(require 'elmo-util)
(require 'modb)
-;; Currently, entity structure is same as legacy.
-(require 'modb-legacy)
-
(defcustom modb-standard-divide-number 500
"*Standard modb divide entity number."
(number-list ; sorted list of message numbers.
entity-map ; number, msg-id -> entity mapping.
flag-map ; number -> flag-list mapping
+ flag-count ; list of (FLAG . COUNT)
+ overview-handler ; instance of modb-entity-handler.
))
(luna-define-internal-accessors 'modb-standard))
(defsubst modb-standard-entity-id (entity)
(if (eq 'autoload (car-safe entity))
(cddr entity)
- (elmo-msgdb-overview-entity-get-id entity)))
+ (elmo-msgdb-message-entity-field
+ (elmo-message-entity-handler entity)
+ entity 'message-id)))
(defsubst modb-standard-entity-map (modb)
(or (modb-standard-entity-map-internal modb)
(throw 'done t))
(setq check-flags (cdr check-flags)))))
+(defsubst modb-standard-countup-flags (modb flags &optional delta)
+ (let ((flag-count (modb-standard-flag-count-internal modb))
+ (delta (or delta 1))
+ elem)
+ (dolist (flag flags)
+ (if (setq elem (assq flag flag-count))
+ (setcdr elem (+ (cdr elem) delta))
+ (setq flag-count (cons (cons flag delta) flag-count))))
+ (modb-standard-set-flag-count-internal modb flag-count)))
;; save and load functions
(defun modb-standard-load-msgid (modb path)
(elmo-make-hash (elmo-msgdb-length modb)))))
(dolist (info (elmo-object-load
(expand-file-name modb-standard-flag-filename path)))
+ (modb-standard-countup-flags modb (cdr info))
(elmo-set-hash-val (modb-standard-key (car info)) info table))
(modb-standard-set-flag-map-internal modb table)))
(number-to-string section))
modb-standard-entity-filename))
+(defsubst modb-standard-loaded-message-id (msgdb number)
+ "Get message-id for autoloaded entity."
+ (let ((ret (elmo-get-hash-val
+ (modb-standard-key number)
+ (modb-standard-entity-map-internal msgdb))))
+ (cond
+ ((null ret)
+ ;; Garbage entity.
+ (elmo-clear-hash-val (modb-standard-key number)
+ (modb-standard-entity-map-internal msgdb))
+ nil) ; return nil.
+ ((eq (car-safe ret) 'autoload)
+ (cdr (cdr ret))) ; message-id.
+ ((elmo-msgdb-message-entity-field (elmo-message-entity-handler ret)
+ ret 'message-id)) ; Already loaded.
+ (t (error "Internal error: invalid msgdb status")))))
+
(defun modb-standard-load-entity (modb path &optional section)
(let ((table (or (modb-standard-entity-map-internal modb)
- (elmo-make-hash (elmo-msgdb-length modb)))))
- (dolist (entity (elmo-object-load
- (expand-file-name
- (modb-standard-entity-filename section)
- path)))
- (elmo-set-hash-val (modb-standard-key
- (elmo-msgdb-overview-entity-get-number entity))
- entity
- table)
- (elmo-set-hash-val (elmo-msgdb-overview-entity-get-id entity)
- entity
- table))
+ (elmo-make-hash (elmo-msgdb-length modb))))
+ (objects (elmo-object-load
+ (expand-file-name
+ (modb-standard-entity-filename section)
+ path)))
+ number msgid)
+ (cond ((eq (car objects) 'modb-standard-entity-handler)
+ ;; (standard PARAMETERS ENTITY*)
+ (let ((handler (apply #'luna-make-entity
+ (car objects)
+ (car (cdr objects))))
+ entity)
+ (dolist (element (cdr (cdr objects)))
+ (setq entity (cons handler (cons nil element))
+ number (elmo-msgdb-message-entity-number handler entity)
+ msgid (modb-standard-loaded-message-id modb number))
+ (when msgid
+ (elmo-msgdb-message-entity-set-field
+ handler entity 'message-id msgid)
+ (elmo-set-hash-val (modb-standard-key number) entity table)
+ (elmo-set-hash-val msgid entity table)))))
+ (t
+ ;; legacy format
+ (dolist (entity objects)
+ (setq number (elmo-msgdb-message-entity-number
+ (elmo-message-entity-handler entity)
+ entity)
+ msgid (modb-standard-loaded-message-id modb number))
+ (when msgid
+ (setcar entity msgid)
+ (elmo-set-hash-val (modb-standard-key number) entity table)
+ (elmo-set-hash-val msgid entity table)))))
(modb-standard-set-entity-map-internal modb table)))
(defsubst modb-standard-save-entity-1 (modb path &optional section)
(let ((table (modb-standard-entity-map-internal modb))
(filename (expand-file-name
- (modb-standard-entity-filename section) path))
+ (modb-standard-entity-filename (car section)) path))
+ (handler (elmo-msgdb-message-entity-handler modb))
entity entities)
- (dolist (number (modb-standard-number-list-internal modb))
- (when (and (or (null section)
- (= section (/ number modb-standard-divide-number)))
- (setq entity (elmo-msgdb-message-entity modb number)))
- (setq entities (cons entity entities))))
+ (dolist (number (or (cdr section)
+ (modb-standard-number-list-internal modb)))
+ (when (setq entity (elmo-msgdb-message-entity modb number))
+ (unless (modb-entity-handler-equal-p
+ handler
+ (elmo-message-entity-handler entity))
+ (setq entity (elmo-msgdb-copy-message-entity
+ (elmo-message-entity-handler entity)
+ entity handler)))
+ (setq entities (cons (cdr (cdr entity)) entities))))
(if entities
- (elmo-object-save filename entities)
+ (elmo-object-save filename
+ (nconc
+ (list (luna-class-name handler)
+ (modb-entity-handler-dump-parameters handler))
+ entities))
(ignore-errors (delete-file filename)))))
+(defun modb-standard-cleanup-stale-entities (modb path)
+ (message "Removing stale entities...")
+ (let* ((entity-regex
+ (concat "^" modb-standard-entity-filename "-\\([0-9]+\\)"))
+ (entities (elmo-uniq-list
+ (mapcar
+ (lambda (x) (/ x modb-standard-divide-number))
+ (modb-standard-number-list-internal modb))))
+ (files (mapcar (lambda(x)
+ (when (string-match entity-regex x)
+ (string-to-number (match-string 1 x))))
+ (directory-files path nil entity-regex))))
+ (dolist (entity (car (elmo-list-diff-nonsortable files entities)))
+ (ignore-errors (delete-file
+ (expand-file-name
+ (modb-standard-entity-filename entity) path))))))
+
(defun modb-standard-save-entity (modb path)
- (let ((sections (modb-generic-message-modified-internal modb)))
- (cond ((listp sections)
- (dolist (section sections)
- (modb-standard-save-entity-1 modb path section)))
- (sections
- (modb-standard-save-entity-1 modb path)))))
+ (let ((modified (modb-generic-message-modified-internal modb)))
+ (cond ((listp modified)
+ (let ((sections (mapcar 'list modified))
+ section)
+ (dolist (number (modb-standard-number-list-internal modb))
+ (when (setq section (assq (/ number modb-standard-divide-number)
+ sections))
+ (nconc section (list number))))
+ (dolist (section sections)
+ (modb-standard-save-entity-1 modb path section))))
+ (modified
+ (modb-standard-cleanup-stale-entities modb path)))))
;;; Implement
;;
t)))
(luna-define-method elmo-msgdb-save ((msgdb modb-standard))
- (let ((path (elmo-msgdb-location msgdb)))
+ (let ((path (elmo-msgdb-location msgdb))
+ (inhibit-quit t))
(when (elmo-msgdb-message-modified-p msgdb)
(modb-standard-save-msgid msgdb path)
(modb-standard-save-entity msgdb path)
(symbol-value atom)
table))
(modb-standard-flag-map msgdb-append)))
+ ;; flag-count
+ (dolist (pair (modb-standard-flag-count-internal msgdb-append))
+ (modb-standard-countup-flags msgdb (list (car pair)) (cdr pair)))
;; modification flags
(dolist (number (modb-standard-number-list-internal msgdb-append))
(modb-standard-set-message-modified msgdb number)
(luna-define-method elmo-msgdb-clear :after ((msgdb modb-standard))
(modb-standard-set-number-list-internal msgdb nil)
(modb-standard-set-entity-map-internal msgdb nil)
- (modb-standard-set-flag-map-internal msgdb nil))
+ (modb-standard-set-flag-map-internal msgdb nil)
+ (modb-standard-set-flag-count-internal msgdb nil))
(luna-define-method elmo-msgdb-length ((msgdb modb-standard))
(length (modb-standard-number-list-internal msgdb)))
+(luna-define-method elmo-msgdb-flag-available-p ((msgdb modb-standard) flag)
+ t)
+
(luna-define-method elmo-msgdb-flags ((msgdb modb-standard) number)
(modb-standard-message-flags msgdb number))
(uncached
(elmo-msgdb-unset-flag msgdb number 'cached))
(t
- (let* ((cur-flags (modb-standard-message-flags msgdb number))
- (new-flags (copy-sequence cur-flags)))
- (and (memq 'new new-flags)
- (setq new-flags (delq 'new new-flags)))
- (or (memq flag new-flags)
- (setq new-flags (cons flag new-flags)))
- (when (and (eq flag 'unread)
- (memq 'answered new-flags))
- (setq new-flags (delq 'answered new-flags)))
- (unless (equal new-flags cur-flags)
+ (let ((cur-flags (modb-standard-message-flags msgdb number))
+ new-flags diff)
+ (unless (memq flag cur-flags)
+ (setq new-flags (cons flag cur-flags))
+ (setq diff (elmo-list-diff-nonsortable new-flags cur-flags))
+ (modb-standard-countup-flags msgdb (car diff))
+ (modb-standard-countup-flags msgdb (cadr diff) -1)
(elmo-set-hash-val (modb-standard-key number)
(cons number new-flags)
(modb-standard-flag-map msgdb))
(elmo-msgdb-set-flag msgdb number 'unread))
(uncached
(elmo-msgdb-set-flag msgdb number 'cached))
+ (all
+ (modb-standard-countup-flags msgdb
+ (modb-standard-message-flags msgdb number)
+ -1)
+ (elmo-clear-hash-val (modb-standard-key number)
+ (modb-standard-flag-map msgdb)))
(t
- (let* ((cur-flags (modb-standard-message-flags msgdb number))
- (new-flags (copy-sequence cur-flags)))
- (and (memq 'new new-flags)
- (setq new-flags (delq 'new new-flags)))
- (and (memq flag new-flags)
- (setq new-flags (delq flag new-flags)))
- (when (and (eq flag 'unread)
- (memq 'answered new-flags))
- (setq new-flags (delq 'answered new-flags)))
- (unless (equal new-flags cur-flags)
+ (let ((cur-flags (modb-standard-message-flags msgdb number))
+ (inhibit-quit t)
+ new-flags diff)
+ (when (memq flag cur-flags)
+ (setq new-flags (delq flag (copy-sequence cur-flags)))
+ (setq diff (elmo-list-diff-nonsortable new-flags cur-flags))
+ (modb-standard-countup-flags msgdb (car diff))
+ (modb-standard-countup-flags msgdb (cadr diff) -1)
(elmo-set-hash-val (modb-standard-key number)
(cons number new-flags)
(modb-standard-flag-map msgdb))
- (modb-standard-set-flag-modified msgdb number))))))
+ (modb-standard-set-flag-modified msgdb number))
+ (when (eq flag 'unread)
+ (elmo-msgdb-unset-flag msgdb number 'new))))))
+
+(luna-define-method elmo-msgdb-flag-count ((msgdb modb-standard))
+ (modb-standard-flag-count-internal msgdb))
(luna-define-method elmo-msgdb-list-messages ((msgdb modb-standard))
(copy-sequence
(dolist (number (modb-standard-number-list-internal msgdb))
(unless (memq 'unread (modb-standard-message-flags msgdb number))
(setq matched (cons number matched)))))
- (digest
- (mapatoms
- (lambda (atom)
- (setq entry (symbol-value atom))
- (when (modb-standard-match-flags '(unread important)
- (cdr entry))
- (setq matched (cons (car entry) matched))))
- (modb-standard-flag-map msgdb)))
+ (uncached
+ (dolist (number (modb-standard-number-list-internal msgdb))
+ (unless (memq 'cached (modb-standard-message-flags msgdb number))
+ (setq matched (cons number matched)))))
(any
(mapatoms
(lambda (atom)
(setq entry (symbol-value atom))
- (when (modb-standard-match-flags '(unread important answered)
- (cdr entry))
+ (unless (and (eq (length (cdr entry)) 1)
+ (eq (car (cdr entry)) 'cached))
+ ;; If there is a flag other than cached, then the message
+ ;; matches to `any'.
(setq matched (cons (car entry) matched))))
(modb-standard-flag-map msgdb)))
+ (digest
+ (let ((flags (append elmo-digest-flags
+ (elmo-get-global-flags t t))))
+ (mapatoms
+ (lambda (atom)
+ (setq entry (symbol-value atom))
+ (when (modb-standard-match-flags flags (cdr entry))
+ (setq matched (cons (car entry) matched))))
+ (modb-standard-flag-map msgdb))))
(t
(mapatoms
(lambda (atom)
(modb-standard-flag-map msgdb))))
matched))
+(luna-define-method elmo-msgdb-search ((msgdb modb-standard)
+ 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
+ (modb-standard-number-list-internal 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-standard)
entity &optional flags)
- (let ((number (elmo-msgdb-overview-entity-get-number entity))
- (msg-id (elmo-msgdb-overview-entity-get-id entity))
- duplicate)
- ;; number-list
- (modb-standard-set-number-list-internal
- msgdb
- (nconc (modb-standard-number-list-internal msgdb)
- (list number)))
- ;; entity-map
- (let ((table (modb-standard-entity-map msgdb)))
- (setq duplicate (elmo-get-hash-val msg-id table))
- (elmo-set-hash-val (modb-standard-key number) entity table)
- (elmo-set-hash-val msg-id entity table))
- ;; modification flags
- (modb-standard-set-message-modified msgdb number)
- ;; flag-map
- (when flags
- (elmo-set-hash-val
- (modb-standard-key number)
- (cons number flags)
- (modb-standard-flag-map msgdb))
- (modb-standard-set-flag-modified msgdb number))
- duplicate))
+ (when entity
+ (let ((number (elmo-msgdb-message-entity-number
+ (elmo-message-entity-handler entity) entity))
+ (msg-id (elmo-msgdb-message-entity-field
+ (elmo-message-entity-handler entity) entity 'message-id))
+ duplicate)
+ (when (and number msg-id)
+ ;; number-list
+ (modb-standard-set-number-list-internal
+ msgdb
+ (nconc (modb-standard-number-list-internal msgdb)
+ (list number)))
+ ;; entity-map
+ (let ((table (modb-standard-entity-map msgdb)))
+ (setq duplicate (elmo-get-hash-val msg-id table))
+ (elmo-set-hash-val (modb-standard-key number) entity table)
+ (elmo-set-hash-val msg-id entity table))
+ ;; modification flags
+ (modb-standard-set-message-modified msgdb number)
+ ;; flag-map
+ (when flags
+ (elmo-set-hash-val
+ (modb-standard-key number)
+ (cons number flags)
+ (modb-standard-flag-map msgdb))
+ (modb-standard-countup-flags msgdb flags)
+ (modb-standard-set-flag-modified msgdb number))
+ duplicate))))
+
+(luna-define-method elmo-msgdb-update-entity ((msgdb modb-standard)
+ entity values)
+ (let ((handler (elmo-message-entity-handler entity)))
+ (when (elmo-msgdb-message-entity-update-fields handler entity values)
+ (modb-standard-set-message-modified
+ msgdb
+ (elmo-msgdb-message-entity-number handler entity))
+ t)))
(luna-define-method elmo-msgdb-delete-messages ((msgdb modb-standard)
numbers)
(dolist (number numbers)
(setq key (modb-standard-key number)
entity (elmo-get-hash-val key entity-map))
- ;; number-list
- (setq number-list (delq number number-list))
- ;; entity-map
- (elmo-clear-hash-val key entity-map)
- (elmo-clear-hash-val (modb-standard-entity-id entity) entity-map)
- ;; flag-map
- (elmo-clear-hash-val key flag-map)
- (modb-standard-set-message-modified msgdb number)
- (modb-standard-set-flag-modified msgdb number))
+ (when entity
+ ;; number-list
+ (setq number-list (delq number number-list))
+ ;; entity-map
+ (elmo-clear-hash-val key entity-map)
+ (elmo-clear-hash-val (modb-standard-entity-id entity) entity-map)
+ ;; flag-count (must be BEFORE flag-map)
+ (modb-standard-countup-flags
+ msgdb
+ (modb-standard-message-flags msgdb number)
+ -1)
+ ;; flag-map
+ (elmo-clear-hash-val key flag-map)
+ (modb-standard-set-message-modified msgdb number)
+ (modb-standard-set-flag-modified msgdb number)))
(modb-standard-set-number-list-internal msgdb number-list)
(modb-standard-set-entity-map-internal msgdb entity-map)
- (modb-standard-set-flag-map-internal msgdb flag-map)))
+ (modb-standard-set-flag-map-internal msgdb flag-map)
+ t))
(luna-define-method elmo-msgdb-sort-entities ((msgdb modb-standard)
predicate &optional app-data)
(message "Sorting...done")
msgdb))
-(luna-define-method elmo-msgdb-message-entity ((msgdb modb-standard) key)
+(defun modb-standard-message-entity (msgdb key load)
(let ((ret (elmo-get-hash-val
- (cond ((stringp key) key)
- ((numberp key) (modb-standard-key key)))
- (modb-standard-entity-map-internal msgdb))))
+ key
+ (modb-standard-entity-map-internal msgdb)))
+ (inhibit-quit t))
(if (eq 'autoload (car-safe ret))
- (when modb-standard-divide-number
+ (when (and load modb-standard-divide-number)
(modb-standard-load-entity
msgdb
(elmo-msgdb-location msgdb)
(/ (nth 1 ret) modb-standard-divide-number))
- (elmo-get-hash-val
- (cond ((stringp key) key)
- ((numberp key) (modb-standard-key key)))
- (modb-standard-entity-map-internal msgdb)))
+ (modb-standard-message-entity msgdb key nil))
ret)))
-;;; Message entity handling.
-(defsubst modb-standard-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-standard)
- args)
- (modb-standard-make-message-entity args))
-
-(luna-define-method elmo-msgdb-create-message-entity-from-file
- ((msgdb modb-standard) 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-standard) 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-standard-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 '(number message-id 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-field ((msgdb modb-standard)
- 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-standard)
- 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-standard)
- entity)
- (cons (car entity)
- (copy-sequence (cdr entity))))
-
-(luna-define-method elmo-msgdb-match-condition-internal ((msgdb modb-standard)
- 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)))))))
+(luna-define-method elmo-msgdb-message-number ((msgdb modb-standard)
+ message-id)
+ (let ((ret (elmo-get-hash-val
+ message-id
+ (modb-standard-entity-map-internal msgdb))))
+ (if (eq 'autoload (car-safe ret))
+ ;; Not loaded yet but can return number.
+ (nth 1 ret)
+ (elmo-message-entity-number ret))))
+
+(luna-define-method elmo-msgdb-message-field ((msgdb modb-standard)
+ number field &optional type)
+ (let ((ret (elmo-get-hash-val
+ (modb-standard-key number)
+ (modb-standard-entity-map-internal msgdb))))
+ (if (and (eq 'autoload (car-safe ret)) (eq field 'message-id))
+ ;; Not loaded yet but can return message-id
+ (cdr (cdr ret))
+ (elmo-message-entity-field (elmo-msgdb-message-entity
+ msgdb (modb-standard-key number))
+ field type))))
+
+(luna-define-method elmo-msgdb-message-entity ((msgdb modb-standard) key)
+ (when key
+ (modb-standard-message-entity
+ msgdb
+ (cond ((stringp key) key)
+ ((numberp key) (modb-standard-key key)))
+ 'autoload)))
+
+(luna-define-method elmo-msgdb-message-entity-handler ((msgdb modb-standard))
+ (or (modb-standard-overview-handler-internal msgdb)
+ (modb-standard-set-overview-handler-internal
+ msgdb
+ (luna-make-entity 'modb-standard-entity-handler
+ :mime-charset
+ (modb-generic-mime-charset-internal msgdb)))))
(require 'product)
(product-provide (provide 'modb-standard) (require 'elmo-version))
projects / elisp / wanderlust.git / blobdiff