"Mark for answered and cached message.")
(defconst modb-legacy-answered-uncached-mark "A"
- "Mark for answered but cached message.")
+ "Mark for answered but uncached message.")
(defconst modb-legacy-important-mark "$"
"Mark for important message.")
+(defconst modb-legacy-flag-list
+ '(new unread important answered cached read uncached)
+ "A list of flag symbol which is supported by legacy msgdb.")
+
(eval-and-compile
(luna-define-class modb-legacy (modb-generic)
(overview number-alist mark-alist index))
;;;
;; Internal use only (obsolete interface)
;;
-;;
-;; mime decode cache
-;;
-(defvar elmo-msgdb-decoded-cache-hashtb nil)
-(make-variable-buffer-local 'elmo-msgdb-decoded-cache-hashtb)
-
-(defsubst elmo-msgdb-get-decoded-cache (string)
- (if elmo-use-decoded-cache
- (let ((hashtb (or elmo-msgdb-decoded-cache-hashtb
- (setq elmo-msgdb-decoded-cache-hashtb
- (elmo-make-hash 2048))))
- decoded)
- (or (elmo-get-hash-val string hashtb)
- (progn
- (elmo-set-hash-val
- string
- (setq decoded
- (decode-mime-charset-string string elmo-mime-charset))
- hashtb)
- decoded)))
- (decode-mime-charset-string string elmo-mime-charset)))
-
-(defsubst elmo-msgdb-overview-entity-get-id (entity)
+(defsubst elmo-msgdb-overview-entity-get-id-internal (entity)
(and entity (car entity)))
-(defsubst elmo-msgdb-overview-entity-get-number (entity)
+(defsubst elmo-msgdb-overview-entity-get-number-internal (entity)
(and entity (aref (cdr entity) 0)))
-(defsubst elmo-msgdb-overview-entity-set-number (entity number)
- (and entity (aset (cdr entity) 0 number))
- entity)
-
-(defsubst elmo-msgdb-overview-entity-get-references (entity)
- (and entity (aref (cdr entity) 1)))
-
-(defsubst elmo-msgdb-overview-entity-set-references (entity references)
- (and entity (aset (cdr entity) 1 references))
- entity)
-
-(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)
- (elmo-msgdb-get-decoded-cache (aref (cdr entity) 2))))
-
-(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)
- (elmo-msgdb-get-decoded-cache (aref (cdr entity) 3))))
-
-(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-set-date (entity date)
- (and entity (aset (cdr entity) 4 date))
- entity)
-
-(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-set-size (entity size)
- (and entity (aset (cdr entity) 7 size))
- entity)
-
-(defsubst elmo-msgdb-overview-entity-get-extra (entity)
- (and entity (aref (cdr entity) 8)))
-
-(defsubst elmo-msgdb-overview-entity-set-extra (entity extra)
- (and entity (aset (cdr entity) 8 extra))
- entity)
-
-(defsubst elmo-msgdb-overview-entity-get-extra-field (entity field-name)
- (let ((field-name (downcase field-name))
- (extra (and entity (aref (cdr entity) 8))))
- (and extra
- (cdr (assoc field-name extra)))))
-
-(defsubst elmo-msgdb-overview-entity-set-extra-field (entity field-name value)
- (let ((field-name (downcase field-name))
- (extras (and entity (aref (cdr entity) 8)))
- extra)
- (if (setq extra (assoc field-name extras))
- (setcdr extra value)
- (elmo-msgdb-overview-entity-set-extra
- entity
- (cons (cons field-name value) extras)))))
-
;;; load & save
(defun elmo-msgdb-number-load (dir)
(elmo-object-load
;;;
+(defsubst modb-legacy-supported-flag-p (flag)
+ (memq flag modb-legacy-flag-list))
(defvar modb-legacy-unread-marks-internal nil)
(defsubst modb-legacy-unread-marks ()
;; key is message-id
(if (elmo-get-hash-val (caar overview) ehash) ; duplicated.
(setq duplicates (cons
- (elmo-msgdb-overview-entity-get-number
+ (elmo-msgdb-overview-entity-get-number-internal
(car overview))
duplicates)))
(if (caar overview)
;; key is number
(elmo-set-hash-val
(format "#%d"
- (elmo-msgdb-overview-entity-get-number (car overview)))
+ (elmo-msgdb-overview-entity-get-number-internal
+ (car overview)))
(car overview) ehash)
(setq overview (cdr overview)))
(while mark-alist
(mhash (elmo-msgdb-get-mark-hashtb msgdb))
number)
(when (and entity ehash)
- (and (setq number (elmo-msgdb-overview-entity-get-number entity))
+ (and (setq number (elmo-msgdb-overview-entity-get-number-internal
+ entity))
(elmo-clear-hash-val (format "#%d" number) ehash))
(and (car entity) ;; message-id
(elmo-clear-hash-val (car entity) ehash)))
(when (and entity mhash)
- (and (setq number (elmo-msgdb-overview-entity-get-number entity))
+ (and (setq number (elmo-msgdb-overview-entity-get-number-internal
+ entity))
(elmo-clear-hash-val (format "#%d" number) mhash)))))
;;; Implement
(luna-define-method elmo-msgdb-length ((msgdb modb-legacy))
(length (modb-legacy-overview-internal msgdb)))
+(luna-define-method elmo-msgdb-flag-available-p ((msgdb modb-legacy) flag)
+ (modb-legacy-supported-flag-p flag))
+
(luna-define-method elmo-msgdb-flags ((msgdb modb-legacy) number)
(modb-legacy-mark-to-flags (elmo-msgdb-get-mark msgdb number)))
(luna-define-method elmo-msgdb-set-flag ((msgdb modb-legacy)
number flag)
+ (unless (modb-legacy-supported-flag-p flag)
+ (error "Flag `%s' is not supported by this msgdb type"
+ (capitalize (symbol-name flag))))
(case flag
(read
(elmo-msgdb-unset-flag msgdb number 'unread))
(luna-define-method elmo-msgdb-unset-flag ((msgdb modb-legacy)
number flag)
+ (unless (or (modb-legacy-supported-flag-p flag)
+ (eq flag 'all))
+ (error "Flag `%s' is not supported by this msgdb type"
+ (capitalize (symbol-name flag))))
(case flag
(read
(elmo-msgdb-set-flag msgdb number 'unread))
(uncached
(elmo-msgdb-set-flag msgdb number 'cached))
+ (all
+ (elmo-msgdb-set-mark msgdb number nil))
(t
(let* ((cur-mark (elmo-msgdb-get-mark msgdb number))
(flags (modb-legacy-mark-to-flags cur-mark))
(unless (string= new-mark cur-mark)
(elmo-msgdb-set-mark msgdb number new-mark))))))
+(luna-define-method elmo-msgdb-flag-count ((msgdb modb-legacy))
+ (let ((new 0)
+ (unread 0)
+ (answered 0))
+ (dolist (elem (elmo-msgdb-get-mark-alist msgdb))
+ (cond
+ ((string= (cadr elem) modb-legacy-new-mark)
+ (incf new)
+ (incf unread))
+ ((member (cadr elem) (modb-legacy-unread-marks))
+ (incf unread))
+ ((member (cadr elem) (modb-legacy-answered-marks))
+ (incf answered))))
+ (list (cons 'new new)
+ (cons 'unread unread)
+ (cons 'answered answered))))
+
(luna-define-method elmo-msgdb-list-messages ((msgdb modb-legacy))
- (mapcar 'elmo-msgdb-overview-entity-get-number
+ (mapcar 'elmo-msgdb-overview-entity-get-number-internal
(elmo-msgdb-get-overview msgdb)))
(luna-define-method elmo-msgdb-list-flagged ((msgdb modb-legacy) flag)
(setq matched (cons (car elem) matched))))))
matched))
+(luna-define-method elmo-msgdb-search ((msgdb modb-legacy)
+ condition &optional numbers)
+ (if (vectorp condition)
+ (let ((key (elmo-filter-key condition))
+ results)
+ (cond
+ ((and (string= key "flag")
+ (eq (elmo-filter-type condition) 'match))
+ (setq results (elmo-msgdb-list-flagged
+ msgdb
+ (intern (elmo-filter-value condition))))
+ (if numbers
+ (elmo-list-filter numbers results)
+ results))
+ ((member key '("first" "last"))
+ (let* ((numbers (or numbers (elmo-msgdb-list-messages msgdb)))
+ (len (length numbers))
+ (lastp (string= key "last"))
+ (value (string-to-number (elmo-filter-value condition))))
+ (when (eq (elmo-filter-type condition) 'unmatch)
+ (setq lastp (not lastp)
+ value (- len value)))
+ (if lastp
+ (nthcdr (max (- len value) 0) numbers)
+ (when (> value 0)
+ (let* ((numbers (copy-sequence numbers))
+ (last (nthcdr (1- value) numbers)))
+ (when last
+ (setcdr last nil))
+ numbers)))))
+ (t
+ t)))
+ t))
+
(luna-define-method elmo-msgdb-append-entity ((msgdb modb-legacy)
entity &optional flags)
(when entity
- (let ((number (elmo-msgdb-overview-entity-get-number entity))
- (message-id (elmo-msgdb-overview-entity-get-id entity))
- mark)
- (elmo-msgdb-set-overview
- msgdb
- (nconc (elmo-msgdb-get-overview msgdb)
- (list entity)))
- (elmo-msgdb-set-number-alist
- msgdb
- (nconc (elmo-msgdb-get-number-alist msgdb)
- (list (cons number message-id))))
- (modb-generic-set-message-modified-internal msgdb t)
- (when (setq mark (modb-legacy-flags-to-mark flags))
- (elmo-msgdb-set-mark-alist
+ (let ((number (elmo-msgdb-overview-entity-get-number-internal entity))
+ (message-id (elmo-msgdb-overview-entity-get-id-internal entity))
+ mark cell)
+ (when (and number message-id)
+ (elmo-msgdb-set-overview
msgdb
- (nconc (elmo-msgdb-get-mark-alist msgdb)
- (list (list number mark))))
- (modb-generic-set-flag-modified-internal msgdb t))
- (elmo-msgdb-make-index
- msgdb
- (list entity)
- (list (list number mark))))))
+ (nconc (elmo-msgdb-get-overview msgdb)
+ (list entity)))
+ (elmo-msgdb-set-number-alist
+ msgdb
+ (nconc (elmo-msgdb-get-number-alist msgdb)
+ (list (cons number message-id))))
+ (modb-generic-set-message-modified-internal msgdb t)
+ (when (setq mark (modb-legacy-flags-to-mark flags))
+ (setq cell (list number mark))
+ (elmo-msgdb-set-mark-alist
+ msgdb
+ (nconc (elmo-msgdb-get-mark-alist msgdb) (list cell)))
+ (modb-generic-set-flag-modified-internal msgdb t))
+ (elmo-msgdb-make-index
+ msgdb
+ (list entity)
+ (and cell (list cell)))))))
(luna-define-method elmo-msgdb-delete-messages ((msgdb modb-legacy)
numbers)
msgdb))
(luna-define-method elmo-msgdb-message-entity ((msgdb modb-legacy) key)
- (elmo-get-hash-val
- (cond ((stringp key) key)
- ((numberp key) (format "#%d" key)))
- (elmo-msgdb-get-entity-hashtb msgdb)))
-
-;;; Message entity handling.
-(defsubst modb-legacy-make-message-entity (args)
- "Make an message entity."
- (cons (plist-get args :message-id)
- (vector (plist-get args :number)
- (plist-get args :references)
- (plist-get args :from)
- (plist-get args :subject)
- (plist-get args :date)
- (plist-get args :to)
- (plist-get args :cc)
- (plist-get args :size)
- (plist-get args :extra))))
-
-(luna-define-method elmo-msgdb-make-message-entity ((msgdb modb-legacy)
- args)
- (modb-legacy-make-message-entity args))
-
-(defsubst elmo-msgdb-insert-file-header (file)
- "Insert the header of the article."
- (let ((beg 0)
- insert-file-contents-pre-hook ; To avoid autoconv-xmas...
- insert-file-contents-post-hook
- format-alist)
- (when (file-exists-p file)
- ;; Read until header separator is found.
- (while (and (eq elmo-msgdb-file-header-chop-length
- (nth 1
- (insert-file-contents-as-binary
- file nil beg
- (incf beg elmo-msgdb-file-header-chop-length))))
- (prog1 (not (search-forward "\n\n" nil t))
- (goto-char (point-max))))))))
-
-(luna-define-method elmo-msgdb-create-message-entity-from-file
- ((msgdb modb-legacy) number file)
- (let (insert-file-contents-pre-hook ; To avoid autoconv-xmas...
- insert-file-contents-post-hook header-end
- (attrib (file-attributes file))
- ret-val size mtime)
- (with-temp-buffer
- (if (not (file-exists-p file))
- ()
- (setq size (nth 7 attrib))
- (setq mtime (timezone-make-date-arpa-standard
- (current-time-string (nth 5 attrib)) (current-time-zone)))
- ;; insert header from file.
- (catch 'done
- (condition-case nil
- (elmo-msgdb-insert-file-header file)
- (error (throw 'done nil)))
- (goto-char (point-min))
- (setq header-end
- (if (re-search-forward "\\(^--.*$\\)\\|\\(\n\n\\)" nil t)
- (point)
- (point-max)))
- (narrow-to-region (point-min) header-end)
- (elmo-msgdb-create-message-entity-from-buffer
- msgdb number :size size :date mtime))))))
-
-(luna-define-method elmo-msgdb-create-message-entity-from-buffer
- ((msgdb modb-legacy) number args)
- (let ((extras elmo-msgdb-extra-fields)
- (default-mime-charset default-mime-charset)
- entity message-id references from subject to cc date
- extra field-body charset size)
- (save-excursion
- (setq entity (modb-legacy-make-message-entity args))
- (elmo-set-buffer-multibyte default-enable-multibyte-characters)
- (setq message-id (elmo-msgdb-get-message-id-from-buffer))
- (and (setq charset (cdr (assoc "charset" (mime-read-Content-Type))))
- (setq charset (intern-soft charset))
- (setq default-mime-charset charset))
- (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")))
- from (elmo-replace-in-string
- (elmo-mime-string (or (elmo-field-body "from")
- elmo-no-from))
- "\t" " ")
- subject (elmo-replace-in-string
- (elmo-mime-string (or (elmo-field-body "subject")
- elmo-no-subject))
- "\t" " ")
- date (elmo-field-body "date")
- to (mapconcat 'identity (elmo-multiple-field-body "to") ",")
- cc (mapconcat 'identity (elmo-multiple-field-body "cc") ","))
- (unless (elmo-msgdb-message-entity-field msgdb entity 'size)
- (if (setq size (elmo-field-body "content-length"))
- (setq size (string-to-int size))
- (setq size 0)))
- (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)))
- (dolist (field '(message-id number references from subject date to cc
- size extra))
- (when (symbol-value field)
- (elmo-msgdb-message-entity-set-field
- msgdb entity field (symbol-value field))))
- entity)))
-
-;;; Message entity interface
-;;
-(luna-define-method elmo-msgdb-message-entity-number ((msgdb modb-legacy)
- entity)
- (and entity (aref (cdr entity) 0)))
-
-(luna-define-method elmo-msgdb-message-entity-set-number ((msgdb modb-legacy)
- entity
- number)
- (and entity (aset (cdr entity) 0 number))
- entity)
-
-(luna-define-method elmo-msgdb-message-entity-field ((msgdb modb-legacy)
- entity field
- &optional decode)
- (and entity
- (let ((field-value
- (case field
- (to (aref (cdr entity) 5))
- (cc (aref (cdr entity) 6))
- (date (aref (cdr entity) 4))
- (subject (aref (cdr entity) 3))
- (from (aref (cdr entity) 2))
- (message-id (car entity))
- (references (aref (cdr entity) 1))
- (size (aref (cdr entity) 7))
- (t (cdr (assoc (symbol-name field) (aref (cdr entity) 8)))))))
- (if (and decode (memq field '(from subject)))
- (elmo-msgdb-get-decoded-cache field-value)
- field-value))))
-
-(luna-define-method elmo-msgdb-message-entity-set-field ((msgdb modb-legacy)
- entity field value)
- (and entity
- (case field
- (number (aset (cdr entity) 0 value))
- (to (aset (cdr entity) 5 value))
- (cc (aset (cdr entity) 6 value))
- (date (aset (cdr entity) 4 value))
- (subject (aset (cdr entity) 3 value))
- (from (aset (cdr entity) 2 value))
- (message-id (setcar entity value))
- (references (aset (cdr entity) 1 value))
- (size (aset (cdr entity) 7 value))
- (t
- (let ((extras (and entity (aref (cdr entity) 8)))
- extra)
- (if (setq extra (assoc field extras))
- (setcdr extra value)
- (aset (cdr entity) 8 (cons (cons (symbol-name field)
- value) extras))))))))
-
-(luna-define-method elmo-msgdb-copy-message-entity ((msgdb modb-legacy)
- entity)
- (cons (car entity)
- (copy-sequence (cdr entity))))
-
-(luna-define-method elmo-msgdb-match-condition-internal ((msgdb modb-legacy)
- condition
- entity flags numbers)
- (cond
- ((vectorp condition)
- (elmo-msgdb-match-condition-primitive condition entity flags numbers))
- ((eq (car condition) 'and)
- (let ((lhs (elmo-msgdb-match-condition-internal msgdb
- (nth 1 condition)
- entity flags numbers)))
- (cond
- ((elmo-filter-condition-p lhs)
- (let ((rhs (elmo-msgdb-match-condition-internal
- msgdb (nth 2 condition) entity flags numbers)))
- (cond ((elmo-filter-condition-p rhs)
- (list 'and lhs rhs))
- (rhs
- lhs))))
- (lhs
- (elmo-msgdb-match-condition-internal msgdb (nth 2 condition)
- entity flags numbers)))))
- ((eq (car condition) 'or)
- (let ((lhs (elmo-msgdb-match-condition-internal msgdb (nth 1 condition)
- entity flags numbers)))
- (cond
- ((elmo-filter-condition-p lhs)
- (let ((rhs (elmo-msgdb-match-condition-internal msgdb
- (nth 2 condition)
- entity flags numbers)))
- (cond ((elmo-filter-condition-p rhs)
- (list 'or lhs rhs))
- (rhs
- t)
- (t
- lhs))))
- (lhs
- t)
- (t
- (elmo-msgdb-match-condition-internal msgdb
- (nth 2 condition)
- entity flags numbers)))))))
-
-;;
-(defun elmo-msgdb-match-condition-primitive (condition entity flags numbers)
- (catch 'unresolved
- (let ((key (elmo-filter-key condition))
- (case-fold-search t)
- result)
- (cond
- ((string= key "last")
- (setq result (<= (length (memq
- (elmo-msgdb-overview-entity-get-number
- entity)
- numbers))
- (string-to-int (elmo-filter-value condition)))))
- ((string= key "first")
- (setq result (< (-
- (length numbers)
- (length (memq
- (elmo-msgdb-overview-entity-get-number
- entity)
- numbers)))
- (string-to-int (elmo-filter-value condition)))))
- ((string= key "flag")
- (setq result
- (cond
- ((string= (elmo-filter-value condition) "any")
- (or (memq 'important flags)
- (memq 'answered flags)
- (memq 'unread flags)))
- ((string= (elmo-filter-value condition) "digest")
- (or (memq 'important flags)
- (memq 'unread flags)))
- ((string= (elmo-filter-value condition) "unread")
- (memq 'unread flags))
- ((string= (elmo-filter-value condition) "important")
- (memq 'important flags))
- ((string= (elmo-filter-value condition) "answered")
- (memq 'answered flags)))))
- ((string= key "from")
- (setq result (string-match
- (elmo-filter-value condition)
- (elmo-msgdb-overview-entity-get-from entity))))
- ((string= key "subject")
- (setq result (string-match
- (elmo-filter-value condition)
- (elmo-msgdb-overview-entity-get-subject entity))))
- ((string= key "to")
- (setq result (string-match
- (elmo-filter-value condition)
- (elmo-msgdb-overview-entity-get-to entity))))
- ((string= key "cc")
- (setq result (string-match
- (elmo-filter-value condition)
- (elmo-msgdb-overview-entity-get-cc entity))))
- ((or (string= key "since")
- (string= key "before"))
- (let ((field-date (elmo-date-make-sortable-string
- (timezone-fix-time
- (elmo-msgdb-overview-entity-get-date entity)
- (current-time-zone) nil)))
- (specified-date
- (elmo-date-make-sortable-string
- (elmo-date-get-datevec
- (elmo-filter-value condition)))))
- (setq result (if (string= key "since")
- (or (string= specified-date field-date)
- (string< specified-date field-date))
- (string< field-date specified-date)))))
- ((member key elmo-msgdb-extra-fields)
- (let ((extval (elmo-msgdb-overview-entity-get-extra-field entity key)))
- (when (stringp extval)
- (setq result (string-match
- (elmo-filter-value condition)
- extval)))))
- (t
- (throw 'unresolved condition)))
- (if (eq (elmo-filter-type condition) 'unmatch)
- (not result)
- result))))
+ (when key
+ (elmo-get-hash-val
+ (cond ((stringp key) key)
+ ((numberp key) (format "#%d" key)))
+ (elmo-msgdb-get-entity-hashtb msgdb))))
(require 'product)
(product-provide (provide 'modb-legacy) (require 'elmo-version))
projects / elisp / wanderlust.git / blobdiff