-;;; elmo-msgdb.el -- Message Database for Elmo.
+;;; elmo-msgdb.el --- Message Database for ELMO.
-;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
;; Author: Yuuichi Teranishi <teranisi@gohome.org>
+;; Masahiro MURATA <muse@ba2.so-net.ne.jp>
;; Keywords: mail, net news
;; This file is part of ELMO (Elisp Library for Message Orchestration).
;;
;;; Commentary:
-;;
+;;
;;; Code:
-;;
+;;
(eval-when-compile (require 'cl))
(require 'elmo-vars)
(require 'elmo-util)
(require 'emu)
(require 'std11)
-(require 'elmo-cache)
-
-(defun elmo-msgdb-expand-path (folder &optional spec)
- (convert-standard-filename
- (let* ((spec (or spec (elmo-folder-get-spec folder)))
- (type (car spec))
- fld)
- (cond
- ((eq type 'imap4)
- (setq fld (elmo-imap4-spec-mailbox spec))
- (if (string= "inbox" (downcase fld))
- (setq fld "inbox"))
- (if (eq (string-to-char fld) ?/)
- (setq fld (substring fld 1 (length fld))))
- (expand-file-name
- fld
- (expand-file-name (or (elmo-imap4-spec-username spec) "nobody")
- (expand-file-name (or
- (elmo-imap4-spec-hostname spec)
- "nowhere")
- (expand-file-name
- "imap"
- elmo-msgdb-dir)))))
- ((eq type 'nntp)
- (expand-file-name
- (elmo-nntp-spec-group spec)
- (expand-file-name (or (elmo-nntp-spec-hostname spec) "nowhere")
- (expand-file-name "nntp"
- elmo-msgdb-dir))))
- ((eq type 'maildir)
- (expand-file-name (elmo-safe-filename (nth 1 spec))
- (expand-file-name "maildir"
- elmo-msgdb-dir)))
- ((eq type 'folder)
- (expand-file-name (elmo-safe-filename (nth 1 spec))
- (expand-file-name "folder"
- elmo-msgdb-dir)))
- ((eq type 'multi)
- (expand-file-name (elmo-safe-filename folder)
- (expand-file-name "multi"
- elmo-msgdb-dir)))
- ((eq type 'filter)
- (expand-file-name
- (elmo-safe-filename folder)
- (expand-file-name "filter"
- elmo-msgdb-dir)))
- ((eq type 'archive)
- (expand-file-name
- (directory-file-name
- (concat
- (elmo-replace-in-string
- (elmo-replace-in-string
- (elmo-replace-in-string
- (nth 1 spec)
- "/" "_")
- ":" "__")
- "~" "___")
- "/" (nth 3 spec)))
- (expand-file-name (concat (symbol-name type) "/"
- (symbol-name (nth 2 spec)))
- elmo-msgdb-dir)))
- ((eq type 'pop3)
- (expand-file-name
- (elmo-safe-filename (elmo-pop3-spec-username spec))
- (expand-file-name (elmo-pop3-spec-hostname spec)
- (expand-file-name
- "pop"
- elmo-msgdb-dir))))
- ((eq type 'localnews)
- (expand-file-name
- (elmo-replace-in-string (nth 1 spec) "/" ".")
- (expand-file-name "localnews"
- elmo-msgdb-dir)))
- ((eq type 'internal)
- (expand-file-name (elmo-safe-filename (concat (symbol-name (nth 1 spec))
- (nth 2 spec)))
- (expand-file-name "internal"
- elmo-msgdb-dir)))
- ((eq type 'cache)
- (expand-file-name (elmo-safe-filename (nth 1 spec))
- (expand-file-name "internal/cache"
- elmo-msgdb-dir)))
- (t ; local dir or undefined type
- ;; absolute path
- (setq fld (nth 1 spec))
- (if (file-name-absolute-p fld)
- (setq fld (elmo-safe-filename fld)))
- (expand-file-name fld
- (expand-file-name (symbol-name type)
- elmo-msgdb-dir)))))))
+(require 'mime)
+(require 'modb)
+
+;;; MSGDB interface.
+;;
+;; MSGDB elmo-load-msgdb PATH MIME-CHARSET
+;; MSGDB elmo-make-msgdb LOCATION TYPE
+;; elmo-msgdb-sort-by-date MSGDB
+
+;; elmo-flag-table-load
+;; elmo-flag-table-set
+;; elmo-flag-table-get
+;; elmo-flag-table-save
+
+;; elmo-msgdb-overview-save DIR OBJ
+
+;;; Abolish
+;; elmo-msgdb-get-parent-entity ENTITY MSGDB
+
+;; elmo-msgdb-killed-list-load DIR
+;; elmo-msgdb-killed-list-save DIR
+;; elmo-msgdb-append-to-killed-list FOLDER MSG
+;; elmo-msgdb-killed-list-length KILLED-LIST
+;; elmo-msgdb-max-of-killed KILLED-LIST
+;; elmo-msgdb-killed-message-p KILLED-LIST MSG
+;; elmo-living-messages MESSAGES KILLED-LIST
+
+;; elmo-msgdb-finfo-load
+;; elmo-msgdb-finfo-save
+;; elmo-msgdb-flist-load
+;; elmo-msgdb-flist-save
+
+;; elmo-crosspost-alist-load
+;; elmo-crosspost-alist-save
+
+;; elmo-folder-get-info
+;; elmo-folder-get-info-max
+;; elmo-folder-get-info-length
+;; elmo-folder-get-info-unread
+
+;;; message entity wrappers
+;;
+(defsubst elmo-message-entity-number (entity)
+ (elmo-msgdb-message-entity-number (elmo-message-entity-handler entity)
+ entity))
+
+(defsubst elmo-message-entity-set-number (entity number)
+ (elmo-msgdb-message-entity-set-number (elmo-message-entity-handler entity)
+ entity
+ number))
+
+(defsubst elmo-message-entity-field (entity field &optional type)
+ "Get message entity field value.
+ENTITY is the message entity structure obtained by `elmo-message-entity'.
+FIELD is the symbol of the field name.
+If optional argument TYPE is specified, return converted value."
+ (elmo-msgdb-message-entity-field (elmo-message-entity-handler entity)
+ entity field type))
+
+(defsubst elmo-message-entity-set-field (entity field value)
+ "Set message entity field value.
+ENTITY is the message entity structure.
+FIELD is the symbol of the field name.
+VALUE is the field value."
+ (elmo-msgdb-message-entity-set-field (elmo-message-entity-handler entity)
+ entity field value))
+
+(defconst elmo-msgdb-load-priorities '(legacy standard)
+ "Priority list of modb type for load.")
+
+;;; Helper functions for MSGDB
+;;
+(defun elmo-load-msgdb (location mime-charset)
+ "Load the MSGDB from PATH."
+ (let ((msgdb (elmo-make-msgdb location elmo-msgdb-default-type mime-charset))
+ priorities loaded temp-modb)
+ (unless (elmo-msgdb-load msgdb)
+ (setq priorities
+ (delq elmo-msgdb-default-type
+ (copy-sequence elmo-msgdb-load-priorities)))
+ (while (and priorities
+ (not loaded))
+ (setq temp-modb (elmo-make-msgdb location
+ (car priorities)
+ mime-charset)
+ loaded (elmo-msgdb-load temp-modb)
+ priorities (cdr priorities)))
+ (when loaded
+ (if (eq elmo-msgdb-convert-type 'auto)
+ (elmo-msgdb-append msgdb temp-modb)
+ (setq msgdb temp-modb))))
+ msgdb))
+
+(defun elmo-make-msgdb (&optional location type mime-charset)
+ "Make a MSGDB."
+ (let* ((type (or type elmo-msgdb-default-type))
+ (class (intern (format "modb-%s" type))))
+ (require class)
+ (luna-make-entity class
+ :location location
+ :mime-charset mime-charset)))
+
+(defun elmo-msgdb-extra-fields (&optional non-virtual)
+ (if non-virtual
+ (apply
+ #'nconc
+ (mapcar
+ (lambda (extra)
+ (let ((spec (assq (intern extra) modb-entity-field-extractor-alist)))
+ (if spec
+ (let ((real-fields (nth 2 spec)))
+ (cond ((functionp real-fields)
+ (funcall real-fields extra))
+ ((listp real-fields)
+ (copy-sequence real-fields))))
+ (list extra))))
+ elmo-msgdb-extra-fields))
+ elmo-msgdb-extra-fields))
+
+(defun elmo-msgdb-sort-by-date (msgdb)
+ (elmo-msgdb-sort-entities
+ msgdb
+ (lambda (x y app-data)
+ (condition-case nil
+ (elmo-time<
+ (elmo-message-entity-field x 'date)
+ (elmo-message-entity-field y 'date))
+ (error)))))
+
+(defsubst elmo-msgdb-get-parent-entity (entity msgdb)
+ (setq entity (elmo-message-entity-field entity 'references))
+ ;; entity is parent-id.
+ (and entity (elmo-msgdb-message-entity msgdb entity)))
+;;;
(defsubst elmo-msgdb-append-element (list element)
(if list
- ;(append list (list element))
+;;; (append list (list element))
(nconc list (list element))
;; list is nil
(list element)))
-(defsubst elmo-msgdb-get-overview (msgdb)
- (car msgdb))
-(defsubst elmo-msgdb-get-number-alist (msgdb)
- (cadr msgdb))
-(defsubst elmo-msgdb-get-mark-alist (msgdb)
- (caddr msgdb))
-(defsubst elmo-msgdb-get-location (msgdb)
- (cadddr msgdb))
-
;;
;; number <-> Message-ID handling
;;
(defsubst elmo-msgdb-number-add (alist number id)
(let ((ret-val alist))
- (setq ret-val
+ (setq ret-val
(elmo-msgdb-append-element ret-val (cons number id)))
ret-val))
-;;;
-;; parsistent mark handling
-;; (for global!)
-
-(defvar elmo-msgdb-global-mark-alist nil)
-
-(defun elmo-msgdb-global-mark-delete (msgid)
- (let* ((path (expand-file-name
- elmo-msgdb-global-mark-filename
- elmo-msgdb-dir))
- (malist (or elmo-msgdb-global-mark-alist
- (setq elmo-msgdb-global-mark-alist
- (elmo-object-load path))))
- match)
- (when (setq match (assoc msgid malist))
- (setq elmo-msgdb-global-mark-alist
- (delete match elmo-msgdb-global-mark-alist))
- (elmo-object-save path elmo-msgdb-global-mark-alist))))
-
-(defun elmo-msgdb-global-mark-set (msgid mark)
- (let* ((path (expand-file-name
- elmo-msgdb-global-mark-filename
- elmo-msgdb-dir))
- (malist (or elmo-msgdb-global-mark-alist
- (setq elmo-msgdb-global-mark-alist
- (elmo-object-load path))))
- match)
- (if (setq match (assoc msgid malist))
- (setcdr match mark)
- (setq elmo-msgdb-global-mark-alist
- (nconc elmo-msgdb-global-mark-alist
- (list (cons msgid mark)))))
- (elmo-object-save path elmo-msgdb-global-mark-alist)))
-
-(defun elmo-msgdb-global-mark-get (msgid)
- (cdr (assoc msgid (or elmo-msgdb-global-mark-alist
- (setq elmo-msgdb-global-mark-alist
- (elmo-object-load
- (expand-file-name
- elmo-msgdb-global-mark-filename
- elmo-msgdb-dir)))))))
-
+;;; flag table
;;
-;; number <-> location handling
-;;
-(defsubst elmo-msgdb-location-load (dir)
- (elmo-object-load
- (expand-file-name
- elmo-msgdb-location-filename
- dir)))
-
-(defsubst elmo-msgdb-location-add (alist number location)
- (let ((ret-val alist))
- (setq ret-val
- (elmo-msgdb-append-element ret-val (cons number location)))
- ret-val))
-
-(defsubst elmo-msgdb-location-save (dir alist)
- (elmo-object-save
- (expand-file-name
- elmo-msgdb-location-filename
- dir) alist))
-
-(defun elmo-list-folder-by-location (spec locations &optional msgdb)
- (let* ((path (elmo-msgdb-expand-path nil spec))
- (location-alist (if msgdb
- (elmo-msgdb-get-location msgdb)
- (elmo-msgdb-location-load path)))
- (locations-in-db (mapcar 'cdr location-alist))
- result new-locs new-alist deleted-locs i
- modified)
- (setq new-locs
- (elmo-delete-if (function
- (lambda (x) (member x locations-in-db)))
- locations))
- (setq deleted-locs
- (elmo-delete-if (function
- (lambda (x) (member x locations)))
- locations-in-db))
- (setq modified new-locs)
- (setq i (or (elmo-max-of-list (mapcar 'car location-alist)) 0))
- (mapcar
- (function
- (lambda (x)
- (setq location-alist
- (delq (rassoc x location-alist) location-alist))))
- deleted-locs)
- (while new-locs
- (setq i (1+ i))
- (setq new-alist (cons (cons i (car new-locs)) new-alist))
- (setq new-locs (cdr new-locs)))
- (setq result (nconc location-alist new-alist))
- (setq result (sort result (lambda (x y) (< (car x)(car y)))))
- (if modified (elmo-msgdb-location-save path result))
- (mapcar 'car result)))
-
+(defvar elmo-flag-table-filename "flag-table")
+(defun elmo-flag-table-load (dir)
+ "Load flag hashtable for MSGDB."
+ (let ((table (elmo-make-hash))
+ ;; For backward compatibility
+ (seen-file (expand-file-name elmo-msgdb-seen-filename dir))
+ value)
+ (when (file-exists-p seen-file)
+ (dolist (msgid (elmo-object-load seen-file))
+ (elmo-set-hash-val msgid '(read) table))
+ (delete-file seen-file))
+ (dolist (pair (elmo-object-load
+ (expand-file-name elmo-flag-table-filename dir)))
+ (setq value (cdr pair))
+ (elmo-set-hash-val (car pair)
+ (cond ((consp value)
+ value)
+ ;; Following cases for backward compatibility.
+ (value
+ (list value))
+ (t
+ '(unread)))
+ table))
+ table))
+
+(defun elmo-flag-table-set (flag-table msg-id flags)
+ (elmo-set-hash-val msg-id (or flags '(read)) flag-table))
+
+(defun elmo-flag-table-get (flag-table msg-id)
+ (let ((flags (elmo-get-hash-val msg-id flag-table)))
+ (append
+ (and (elmo-file-cache-exists-p msg-id)
+ '(cached))
+ (if flags
+ (elmo-list-delete '(cached read)
+ (copy-sequence flags)
+ #'delq)
+ '(new unread)))))
+
+(defun elmo-flag-table-save (dir flag-table)
+ (elmo-object-save
+ (expand-file-name elmo-flag-table-filename dir)
+ (if flag-table
+ (let (list)
+ (mapatoms (lambda (atom)
+ (setq list (cons (cons (symbol-name atom)
+ (symbol-value atom))
+ list)))
+ flag-table)
+ list))))
;;;
;; persistent mark handling
;; (for each folder)
-(defun elmo-msgdb-mark-set (alist id mark)
- (let ((ret-val alist)
- entity)
- (setq entity (assq id alist))
- (if entity
- (if (eq mark nil)
- ;; delete this entity
- (setq ret-val (delq entity alist))
- ;; set mark
- (setcar (cdr entity) mark))
- (if mark
- (setq ret-val (elmo-msgdb-append-element ret-val
- (list id mark)))))
- ret-val))
(defun elmo-msgdb-mark-append (alist id mark)
- "Append mark"
+ "Append mark."
(setq alist (elmo-msgdb-append-element alist
(list id mark))))
-(defun elmo-msgdb-mark-alist-to-seen-list (number-alist mark-alist seen-marks)
- "Make seen-list from mark-alist"
- (let ((seen-mark-list (string-to-char-list seen-marks))
- ret-val ent)
- (while number-alist
- (if (setq ent (assq (car (car number-alist)) mark-alist))
- (if (and (cadr ent)
- (memq (string-to-char (cadr ent)) seen-mark-list))
- (setq ret-val (cons (cdr (car number-alist)) ret-val)))
- (setq ret-val (cons (cdr (car number-alist)) ret-val)))
- (setq number-alist (cdr number-alist)))
- ret-val))
-
-;;
-;; overview handling
-;;
-
-(defsubst elmo-msgdb-get-field-value (field-name beg end buffer)
- (save-excursion
- (save-restriction
- (set-buffer buffer)
- (narrow-to-region beg end)
- (elmo-field-body field-name))))
-
-(defun elmo-multiple-field-body (name &optional boundary)
- (save-excursion
- (save-restriction
- (std11-narrow-to-header boundary)
- (goto-char (point-min))
- (let ((case-fold-search t)
- (field-body nil))
- (while (re-search-forward (concat "^" name ":[ \t]*") nil t)
- (setq field-body
- (nconc field-body
- (list (buffer-substring-no-properties
- (match-end 0) (std11-field-end))))))
- field-body))))
+(defun elmo-msgdb-flag-table (msgdb &optional flag-table)
+ ;; Make a table of msgid flag (read, answered)
+ (let ((flag-table (or flag-table
+ (elmo-make-hash (elmo-msgdb-length msgdb))))
+ msg-id)
+ (dolist (number (elmo-msgdb-list-messages msgdb))
+ (when (setq msg-id (elmo-msgdb-message-field msgdb number 'message-id))
+ (elmo-flag-table-set flag-table
+ msg-id
+ (elmo-msgdb-flags msgdb number))))
+ flag-table))
(defun elmo-multiple-fields-body-list (field-names &optional boundary)
"Return list of each field-bodies of FIELD-NAMES of the message header
(substring string (match-end 0))
string))
-(defsubst elmo-msgdb-get-last-message-id (string)
- (if string
- (save-match-data
- (let (beg)
- (elmo-set-work-buf
- (insert string)
- (goto-char (point-max))
- (when (search-backward "<" nil t)
- (setq beg (point))
- (if (search-forward ">" nil t)
- (elmo-replace-in-string
- (buffer-substring beg (point)) "\n[ \t]*" ""))))))))
-
-(defun elmo-msgdb-number-load (dir)
- (elmo-object-load
- (expand-file-name elmo-msgdb-number-filename dir)))
-
-(defun elmo-msgdb-overview-load (dir)
- (elmo-object-load
- (expand-file-name elmo-msgdb-overview-filename dir)))
-
-(defun elmo-msgdb-mark-load (dir)
- (elmo-object-load
- (expand-file-name elmo-msgdb-mark-filename dir)))
-
(defsubst elmo-msgdb-seen-load (dir)
(elmo-object-load (expand-file-name
elmo-msgdb-seen-filename
dir)))
-(defun elmo-msgdb-number-save (dir obj)
- (elmo-object-save
- (expand-file-name elmo-msgdb-number-filename dir)
- obj))
-
-(defun elmo-msgdb-mark-save (dir obj)
- (elmo-object-save
- (expand-file-name elmo-msgdb-mark-filename dir)
- obj))
-
-(defsubst elmo-msgdb-seen-save (dir obj)
- (elmo-object-save
- (expand-file-name elmo-msgdb-seen-filename dir)
- obj))
-
-(defsubst elmo-msgdb-overview-save (dir overview)
- (elmo-object-save
- (expand-file-name elmo-msgdb-overview-filename dir)
- overview))
-
-(defun elmo-msgdb-delete-msgs (folder msgs msgdb &optional reserve-cache)
- "Delete MSGS from FOLDER in MSGDB.
-content of MSGDB is changed."
- (save-excursion
- (let* ((msg-list msgs)
- (dir (elmo-msgdb-expand-path folder))
- (overview (or (car msgdb)
- (elmo-msgdb-overview-load dir)))
- (number-alist (or (cadr msgdb)
- (elmo-msgdb-number-load dir)))
- (mark-alist (or (caddr msgdb)
- (elmo-msgdb-mark-load dir)))
- message-id)
- ;; remove from current database.
- (while msg-list
- (setq message-id (cdr (assq (car msg-list) number-alist)))
- (if (and (not reserve-cache) message-id)
- (elmo-cache-delete message-id
- folder (car msg-list)))
- ;; This is no good!!!!
- ;(setq overview (delete (assoc message-id overview) overview))
- (setq overview
- (delq
- (elmo-msgdb-overview-get-entity-by-number overview
- (car msg-list))
- overview))
- (setq number-alist
- (delq (assq (car msg-list) number-alist) number-alist))
- (setq mark-alist (delq (assq (car msg-list) mark-alist) mark-alist))
- (setq msg-list (cdr msg-list)))
- (setcar msgdb overview)
- (setcar (cdr msgdb) number-alist)
- (setcar (cddr msgdb) mark-alist))
- t)) ;return value
-
-(defsubst elmo-msgdb-set-overview (msgdb overview)
- (setcar msgdb overview))
-
-(defsubst elmo-msgdb-set-number-alist (msgdb number-alist)
- (setcar (cdr msgdb) number-alist))
-
-(defsubst elmo-msgdb-set-mark-alist (msgdb mark-alist)
- (setcar (cddr msgdb) mark-alist))
-
-(defsubst elmo-msgdb-overview-entity-get-references (entity)
- (and entity (aref (cdr entity) 1)))
-
-;; entity -> parent-entity
-(defsubst elmo-msgdb-overview-get-parent-entity (entity database)
- (setq entity (elmo-msgdb-overview-entity-get-references entity))
- ;; entity is parent-id.
- (and entity (assoc entity database)))
-
-(defsubst elmo-msgdb-overview-entity-get-number (entity)
- (and entity (aref (cdr entity) 0)))
-
-(defsubst elmo-msgdb-overview-entity-get-from-no-decode (entity)
- (and entity (aref (cdr entity) 2)))
-
-(defsubst elmo-msgdb-overview-entity-get-from (entity)
- (and entity
- (aref (cdr entity) 2)
- (decode-mime-charset-string (aref (cdr entity) 2)
- elmo-mime-charset)))
-
-(defsubst elmo-msgdb-overview-entity-set-number (entity number)
- (and entity (aset (cdr entity) 0 number))
- entity)
- ;(setcar (cadr entity) number) entity)
-
-(defsubst elmo-msgdb-overview-entity-set-from (entity from)
- (and entity (aset (cdr entity) 2 from))
- entity)
-
-(defsubst elmo-msgdb-overview-entity-get-subject (entity)
- (and entity
- (aref (cdr entity) 3)
- (decode-mime-charset-string (aref (cdr entity) 3)
- elmo-mime-charset)))
-
-(defsubst elmo-msgdb-overview-entity-get-subject-no-decode (entity)
- (and entity (aref (cdr entity) 3)))
-
-(defsubst elmo-msgdb-overview-entity-set-subject (entity subject)
- (and entity (aset (cdr entity) 3 subject))
- entity)
-
-(defsubst elmo-msgdb-overview-entity-get-date (entity)
- (and entity (aref (cdr entity) 4)))
-
-(defsubst elmo-msgdb-overview-entity-get-to (entity)
- (and entity (aref (cdr entity) 5)))
-
-(defsubst elmo-msgdb-overview-entity-get-cc (entity)
- (and entity (aref (cdr entity) 6)))
-
-(defsubst elmo-msgdb-overview-entity-get-size (entity)
- (and entity (aref (cdr entity) 7)))
-
-(defsubst elmo-msgdb-overview-entity-get-id (entity)
- (and entity (car entity)))
-
-(defsubst elmo-msgdb-overview-entity-get-extra-field (entity field-name)
- (let ((extra (and entity (aref (cdr entity) 8))))
- (and extra
- (cdr (assoc field-name extra)))))
-
-(defun elmo-msgdb-overview-get-entity-by-number (database number)
- (let ((db database)
- entity)
- (catch 'loop
- (while db
- (if (eq (elmo-msgdb-overview-entity-get-number (car db)) number)
- (progn
- (setq entity (car db))
- (throw 'loop nil))
- (setq db (cdr db)))))
- entity))
+(defsubst elmo-msgdb-out-of-date-messages (msgdb)
+ (dolist (number (elmo-msgdb-list-flagged msgdb 'new))
+ (elmo-msgdb-unset-flag msgdb number 'new)))
;;
;; deleted message handling
killed-list))
(defun elmo-msgdb-killed-message-p (killed-list msg)
- (and killed-list
- (not (listp
- (catch 'found
- (mapcar
- (function
- (lambda (entity)
- (cond
- ((integerp entity)
- (if (eq entity msg)
- (throw 'found t)))
- ((consp entity)
- (if (and (<= (car entity) msg)
- (<= msg (cdr entity)))
- (throw 'found t)))))
- killed-list)))))))
+ (elmo-number-set-member msg killed-list))
(defun elmo-msgdb-set-as-killed (killed-list msg)
- "if cons cell, set car-cdr messages as killed.
-if integer, set number th message as killed."
- (let ((dlist killed-list)
- (ret-val killed-list)
- entity found)
- (cond
- ((integerp msg)
- (while (and dlist (not found))
- (setq entity (car dlist))
- (if (or (and (integerp entity) (eq entity msg))
- (and (consp entity)
- (<= (car entity) msg)
- (<= msg (cdr entity))))
- (setq found t))
- (setq dlist (cdr dlist))
- )
- (if (not found)
- (setq ret-val (elmo-msgdb-append-element killed-list msg)))
- )
- ((consp msg)
- (while (and dlist (not found))
- (setq entity (car dlist))
- (if (integerp entity)
- (cond
- ((and (<= (car msg) entity)(<= entity (cdr msg)))
- (setcar dlist msg)
- (setq found t)
- )
- ((= (1- (car msg)) entity)
- (setcar dlist (cons entity (cdr msg)))
- (setq found t)
- )
- ((= (1+ (cdr msg)) entity)
- (setcar dlist (cons (car msg) entity))
- (setq found t)
- ))
- ;; entity is consp
- (cond ; there are four patterns
- ((and (<= (car msg) (car entity))
- (<= (cdr entity) (cdr msg)))
- (setcar dlist msg)
- (setq found t))
- ((and (< (car entity)(car msg))
- (< (cdr msg) (cdr entity)))
- (setq found t))
- ((and (<= (car msg) (car entity))
- (<= (cdr msg) (cdr entity)))
- (setcar dlist (cons (car msg) (cdr entity)))
- (setq found t))
- ((and (<= (car entity) (car msg))
- (<= (cdr entity) (cdr msg)))
- (setcar dlist (cons (car entity) (cdr msg)))
- (setq found t))))
- (setq dlist (cdr dlist)))
- (if (not found)
- (setq ret-val (elmo-msgdb-append-element killed-list msg)))))
+ (elmo-number-set-append killed-list msg))
+
+(defun elmo-msgdb-killed-list-length (killed-list)
+ (let ((killed killed-list)
+ (ret-val 0))
+ (while (car killed)
+ (if (consp (car killed))
+ (setq ret-val (+ ret-val 1 (- (cdar killed) (caar killed))))
+ (setq ret-val (+ ret-val 1)))
+ (setq killed (cdr killed)))
ret-val))
+(defun elmo-msgdb-max-of-killed (killed-list)
+ (let ((klist killed-list)
+ (max 0)
+ k)
+ (while (car klist)
+ (if (< max
+ (setq k
+ (if (consp (car klist))
+ (cdar klist)
+ (car klist))))
+ (setq max k))
+ (setq klist (cdr klist)))
+ max))
+
+(defun elmo-living-messages (messages killed-list)
+ (if killed-list
+ (delq nil
+ (mapcar (lambda (number)
+ (unless (elmo-number-set-member number killed-list)
+ number))
+ messages))
+ messages))
+
(defun elmo-msgdb-finfo-load ()
- (elmo-object-load (expand-file-name
+ (elmo-object-load (expand-file-name
elmo-msgdb-finfo-filename
- elmo-msgdb-dir)
+ elmo-msgdb-directory)
elmo-mime-charset t))
(defun elmo-msgdb-finfo-save (finfo)
(elmo-object-save (expand-file-name
elmo-msgdb-finfo-filename
- elmo-msgdb-dir)
+ elmo-msgdb-directory)
finfo elmo-mime-charset))
-(defun elmo-msgdb-flist-load (folder)
+(defun elmo-msgdb-flist-load (fname)
(let ((flist-file (expand-file-name
elmo-msgdb-flist-filename
- (elmo-msgdb-expand-path folder (list 'folder folder)))))
- (elmo-object-load flist-file nil t)))
+ (expand-file-name
+ (elmo-safe-filename fname)
+ (expand-file-name "folder" elmo-msgdb-directory)))))
+ (elmo-object-load flist-file elmo-mime-charset t)))
-(defun elmo-msgdb-flist-save (folder flist)
+(defun elmo-msgdb-flist-save (fname flist)
(let ((flist-file (expand-file-name
elmo-msgdb-flist-filename
- (elmo-msgdb-expand-path folder (list 'folder folder)))))
- (elmo-object-save flist-file flist)))
+ (expand-file-name
+ (elmo-safe-filename fname)
+ (expand-file-name "folder" elmo-msgdb-directory)))))
+ (elmo-object-save flist-file flist elmo-mime-charset)))
(defun elmo-crosspost-alist-load ()
(elmo-object-load (expand-file-name
elmo-crosspost-alist-filename
- elmo-msgdb-dir)
+ elmo-msgdb-directory)
nil t))
(defun elmo-crosspost-alist-save (alist)
(elmo-object-save (expand-file-name
elmo-crosspost-alist-filename
- elmo-msgdb-dir)
+ elmo-msgdb-directory)
alist))
-(defsubst elmo-msgdb-create-overview-from-buffer (number &optional size time)
- "Create overview entity from current buffer.
-Header region is supposed to be narrowed."
- (save-excursion
- (let ((extras elmo-msgdb-extra-fields)
- message-id references from subject to cc date
- extra field-body)
- (elmo-set-buffer-multibyte default-enable-multibyte-characters)
- (setq message-id (elmo-field-body "message-id"))
- (setq references
- (or (elmo-msgdb-get-last-message-id
- (elmo-field-body "in-reply-to"))
- (elmo-msgdb-get-last-message-id
- (elmo-field-body "references"))))
- (setq from (elmo-mime-string (elmo-delete-char
- ?\"
- (or
- (elmo-field-body "from")
- elmo-no-from))))
- (setq subject (elmo-mime-string (or (elmo-field-body "subject")
- elmo-no-subject)))
- (setq date (or (elmo-field-body "date") time))
- (setq to (mapconcat 'identity (elmo-multiple-field-body "to") ","))
- (setq cc (mapconcat 'identity (elmo-multiple-field-body "cc") ","))
- (or size
- (if (setq size (elmo-field-body "content-length"))
- (setq size (string-to-int size))
- (setq size 0)));; No mean...
- (while extras
- (if (setq field-body (elmo-field-body (car extras)))
- (setq extra (cons (cons (downcase (car extras))
- field-body) extra)))
- (setq extras (cdr extras)))
- (cons message-id (vector number references
- from subject date to cc
- size extra))
- )))
-
-(defun elmo-msgdb-overview-sort-by-date (overview)
- (sort overview
- (function
- (lambda (x y)
- (condition-case nil
- (string<
- (timezone-make-date-sortable
- (elmo-msgdb-overview-entity-get-date x))
- (timezone-make-date-sortable
- (elmo-msgdb-overview-entity-get-date y)))
- (error))))))
+(defsubst elmo-folder-get-info (folder &optional hashtb)
+ (elmo-get-hash-val folder
+ (or hashtb elmo-folder-info-hashtb)))
-(defun elmo-msgdb-sort-by-date (msgdb)
- (message "Sorting...")
- (let ((overview (elmo-msgdb-get-overview msgdb)))
- (setq overview (elmo-msgdb-overview-sort-by-date overview))
- (message "Sorting...done.")
- (list overview (nth 1 msgdb)(nth 2 msgdb)(nth 3 msgdb))))
-
-(defsubst elmo-msgdb-search-overview-entity (number number-alist overview)
- (let ((message-id (cdr (assq number number-alist)))
- ovs)
- (if message-id
- (assoc message-id overview)
- (elmo-msgdb-overview-get-entity-by-number overview number))))
-
-(defsubst elmo-msgdb-append (msgdb msgdb-append)
- (list
- (nconc (car msgdb) (car msgdb-append))
- (nconc (cadr msgdb) (cadr msgdb-append))
- (nconc (caddr msgdb) (caddr msgdb-append))
- (nconc (cadddr msgdb) (cadddr msgdb-append))))
-
-(defun elmo-msgdb-delete-path (folder &optional spec)
- (let ((path (elmo-msgdb-expand-path folder spec)))
- (if (file-directory-p path)
- (elmo-delete-directory path t))))
-
-(defun elmo-msgdb-rename-path (old-folder new-folder &optional old-spec new-spec)
- (let* ((old (directory-file-name (elmo-msgdb-expand-path old-folder old-spec)))
- (new (directory-file-name (elmo-msgdb-expand-path new-folder new-spec)))
- (new-dir (directory-file-name (file-name-directory new))))
- (if (not (file-directory-p old))
- ()
- (if (file-exists-p new)
- (error "already exists directory: %s" new)
- (if (not (file-exists-p new-dir))
- (elmo-make-directory new-dir))
- (rename-file old new)))))
-
-(provide 'elmo-msgdb)
+(defun elmo-folder-get-info-max (folder)
+ "Get folder info from cache."
+ (nth 3 (elmo-folder-get-info folder)))
+
+(defun elmo-folder-get-info-length (folder)
+ (nth 2 (elmo-folder-get-info folder)))
+
+(defun elmo-folder-get-info-unread (folder)
+ (nth 1 (elmo-folder-get-info folder)))
+
+(defsubst elmo-msgdb-location-load (dir)
+ (elmo-object-load
+ (expand-file-name
+ elmo-msgdb-location-filename
+ dir)))
+
+(defsubst elmo-msgdb-location-add (alist number location)
+ (let ((ret-val alist))
+ (setq ret-val
+ (elmo-msgdb-append-element ret-val (cons number location)))
+ ret-val))
+
+(defsubst elmo-msgdb-location-save (dir alist)
+ (elmo-object-save
+ (expand-file-name
+ elmo-msgdb-location-filename
+ dir) alist))
+
+;;; For backward compatibility.
+(defsubst elmo-msgdb-overview-entity-get-number (entity)
+ (elmo-message-entity-number entity))
+
+(defsubst elmo-msgdb-overview-entity-set-number (entity number)
+ (elmo-message-entity-set-number entity number))
+
+(defsubst elmo-msgdb-overview-entity-get-references (entity)
+ (elmo-message-entity-field entity 'references))
+
+(defsubst elmo-msgdb-overview-entity-set-references (entity references)
+ (elmo-message-entity-set-field entity 'references references))
+
+(defsubst elmo-msgdb-overview-entity-get-from-no-decode (entity)
+ (elmo-with-enable-multibyte
+ (encode-mime-charset-string
+ (elmo-message-entity-field entity 'from) elmo-mime-charset)))
+
+(defsubst elmo-msgdb-overview-entity-get-from (entity)
+ (elmo-message-entity-field entity 'from))
+
+(defsubst elmo-msgdb-overview-entity-set-from (entity from)
+ (elmo-message-entity-set-field entity 'from from))
+
+(defsubst elmo-msgdb-overview-entity-get-subject (entity)
+ (elmo-message-entity-field entity 'subject))
+
+(defsubst elmo-msgdb-overview-entity-get-subject-no-decode (entity)
+ (elmo-with-enable-multibyte
+ (encode-mime-charset-string
+ (elmo-message-entity-field entity 'subject) elmo-mime-charset)))
+
+(defsubst elmo-msgdb-overview-entity-set-subject (entity subject)
+ (elmo-message-entity-set-field entity 'subject subject))
+
+(defsubst elmo-msgdb-overview-entity-get-date (entity)
+ (elmo-message-entity-field entity 'date 'string))
+
+(defsubst elmo-msgdb-overview-entity-set-date (entity date)
+ (elmo-message-entity-set-field entity 'date date))
+
+(defsubst elmo-msgdb-overview-entity-get-to (entity)
+ (elmo-message-entity-field entity 'to 'string))
+
+(defsubst elmo-msgdb-overview-entity-get-cc (entity)
+ (elmo-message-entity-field entity 'cc 'string))
+
+(defsubst elmo-msgdb-overview-entity-get-size (entity)
+ (elmo-message-entity-field entity 'size))
+
+(defsubst elmo-msgdb-overview-entity-set-size (entity size)
+ (elmo-message-entity-set-field entity 'size size))
+
+(defsubst elmo-msgdb-overview-entity-get-extra (entity)
+ ;; Truely obsolete.
+ )
+
+(defsubst elmo-msgdb-overview-entity-set-extra (entity extra)
+ ;; Truely obsolete.
+ )
+
+(defsubst elmo-msgdb-overview-entity-get-extra-field (entity
+ field-name)
+ (elmo-message-entity-field entity (intern field-name)))
+
+(defsubst elmo-msgdb-overview-entity-set-extra-field (entity
+ field-name
+ value)
+ (elmo-message-entity-set-field entity (intern field-name) value))
+
+(require 'product)
+(product-provide (provide 'elmo-msgdb) (require 'elmo-version))
;;; elmo-msgdb.el ends here
projects / elisp / wanderlust.git / blobdiff