From: hmurata Date: Mon, 15 Sep 2003 06:22:52 +0000 (+0000) Subject: * modb.el: New file. X-Git-Tag: wl-2_11_14~4 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=f4aed41040236d1fc835dd7bc475a2d8c3e611ec;p=elisp%2Fwanderlust.git * modb.el: New file. * modb-entity.el: Ditto. * modb-legacy.el: Ditto. * elmo-msgdb.el (elmo-make-msgdb): Added 2nd argument `type'. (elmo-msgdb-get-number): Use `elmo-msgdb-message-entity' instead of `elmo-msgdb-overview-get-entity'. (elmo-msgdb-get-field): Ditto. (elmo-msgdb-merge): Moved to `elmo.el'. (elmo-msgdb-length): Removed; redefine as modb method. (elmo-msgdb-change-mark): Abolish. (elmo-msgdb-out-of-date-messages): Rewrite; don't use it. (elmo-msgdb-match-condition): Don't use mark. (elmo-msgdb-overview-get-entity): Abolish. Split modb part into `modb*.el'. * elmo-vars.el (elmo-msgdb-default-type): New user option. * elmo-shimbun.el (shimbun-mua-search-id): Use `elmo-msgdb-message-entity' instead of `elmo-msgdb-overview-get-entity'. (elmo-shimbun-folder-shimbun-header): Ditto. (elmo-shimbun-get-headers): Ditto. (elmo-shimbun-update-overview): Ditto. * elmo-mime.el (elmo-mime-display-as-is): Ditto. * elmo-filter.el (elmo-folder-msgdb-create): Ditto. * elmo.el (elmo-folder-list-messages-with-global-mark): Ditto. (elmo-msgdb-merge): Moved from `elmo-msgdb.el'. * elmo-mark.el (elmo-mark-folder-msgdb-create): Don't use `elmo-msgdb-mark-to-flags'. * elmo-map.el (elmo-folder-pack-numbers): Don't use `elmo-msgdb-set-path'. * elmo-localdir.el (elmo-folder-pack-numbers): Ditto. * WL-ELS (ELMO-MODULES): Added `modb', `modb-entity' and `modb-legacy'. --- diff --git a/ChangeLog b/ChangeLog index 33a6db3..3017bbb 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2003-09-15 Hiroya Murata + + * WL-ELS (ELMO-MODULES): Added `modb', `modb-entity' and + `modb-legacy'. + 2003-09-14 Hiroya Murata * WL-MK (update-version): Bind `coding-system-for-write' to diff --git a/WL-ELS b/WL-ELS index 99f3a1b..71f27d3 100644 --- a/WL-ELS +++ b/WL-ELS @@ -22,6 +22,7 @@ elmo-archive elmo-pipe elmo-cache elmo-internal elmo-mark elmo-sendlog elmo-dop elmo-nmz elmo-split + modb modb-entity modb-legacy )) diff --git a/elmo/ChangeLog b/elmo/ChangeLog index 37928f0..287e034 100644 --- a/elmo/ChangeLog +++ b/elmo/ChangeLog @@ -1,5 +1,47 @@ 2003-09-15 Hiroya Murata + * modb.el: New file. + + * modb-entity.el: Ditto. + + * modb-legacy.el: Ditto. + + * elmo-msgdb.el (elmo-make-msgdb): Added 2nd argument `type'. + (elmo-msgdb-get-number): Use `elmo-msgdb-message-entity' instead + of `elmo-msgdb-overview-get-entity'. + (elmo-msgdb-get-field): Ditto. + (elmo-msgdb-merge): Moved to `elmo.el'. + (elmo-msgdb-length): Removed; redefine as modb method. + (elmo-msgdb-change-mark): Abolish. + (elmo-msgdb-out-of-date-messages): Rewrite; don't use it. + (elmo-msgdb-match-condition): Don't use mark. + (elmo-msgdb-overview-get-entity): Abolish. + Split modb part into `modb*.el'. + + * elmo-vars.el (elmo-msgdb-default-type): New user option. + + * elmo-shimbun.el (shimbun-mua-search-id): Use + `elmo-msgdb-message-entity' instead of + `elmo-msgdb-overview-get-entity'. + (elmo-shimbun-folder-shimbun-header): Ditto. + (elmo-shimbun-get-headers): Ditto. + (elmo-shimbun-update-overview): Ditto. + + * elmo-mime.el (elmo-mime-display-as-is): Ditto. + + * elmo-filter.el (elmo-folder-msgdb-create): Ditto. + + * elmo.el (elmo-folder-list-messages-with-global-mark): Ditto. + (elmo-msgdb-merge): Moved from `elmo-msgdb.el'. + + * elmo-mark.el (elmo-mark-folder-msgdb-create): Don't use + `elmo-msgdb-mark-to-flags'. + + * elmo-map.el (elmo-folder-pack-numbers): Don't use + `elmo-msgdb-set-path'. + + * elmo-localdir.el (elmo-folder-pack-numbers): Ditto. + * elmo-version.el (elmo-version): Up to 2.11.13. * elmo.el (elmo-generic-folder-commit): Don't load msgdb. diff --git a/elmo/elmo-filter.el b/elmo/elmo-filter.el index 1293f4b..9061389 100644 --- a/elmo/elmo-filter.el +++ b/elmo/elmo-filter.el @@ -129,7 +129,7 @@ len "Creating msgdb...")) (unwind-protect (dolist (number numlist) - (setq entity (elmo-msgdb-overview-get-entity number msgdb)) + (setq entity (elmo-msgdb-message-entity msgdb number)) (when entity (elmo-msgdb-append-entity new-msgdb entity (elmo-msgdb-flags msgdb number))) diff --git a/elmo/elmo-localdir.el b/elmo/elmo-localdir.el index 32e0125..a313c5d 100644 --- a/elmo/elmo-localdir.el +++ b/elmo/elmo-localdir.el @@ -326,7 +326,7 @@ (luna-define-method elmo-folder-pack-numbers ((folder elmo-localdir-folder)) (let* ((dir (elmo-localdir-folder-directory-internal folder)) (msgdb (elmo-folder-msgdb folder)) - (new-msgdb (elmo-make-msgdb)) + (new-msgdb (elmo-make-msgdb (elmo-folder-msgdb-path folder))) (numbers (sort (elmo-folder-list-messages folder nil @@ -334,7 +334,6 @@ '<)) (new-number 1) ; first ordinal position in localdir total entity) - (elmo-msgdb-set-path new-msgdb (elmo-folder-msgdb-path folder)) (setq total (length numbers)) (elmo-with-progress-display (> total elmo-display-progress-threshold) (elmo-folder-pack-numbers total "Packing...") diff --git a/elmo/elmo-map.el b/elmo/elmo-map.el index aafd7a8..6a383d4 100644 --- a/elmo/elmo-map.el +++ b/elmo/elmo-map.el @@ -139,10 +139,9 @@ (luna-define-method elmo-folder-pack-numbers ((folder elmo-map-folder)) (let* ((msgdb (elmo-folder-msgdb folder)) (numbers (sort (elmo-folder-list-messages folder nil 'in-msgdb) '<)) - (new-msgdb (elmo-make-msgdb)) + (new-msgdb (elmo-make-msgdb (elmo-folder-msgdb-path folder))) (number 1) total location entity) - (elmo-msgdb-set-path new-msgdb (elmo-folder-msgdb-path folder)) (setq total (length numbers)) (elmo-with-progress-display (> total elmo-display-progress-threshold) (elmo-folder-pack-numbers total "Packing...") diff --git a/elmo/elmo-mark.el b/elmo/elmo-mark.el index 26dbe84..beb9873 100644 --- a/elmo/elmo-mark.el +++ b/elmo/elmo-mark.el @@ -100,8 +100,7 @@ (when entity (elmo-msgdb-append-entity new-msgdb entity - (elmo-msgdb-mark-to-flags - (elmo-mark-folder-mark-internal folder)))) + '(important cached))) (when (> len elmo-display-progress-threshold) (setq i (1+ i)) (elmo-display-progress diff --git a/elmo/elmo-mime.el b/elmo/elmo-mime.el index 0fa6fa0..f0a1b52 100644 --- a/elmo/elmo-mime.el +++ b/elmo/elmo-mime.el @@ -254,8 +254,7 @@ If optional argument IGNORE-CACHE is specified, existing cache is ignored. If second optional argument UNREAD is specified, message is displayed but keep it as unread. Return non-nil if cache is used." - (let ((entity (elmo-msgdb-overview-get-entity number - (elmo-folder-msgdb folder))) + (let ((entity (elmo-msgdb-message-entity (elmo-folder-msgdb folder) number)) mime-display-header-hook ; Do nothing. cache-file strategy use-cache) (when entity diff --git a/elmo/elmo-msgdb.el b/elmo/elmo-msgdb.el index e75431d..939f418 100644 --- a/elmo/elmo-msgdb.el +++ b/elmo/elmo-msgdb.el @@ -37,6 +37,8 @@ (require 'emu) (require 'std11) (require 'mime) +(require 'modb) +(require 'modb-entity) (defconst elmo-msgdb-new-mark "N" "Mark for new message.") @@ -62,65 +64,20 @@ ;;; MSGDB interface. ;; ;; MSGDB elmo-load-msgdb PATH -;; MARK elmo-msgdb-get-mark MSGDB NUMBER -;; CACHED elmo-msgdb-get-cached MSGDB NUMBER -;; VOID elmo-msgdb-set-cached MSGDB NUMBER CACHED USE-CACHE -;; VOID elmo-msgdb-set-flag MSGDB FOLDER NUMBER FLAG -;; VOID elmo-msgdb-unset-flag MSGDB FOLDER NUMBER FLAG - -;; LIST-OF-NUMBERS elmo-msgdb-count-marks MSGDB ;; NUMBER elmo-msgdb-get-number MSGDB MESSAGE-ID ;; FIELD-VALUE elmo-msgdb-get-field MSGDB NUMBER FIELD -;; MSGDB elmo-msgdb-append MSGDB MSGDB-APPEND -;; MSGDB elmo-msgdb-clear MSGDB -;; elmo-msgdb-delete-messages MSGDB NUMBERS ;; elmo-msgdb-sort-by-date MSGDB -;;; -;; LIST-OF-NUMBERS elmo-msgdb-list-messages MSGDB - ;; elmo-flag-table-load ;; elmo-flag-table-set ;; elmo-flag-table-get ;; elmo-flag-table-save -;; elmo-msgdb-append-entity MSGDB ENTITY MARK-OR-FLAGS - -;; ENTITY elmo-msgdb-make-entity ARGS -;; VALUE elmo-msgdb-entity-field ENTITY -;; - -;; OVERVIEW elmo-msgdb-get-overview MSGDB -;; NUMBER-ALIST elmo-msgdb-get-number-alist MSGDB -;; MARK-ALIST elmo-msgdb-get-mark-alist MSGDB -;; elmo-msgdb-change-mark MSGDB BEFORE AFTER - -;; (for internal use?) -;; LIST-OF-MARKS elmo-msgdb-unread-marks -;; LIST-OF-MARKS elmo-msgdb-answered-marks -;; LIST-OF-MARKS elmo-msgdb-uncached-marks ;; elmo-msgdb-overview-save DIR OBJ -;; elmo-msgdb-message-entity MSGDB KEY - ;;; Abolish -;; elmo-msgdb-overview-entity-get-references ENTITY -;; elmo-msgdb-overview-entity-set-references ENTITY ;; elmo-msgdb-get-parent-entity ENTITY MSGDB -;; elmo-msgdb-overview-enitty-get-number ENTITY -;; elmo-msgdb-overview-enitty-get-from-no-decode ENTITY -;; elmo-msgdb-overview-enitty-get-from ENTITY -;; elmo-msgdb-overview-enitty-get-subject-no-decode ENTITY -;; elmo-msgdb-overview-enitty-get-subject ENTITY -;; elmo-msgdb-overview-enitty-get-date ENTITY -;; elmo-msgdb-overview-enitty-get-to ENTITY -;; elmo-msgdb-overview-enitty-get-cc ENTITY -;; elmo-msgdb-overview-enitty-get-size ENTITY -;; elmo-msgdb-overview-enitty-get-id ENTITY -;; elmo-msgdb-overview-enitty-get-extra-field ENTITY -;; elmo-msgdb-overview-enitty-get-extra ENTITY -;; elmo-msgdb-overview-get-entity ID MSGDB ;; elmo-msgdb-killed-list-load DIR ;; elmo-msgdb-killed-list-save DIR @@ -129,6 +86,7 @@ ;; 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 @@ -138,493 +96,55 @@ ;; elmo-crosspost-alist-save ;; elmo-msgdb-create-overview-from-buffer NUMBER SIZE TIME -;; elmo-msgdb-copy-overview-entity ENTITY ;; elmo-msgdb-create-overview-entity-from-file NUMBER FILE -;; elmo-msgdb-clear-index ;; elmo-folder-get-info ;; elmo-folder-get-info-max ;; elmo-folder-get-info-length ;; elmo-folder-get-info-unread -;; elmo-msgdb-list-flagged MSGDB FLAG -;; (MACRO) elmo-msgdb-do-each-entity - -;;; MSGDB interface -;; -(eval-and-compile - (luna-define-class elmo-msgdb () (location ; location for save. - message-modified ; message is modified. - flag-modified ; flag is modified. - )) - (luna-define-internal-accessors 'elmo-msgdb)) - -(luna-define-generic elmo-msgdb-load (msgdb) - "Load the MSGDB.") - -(luna-define-generic elmo-msgdb-save (msgdb) - "Save the MSGDB.") - -(luna-define-generic elmo-msgdb-location (msgdb) - "Return the location of MSGDB.") - -(luna-define-generic elmo-msgdb-message-modified-p (msgdb) - "Return non-nil if message is modified.") - -(luna-define-generic elmo-msgdb-flag-modified-p (msgdb) - "Return non-nil if flag is modified.") - -(luna-define-generic elmo-msgdb-append (msgdb msgdb-append) - "Append the MSGDB-APPEND to the MSGDB. -Return a list of messages which have duplicated message-id.") - -(luna-define-generic elmo-msgdb-clear (msgdb) - "Clear the MSGDB structure.") - -(luna-define-generic elmo-msgdb-flags (msgdb number) - "Return a list of flag which corresponds to the message with NUMBER.") - -(luna-define-generic elmo-msgdb-set-flag (msgdb number flag) - "Set message flag. -MSGDB is the ELMO msgdb. -NUMBER is a message number to set flag. -FLAG is a symbol which is one of the following: -`new' ... Message which is new. -`read' ... Message which is already read. -`important' ... Message which is marked as important. -`answered' ... Message which is marked as answered. -`cached' ... Message which is cached.") - -(luna-define-generic elmo-msgdb-unset-flag (msgdb number flag) - "Unset message flag. -MSGDB is the ELMO msgdb. -NUMBER is a message number to set flag. -FLAG is a symbol which is one of the following: -`new' ... Message which is new. -`read' ... Message which is already read. -`important' ... Message which is marked as important. -`answered' ... Message which is marked as answered. -`cached' ... Message which is cached.") - -(luna-define-generic elmo-msgdb-list-messages (msgdb) - "Return a list of message numbers in the MSGDB.") - -(luna-define-generic elmo-msgdb-list-flagged (msgdb flag) - "Return a list of message numbers which is set FLAG in the MSGDB.") - -;;; (luna-define-generic elmo-msgdb-search (msgdb condition &optional numbers) -;;; "Search and return list of message numbers. -;;; MSGDB is the ELMO msgdb structure. -;;; CONDITION is a condition structure for searching. -;;; If optional argument NUMBERS is specified and is a list of message numbers, -;;; messages are searched from the list.") - -(luna-define-generic elmo-msgdb-append-entity (msgdb entity &optional flags) - "Append a ENTITY with FLAGS into the MSGDB. -Return non-nil if message-id of entity is duplicated.") - -(luna-define-generic elmo-msgdb-delete-messages (msgdb numbers) - "Delete messages which are contained NUMBERS from MSGDB.") - -(luna-define-generic elmo-msgdb-sort-entities (msgdb predicate &optional app-data) - "Sort entities of MSGDB, comparing with PREDICATE. -PREDICATE is called with two entities and APP-DATA. -Should return non-nil if the first entity is \"less\" than the second.") - -(luna-define-generic elmo-msgdb-message-entity (msgdb key) - "Return the message-entity structure which matches to the KEY. -KEY is a number or a string. -A number is for message number in the MSGDB. -A string is for message-id of the message.") - -;;; generic implement +;;; Helper functions for MSGDB ;; -(luna-define-method elmo-msgdb-location ((msgdb elmo-msgdb)) - (elmo-msgdb-location-internal msgdb)) - -(luna-define-method elmo-msgdb-message-modified-p ((msgdb elmo-msgdb)) - (elmo-msgdb-message-modified-internal msgdb)) - -(luna-define-method elmo-msgdb-flag-modified-p ((msgdb elmo-msgdb)) - (elmo-msgdb-flag-modified-internal msgdb)) - -(luna-define-method elmo-msgdb-clear ((msgdb elmo-msgdb)) - (elmo-msgdb-set-message-modified-internal msgdb nil) - (elmo-msgdb-set-flag-modified-internal msgdb nil)) - -(luna-define-method elmo-msgdb-append ((msgdb elmo-msgdb) msgdb-append) - (let (duplicates) - (dolist (number (elmo-msgdb-list-messages msgdb-append)) - (when (elmo-msgdb-append-entity - msgdb - (elmo-msgdb-message-entity msgdb-append number) - (elmo-msgdb-flags msgdb-append number)) - (setq duplicates (cons number duplicates)))) - duplicates)) - - -;;; legacy implement -;; -(eval-and-compile - (luna-define-class elmo-msgdb-legacy (elmo-msgdb) - (overview number-alist mark-alist index)) - (luna-define-internal-accessors 'elmo-msgdb-legacy)) - -;; for internal use only -(defsubst elmo-msgdb-get-overview (msgdb) - (elmo-msgdb-legacy-overview-internal msgdb)) - -(defsubst elmo-msgdb-get-number-alist (msgdb) - (elmo-msgdb-legacy-number-alist-internal msgdb)) - -(defsubst elmo-msgdb-get-mark-alist (msgdb) - (elmo-msgdb-legacy-mark-alist-internal msgdb)) - -(defsubst elmo-msgdb-get-index (msgdb) - (elmo-msgdb-legacy-index-internal msgdb)) - -(defsubst elmo-msgdb-get-entity-hashtb (msgdb) - (car (elmo-msgdb-legacy-index-internal msgdb))) - -(defsubst elmo-msgdb-get-mark-hashtb (msgdb) - (cdr (elmo-msgdb-legacy-index-internal msgdb))) - -(defsubst elmo-msgdb-get-path (msgdb) - (elmo-msgdb-location msgdb)) - -(defsubst elmo-msgdb-set-overview (msgdb overview) - (elmo-msgdb-legacy-set-overview-internal msgdb overview)) - -(defsubst elmo-msgdb-set-number-alist (msgdb number-alist) - (elmo-msgdb-legacy-set-number-alist-internal msgdb number-alist)) - -(defsubst elmo-msgdb-set-mark-alist (msgdb mark-alist) - (elmo-msgdb-legacy-set-mark-alist-internal msgdb mark-alist)) - -(defsubst elmo-msgdb-set-index (msgdb index) - (elmo-msgdb-legacy-set-index-internal msgdb index)) - -(defsubst elmo-msgdb-set-path (msgdb path) - (elmo-msgdb-set-location-internal msgdb path)) - - -;; -(luna-define-method elmo-msgdb-load ((msgdb elmo-msgdb-legacy)) - (let ((inhibit-quit t) - (path (elmo-msgdb-location msgdb))) - (when (file-exists-p (expand-file-name elmo-msgdb-mark-filename path)) - (elmo-msgdb-legacy-set-overview-internal - msgdb - (elmo-msgdb-overview-load path)) - (elmo-msgdb-legacy-set-number-alist-internal - msgdb - (elmo-msgdb-number-load path)) - (elmo-msgdb-legacy-set-mark-alist-internal - msgdb - (elmo-msgdb-mark-load path)) - (elmo-msgdb-make-index msgdb) - t))) - -(luna-define-method elmo-msgdb-save ((msgdb elmo-msgdb-legacy)) - (let ((path (elmo-msgdb-location msgdb))) - (when (elmo-msgdb-message-modified-p msgdb) - (elmo-msgdb-overview-save - path - (elmo-msgdb-legacy-overview-internal msgdb)) - (elmo-msgdb-number-save - path - (elmo-msgdb-legacy-number-alist-internal msgdb)) - (elmo-msgdb-set-message-modified-internal msgdb nil)) - (when (elmo-msgdb-flag-modified-p msgdb) - (elmo-msgdb-mark-save - path - (elmo-msgdb-legacy-mark-alist-internal msgdb)) - (elmo-msgdb-set-flag-modified-internal msgdb nil)))) - (defun elmo-load-msgdb (location) "Load the MSGDB from PATH." (let ((msgdb (elmo-make-msgdb location))) (elmo-msgdb-load msgdb) msgdb)) -(defun elmo-make-msgdb (&optional location) +(defun elmo-make-msgdb (&optional location type) "Make a MSGDB." - (luna-make-entity 'elmo-msgdb-legacy :location location)) - -(luna-define-method elmo-msgdb-list-messages ((msgdb elmo-msgdb-legacy)) - (mapcar 'elmo-msgdb-overview-entity-get-number - (elmo-msgdb-get-overview msgdb))) - -(defsubst elmo-msgdb-mark-to-flags (mark) - (append - (and (string= mark elmo-msgdb-new-mark) - '(new)) - (and (string= mark elmo-msgdb-important-mark) - '(important)) - (and (member mark (elmo-msgdb-unread-marks)) - '(unread)) - (and (member mark (elmo-msgdb-answered-marks)) - '(answered)) - (and (not (member mark (elmo-msgdb-uncached-marks))) - '(cached)))) - -(defsubst elmo-msgdb-flags-to-mark (flags) - (cond ((memq 'new flags) - elmo-msgdb-new-mark) - ((memq 'important flags) - elmo-msgdb-important-mark) - ((memq 'answered flags) - (if (memq 'cached flags) - elmo-msgdb-answered-cached-mark - elmo-msgdb-answered-uncached-mark)) - ((memq 'unread flags) - (if (memq 'cached flags) - elmo-msgdb-unread-cached-mark - elmo-msgdb-unread-uncached-mark)) - (t - (if (memq 'cached flags) - nil - elmo-msgdb-read-uncached-mark)))) - -(defsubst elmo-msgdb-get-mark (msgdb number) - "Get mark string from MSGDB which corresponds to the message with NUMBER." - (cadr (elmo-get-hash-val (format "#%d" number) - (elmo-msgdb-get-mark-hashtb msgdb)))) - -(defsubst elmo-msgdb-set-mark (msgdb number mark) - "Set MARK of the message with NUMBER in the MSGDB. -if MARK is nil, mark is removed." - (let ((elem (elmo-get-hash-val (format "#%d" number) - (elmo-msgdb-get-mark-hashtb msgdb)))) - (if elem - (if mark - ;; Set mark of the elem - (setcar (cdr elem) mark) - ;; Delete elem from mark-alist - (elmo-msgdb-set-mark-alist - msgdb - (delq elem (elmo-msgdb-get-mark-alist msgdb))) - (elmo-clear-hash-val (format "#%d" number) - (elmo-msgdb-get-mark-hashtb msgdb))) - (when mark - ;; Append new element. - (elmo-msgdb-set-mark-alist - msgdb - (nconc - (elmo-msgdb-get-mark-alist msgdb) - (list (setq elem (list number mark))))) - (elmo-set-hash-val (format "#%d" number) elem - (elmo-msgdb-get-mark-hashtb msgdb)))) - (elmo-msgdb-set-flag-modified-internal msgdb t) - ;; return value. - t)) - -(luna-define-method elmo-msgdb-flags ((msgdb elmo-msgdb-legacy) number) - (elmo-msgdb-mark-to-flags (elmo-msgdb-get-mark msgdb number))) - -(luna-define-method elmo-msgdb-set-flag ((msgdb elmo-msgdb-legacy) - number flag) - (case flag - (read - (elmo-msgdb-unset-flag msgdb number 'unread)) - (uncached - (elmo-msgdb-unset-flag msgdb number 'cached)) - (t - (let* ((cur-mark (elmo-msgdb-get-mark msgdb number)) - (flags (elmo-msgdb-mark-to-flags cur-mark)) - new-mark) - (and (memq 'new flags) - (setq flags (delq 'new flags))) - (or (memq flag flags) - (setq flags (cons flag flags))) - (when (and (eq flag 'unread) - (memq 'answered flags)) - (setq flags (delq 'answered flags))) - (setq new-mark (elmo-msgdb-flags-to-mark flags)) - (unless (string= new-mark cur-mark) - (elmo-msgdb-set-mark msgdb number new-mark)))))) - -(luna-define-method elmo-msgdb-unset-flag ((msgdb elmo-msgdb-legacy) - number flag) - (case flag - (read - (elmo-msgdb-set-flag msgdb number 'unread)) - (uncached - (elmo-msgdb-set-flag msgdb number 'cached)) - (t - (let* ((cur-mark (elmo-msgdb-get-mark msgdb number)) - (flags (elmo-msgdb-mark-to-flags cur-mark)) - new-mark) - (and (memq 'new flags) - (setq flags (delq 'new flags))) - (and (memq flag flags) - (setq flags (delq flag flags))) - (when (and (eq flag 'unread) - (memq 'answered flags)) - (setq flags (delq 'answered flags))) - (setq new-mark (elmo-msgdb-flags-to-mark flags)) - (unless (string= new-mark cur-mark) - (elmo-msgdb-set-mark msgdb number new-mark)))))) - -(defvar elmo-msgdb-unread-marks-internal nil) -(defsubst elmo-msgdb-unread-marks () - "Return an unread mark list" - (or elmo-msgdb-unread-marks-internal - (setq elmo-msgdb-unread-marks-internal - (list elmo-msgdb-new-mark - elmo-msgdb-unread-uncached-mark - elmo-msgdb-unread-cached-mark)))) - -(defvar elmo-msgdb-answered-marks-internal nil) -(defsubst elmo-msgdb-answered-marks () - "Return an answered mark list" - (or elmo-msgdb-answered-marks-internal - (setq elmo-msgdb-answered-marks-internal - (list elmo-msgdb-answered-cached-mark - elmo-msgdb-answered-uncached-mark)))) - -(defvar elmo-msgdb-uncached-marks-internal nil) -(defsubst elmo-msgdb-uncached-marks () - (or elmo-msgdb-uncached-marks-internal - (setq elmo-msgdb-uncached-marks-internal - (list elmo-msgdb-new-mark - elmo-msgdb-answered-uncached-mark - elmo-msgdb-unread-uncached-mark - elmo-msgdb-read-uncached-mark)))) - -(luna-define-method elmo-msgdb-append-entity ((msgdb elmo-msgdb-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)))) - (elmo-msgdb-set-message-modified-internal msgdb t) - (when (setq mark (elmo-msgdb-flags-to-mark flags)) - (elmo-msgdb-set-mark-alist - msgdb - (nconc (elmo-msgdb-get-mark-alist msgdb) - (list (list number mark)))) - (elmo-msgdb-set-flag-modified-internal msgdb t)) - (elmo-msgdb-make-index - msgdb - (list entity) - (list (list number mark)))))) + (let* ((type (or type elmo-msgdb-default-type)) + (class (intern (format "modb-%s" type)))) + (require class) + (luna-make-entity class + :location location))) (defsubst elmo-msgdb-get-number (msgdb message-id) "Get number of the message which corrensponds to MESSAGE-ID from MSGDB." (elmo-msgdb-overview-entity-get-number - (elmo-msgdb-overview-get-entity message-id msgdb))) + (elmo-msgdb-message-entity msgdb message-id))) (defsubst elmo-msgdb-get-field (msgdb number field) "Get FIELD value of the message with NUMBER from MSGDB." (case field (message-id (elmo-msgdb-overview-entity-get-id - (elmo-msgdb-overview-get-entity - number msgdb))) + (elmo-msgdb-message-entity + msgdb number))) (subject (elmo-msgdb-overview-entity-get-subject - (elmo-msgdb-overview-get-entity - number msgdb))) + (elmo-msgdb-message-entity + msgdb number))) (size (elmo-msgdb-overview-entity-get-size - (elmo-msgdb-overview-get-entity - number msgdb))) + (elmo-msgdb-message-entity + msgdb number))) (date (elmo-msgdb-overview-entity-get-date - (elmo-msgdb-overview-get-entity - number msgdb))) + (elmo-msgdb-message-entity + msgdb number))) (to (elmo-msgdb-overview-entity-get-to - (elmo-msgdb-overview-get-entity - number msgdb))) + (elmo-msgdb-message-entity + msgdb number))) (cc (elmo-msgdb-overview-entity-get-cc - (elmo-msgdb-overview-get-entity - number msgdb))))) - -(luna-define-method elmo-msgdb-append :around ((msgdb elmo-msgdb-legacy) - msgdb-append) - (if (eq (luna-class-name msgdb-append) - 'elmo-msgdb-legacy) - (let (duplicates) - (elmo-msgdb-set-overview - msgdb - (nconc (elmo-msgdb-get-overview msgdb) - (elmo-msgdb-get-overview msgdb-append))) - (elmo-msgdb-set-number-alist - msgdb - (nconc (elmo-msgdb-get-number-alist msgdb) - (elmo-msgdb-get-number-alist msgdb-append))) - (elmo-msgdb-set-mark-alist - msgdb - (nconc (elmo-msgdb-get-mark-alist msgdb) - (elmo-msgdb-get-mark-alist msgdb-append))) - (setq duplicates (elmo-msgdb-make-index - msgdb - (elmo-msgdb-get-overview msgdb-append) - (elmo-msgdb-get-mark-alist msgdb-append))) - (elmo-msgdb-set-path - msgdb - (or (elmo-msgdb-get-path msgdb) - (elmo-msgdb-get-path msgdb-append))) - (elmo-msgdb-set-message-modified-internal msgdb t) - (elmo-msgdb-set-flag-modified-internal msgdb t) - duplicates) - (luna-call-next-method))) - -(defun elmo-msgdb-merge (folder msgdb-merge) - "Return a list of messages which have duplicated message-id." - (let (msgdb duplicates) - (setq msgdb (or (elmo-folder-msgdb-internal folder) - (elmo-make-msgdb (elmo-folder-msgdb-path folder)))) - (setq duplicates (elmo-msgdb-append msgdb msgdb-merge)) - (elmo-folder-set-msgdb-internal folder msgdb) - duplicates)) - -(luna-define-method elmo-msgdb-clear :after ((msgdb elmo-msgdb-legacy)) - (elmo-msgdb-set-overview msgdb nil) - (elmo-msgdb-set-number-alist msgdb nil) - (elmo-msgdb-set-mark-alist msgdb nil) - (elmo-msgdb-set-index msgdb nil)) - -(luna-define-method elmo-msgdb-delete-messages ((msgdb elmo-msgdb-legacy) - numbers) - (let* ((overview (elmo-msgdb-get-overview msgdb)) - (number-alist (elmo-msgdb-get-number-alist msgdb)) - (mark-alist (elmo-msgdb-get-mark-alist msgdb)) - (index (elmo-msgdb-get-index msgdb)) - ov-entity) - ;; remove from current database. - (dolist (number numbers) - (setq overview - (delq - (setq ov-entity - (elmo-msgdb-overview-get-entity number msgdb)) - overview)) - (setq number-alist (delq (assq number number-alist) number-alist)) - (setq mark-alist (delq (assq number mark-alist) mark-alist)) - ;; - (when index (elmo-msgdb-clear-index msgdb ov-entity))) - (elmo-msgdb-set-overview msgdb overview) - (elmo-msgdb-set-number-alist msgdb number-alist) - (elmo-msgdb-set-mark-alist msgdb mark-alist) - (elmo-msgdb-set-index msgdb index) - (elmo-msgdb-set-message-modified-internal msgdb t) - (elmo-msgdb-set-flag-modified-internal msgdb t) - t)) ;return value - -(luna-define-method elmo-msgdb-sort-entities ((msgdb elmo-msgdb-legacy) - predicate &optional app-data) - (message "Sorting...") - (let ((overview (elmo-msgdb-get-overview msgdb))) - (elmo-msgdb-set-overview - msgdb - (sort overview (lambda (a b) (funcall predicate a b app-data)))) - (message "Sorting...done") - msgdb)) + (elmo-msgdb-message-entity + msgdb number))))) (defun elmo-msgdb-sort-by-date (msgdb) (elmo-msgdb-sort-entities @@ -718,9 +238,6 @@ if MARK is nil, mark is removed." (setq alist (elmo-msgdb-append-element alist (list id mark)))) -(defsubst elmo-msgdb-length (msgdb) - (length (elmo-msgdb-get-overview msgdb))) - (defun elmo-msgdb-flag-table (msgdb &optional flag-table) ;; Make a table of msgid flag (read, answered) (let ((flag-table (or flag-table @@ -735,28 +252,6 @@ if MARK is nil, mark is removed." flag-table)) ;; -;; 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))) - -;; ;; overview handling ;; (defun elmo-multiple-field-body (name &optional boundary) @@ -838,145 +333,15 @@ header separator." (expand-file-name elmo-msgdb-mark-filename dir) obj)) -(defun elmo-msgdb-change-mark (msgdb before after) - "Set the BEFORE marks to AFTER." - (let ((mark-alist (elmo-msgdb-get-mark-alist msgdb)) - entity) - (while mark-alist - (setq entity (car mark-alist)) - (when (string= (cadr entity) before) - (setcar (cdr entity) after)) - (setq mark-alist (cdr mark-alist))))) - (defsubst elmo-msgdb-out-of-date-messages (msgdb) - (elmo-msgdb-change-mark msgdb - elmo-msgdb-new-mark - elmo-msgdb-unread-uncached-mark)) + (dolist (number (elmo-msgdb-list-flagged msgdb 'new)) + (elmo-msgdb-unset-flag msgdb number 'new))) (defsubst elmo-msgdb-overview-save (dir overview) (elmo-object-save (expand-file-name elmo-msgdb-overview-filename dir) overview)) -(defun elmo-msgdb-match-condition-primitive (condition mark entity 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") - (not (or (null mark) - (string= mark elmo-msgdb-read-uncached-mark)))) - ((string= (elmo-filter-value condition) "digest") - (not (or (null mark) - (string= mark elmo-msgdb-read-uncached-mark) - (string= mark elmo-msgdb-answered-cached-mark) - (string= mark elmo-msgdb-answered-uncached-mark)))) -;; (member mark (append (elmo-msgdb-answered-marks) -;; (list elmo-msgdb-important-mark) -;; (elmo-msgdb-unread-marks)))) - ((string= (elmo-filter-value condition) "unread") - (member mark (elmo-msgdb-unread-marks))) - ((string= (elmo-filter-value condition) "important") - (string= mark elmo-msgdb-important-mark)) - ((string= (elmo-filter-value condition) "answered") - (member mark (elmo-msgdb-answered-marks)))))) - ((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)))) - -(defun elmo-msgdb-match-condition-internal (condition mark entity numbers) - (cond - ((vectorp condition) - (elmo-msgdb-match-condition-primitive condition mark entity numbers)) - ((eq (car condition) 'and) - (let ((lhs (elmo-msgdb-match-condition-internal (nth 1 condition) - mark entity numbers))) - (cond - ((elmo-filter-condition-p lhs) - (let ((rhs (elmo-msgdb-match-condition-internal - (nth 2 condition) mark entity numbers))) - (cond ((elmo-filter-condition-p rhs) - (list 'and lhs rhs)) - (rhs - lhs)))) - (lhs - (elmo-msgdb-match-condition-internal (nth 2 condition) - mark entity numbers))))) - ((eq (car condition) 'or) - (let ((lhs (elmo-msgdb-match-condition-internal (nth 1 condition) - mark entity numbers))) - (cond - ((elmo-filter-condition-p lhs) - (let ((rhs (elmo-msgdb-match-condition-internal (nth 2 condition) - mark entity numbers))) - (cond ((elmo-filter-condition-p rhs) - (list 'or lhs rhs)) - (rhs - t) - (t - lhs)))) - (lhs - t) - (t - (elmo-msgdb-match-condition-internal (nth 2 condition) - mark entity numbers))))))) - (defun elmo-msgdb-match-condition (msgdb condition number numbers) "Check whether the condition of the message is satisfied or not. MSGDB is the msgdb to search from. @@ -984,20 +349,14 @@ CONDITION is the search condition. NUMBER is the message number to check. NUMBERS is the target message number list. Return CONDITION itself if no entity exists in msgdb." - (let ((entity (elmo-msgdb-overview-get-entity number msgdb))) + (let ((entity (elmo-msgdb-message-entity msgdb number))) (if entity (elmo-msgdb-match-condition-internal condition - (elmo-msgdb-get-mark msgdb number) - entity numbers) + entity + (elmo-msgdb-flags msgdb number) + numbers) condition))) -(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) - ;; entity -> parent-entity (defsubst elmo-msgdb-overview-get-parent-entity (entity database) (setq entity (elmo-msgdb-overview-entity-get-references entity)) @@ -1007,145 +366,7 @@ Return CONDITION itself if no entity exists in msgdb." (defsubst elmo-msgdb-get-parent-entity (entity msgdb) (setq entity (elmo-msgdb-overview-entity-get-references entity)) ;; entity is parent-id. - (and entity (elmo-msgdb-overview-get-entity entity msgdb))) - -(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) - (elmo-msgdb-get-decoded-cache (aref (cdr entity) 2)))) - -(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) - (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-id (entity) - (and entity (car 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))))) - -(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) - -;;; New APIs -(luna-define-method elmo-msgdb-message-entity ((msgdb elmo-msgdb-legacy) key) - (elmo-get-hash-val - (cond ((stringp key) key) - ((numberp key) (format "#%d" key))) - (elmo-msgdb-get-entity-hashtb msgdb))) - -(defun elmo-msgdb-make-message-entity (&rest 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)))) - -(defsubst elmo-msgdb-message-entity-field (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)))) - -(defsubst elmo-msgdb-message-entity-set-field (entity field value) - (and entity - (case field - (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)))))))) - -;;; -(defun elmo-msgdb-overview-get-entity (id msgdb) - (elmo-msgdb-message-entity msgdb id)) + (and entity (elmo-msgdb-message-entity msgdb entity))) ;; ;; deleted message handling @@ -1294,10 +515,6 @@ Header region is supposed to be narrowed." size extra)) ))) -(defun elmo-msgdb-copy-overview-entity (entity) - (cons (car entity) - (copy-sequence (cdr entity)))) - (defsubst elmo-msgdb-insert-file-header (file) "Insert the header of the article." (let ((beg 0) @@ -1338,57 +555,6 @@ Header region is supposed to be narrowed." (narrow-to-region (point-min) header-end) (elmo-msgdb-create-overview-from-buffer number size mtime)))))) -(defun elmo-msgdb-clear-index (msgdb entity) - (let ((ehash (elmo-msgdb-get-entity-hashtb msgdb)) - (mhash (elmo-msgdb-get-mark-hashtb msgdb)) - number) - (when (and entity ehash) - (and (setq number (elmo-msgdb-overview-entity-get-number 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)) - (elmo-clear-hash-val (format "#%d" number) mhash))))) - -(defun elmo-msgdb-make-index (msgdb &optional overview mark-alist) - "Append OVERVIEW and MARK-ALIST to the index of MSGDB. -If OVERVIEW and MARK-ALIST are nil, make index for current MSGDB. -Return a list of message numbers which have duplicated message-ids." - (when msgdb - (let* ((overview (or overview (elmo-msgdb-get-overview msgdb))) - (mark-alist (or mark-alist (elmo-msgdb-get-mark-alist msgdb))) - (index (elmo-msgdb-get-index msgdb)) - (ehash (or (car index) ;; append - (elmo-make-hash (length overview)))) - (mhash (or (cdr index) ;; append - (elmo-make-hash (length overview)))) - duplicates) - (while overview - ;; key is message-id - (if (elmo-get-hash-val (caar overview) ehash) ; duplicated. - (setq duplicates (cons - (elmo-msgdb-overview-entity-get-number - (car overview)) - duplicates))) - (if (caar overview) - (elmo-set-hash-val (caar overview) (car overview) ehash)) - ;; key is number - (elmo-set-hash-val - (format "#%d" - (elmo-msgdb-overview-entity-get-number (car overview))) - (car overview) ehash) - (setq overview (cdr overview))) - (while mark-alist - ;; key is number - (elmo-set-hash-val - (format "#%d" (car (car mark-alist))) - (car mark-alist) mhash) - (setq mark-alist (cdr mark-alist))) - (setq index (or index (cons ehash mhash))) - (elmo-msgdb-set-index msgdb index) - duplicates))) - (defsubst elmo-folder-get-info (folder &optional hashtb) (elmo-get-hash-val folder (or hashtb elmo-folder-info-hashtb))) @@ -1421,41 +587,6 @@ Return a list of message numbers which have duplicated message-ids." elmo-msgdb-location-filename dir) alist)) -(luna-define-method elmo-msgdb-list-flagged ((msgdb elmo-msgdb-legacy) flag) - (let ((case-fold-search nil) - mark-regexp matched) - (case flag - (new - (setq mark-regexp (regexp-quote elmo-msgdb-new-mark))) - (unread - (setq mark-regexp (elmo-regexp-opt (elmo-msgdb-unread-marks)))) - (answered - (setq mark-regexp (elmo-regexp-opt (elmo-msgdb-answered-marks)))) - (important - (setq mark-regexp (regexp-quote elmo-msgdb-important-mark))) - (read - (setq mark-regexp (elmo-regexp-opt (elmo-msgdb-unread-marks)))) - (digest - (setq mark-regexp (elmo-regexp-opt - (append (elmo-msgdb-unread-marks) - (list elmo-msgdb-important-mark))))) - (any - (setq mark-regexp (elmo-regexp-opt - (append - (elmo-msgdb-unread-marks) - (elmo-msgdb-answered-marks) - (list elmo-msgdb-important-mark)))))) - (when mark-regexp - (if (eq flag 'read) - (dolist (number (elmo-msgdb-list-messages msgdb)) - (let ((mark (elmo-msgdb-get-mark msgdb number))) - (unless (and mark (string-match mark-regexp mark)) - (setq matched (cons number matched))))) - (dolist (elem (elmo-msgdb-get-mark-alist msgdb)) - (if (string-match mark-regexp (cadr elem)) - (setq matched (cons (car elem) matched)))))) - matched)) - (require 'product) (product-provide (provide 'elmo-msgdb) (require 'elmo-version)) diff --git a/elmo/elmo-shimbun.el b/elmo/elmo-shimbun.el index e8bb321..08415f7 100644 --- a/elmo/elmo-shimbun.el +++ b/elmo/elmo-shimbun.el @@ -92,9 +92,9 @@ update overview when message is fetched." (luna-define-internal-accessors 'shimbun-elmo-mua)) (luna-define-method shimbun-mua-search-id ((mua shimbun-elmo-mua) id) - (elmo-msgdb-overview-get-entity id - (elmo-folder-msgdb - (shimbun-elmo-mua-folder-internal mua)))) + (elmo-msgdb-message-entity (elmo-folder-msgdb + (shimbun-elmo-mua-folder-internal mua)) + id)) (eval-and-compile (luna-define-class elmo-shimbun-folder @@ -120,9 +120,9 @@ update overview when message is fetched." (defsubst elmo-shimbun-folder-shimbun-header (folder location) (let ((hash (elmo-shimbun-folder-header-hash-internal folder))) (or (and hash (elmo-get-hash-val location hash)) - (let ((entity (elmo-msgdb-overview-get-entity - location - (elmo-folder-msgdb folder))) + (let ((entity (elmo-msgdb-message-entity + (elmo-folder-msgdb folder) + location)) (elmo-hash-minimum-size 63) header) (when entity @@ -202,9 +202,9 @@ update overview when message is fetched." (delq nil (mapcar (lambda (x) - (unless (elmo-msgdb-overview-get-entity - (shimbun-header-id x) - (elmo-folder-msgdb folder)) + (unless (elmo-msgdb-message-entity + (elmo-folder-msgdb folder) + (shimbun-header-id x)) x)) ;; This takes much time. (shimbun-headers @@ -377,8 +377,8 @@ update overview when message is fetched." nil) (defsubst elmo-shimbun-update-overview (folder shimbun-id header) - (let ((entity (elmo-msgdb-overview-get-entity shimbun-id - (elmo-folder-msgdb folder))) + (let ((entity (elmo-msgdb-message-entity (elmo-folder-msgdb folder) + shimbun-id)) (message-id (shimbun-header-id header)) references) (unless (string= shimbun-id message-id) diff --git a/elmo/elmo-vars.el b/elmo/elmo-vars.el index 39601f5..5f072bc 100644 --- a/elmo/elmo-vars.el +++ b/elmo/elmo-vars.el @@ -59,6 +59,13 @@ ;; Message Database +(defcustom elmo-msgdb-default-type 'legacy + "*Default type of Message Database for ELMO." + :type '(radio (const legacy) + (const :tag "No use" generic)) + :group 'elmo + :group 'elmo-setting) + (defvar elmo-msgdb-file-header-chop-length 2048 "*Number of bytes to get header in one reading from file.") diff --git a/elmo/elmo.el b/elmo/elmo.el index cbe7ad0..0a012d2 100644 --- a/elmo/elmo.el +++ b/elmo/elmo.el @@ -249,9 +249,8 @@ If second optional IN-MSGDB is non-nil, only messages in the msgdb are listed.") elmo-msgdb-directory))))) (if (and (string= mark (cdr mark-pair)) (setq entity - (elmo-msgdb-overview-get-entity (car mark-pair) - (elmo-folder-msgdb - folder)))) + (elmo-msgdb-message-entity (elmo-folder-msgdb folder) + (car mark-pair)))) (setq msgs (cons (elmo-msgdb-overview-entity-get-number entity) msgs)))) msgs)) @@ -1326,6 +1325,15 @@ FIELD is a symbol of the field.") ;; flag-table) ;; "Append ENTITY to the folder.") +(defun elmo-msgdb-merge (folder msgdb-merge) + "Return a list of messages which have duplicated message-id." + (let (msgdb duplicates) + (setq msgdb (or (elmo-folder-msgdb-internal folder) + (elmo-make-msgdb (elmo-folder-msgdb-path folder)))) + (setq duplicates (elmo-msgdb-append msgdb msgdb-merge)) + (elmo-folder-set-msgdb-internal folder msgdb) + duplicates)) + (defsubst elmo-folder-append-msgdb (folder append-msgdb) (if append-msgdb (let ((duplicates (elmo-msgdb-merge folder append-msgdb))) diff --git a/elmo/modb-entity.el b/elmo/modb-entity.el new file mode 100644 index 0000000..546a6f4 --- /dev/null +++ b/elmo/modb-entity.el @@ -0,0 +1,325 @@ +;;; modb-entity.el --- Message Entity Interface. + +;; Copyright (C) 2003 Yuuichi Teranishi + +;; Author: Yuuichi Teranishi +;; Hiroya Murata +;; Keywords: mail, net news + +;; This file is part of ELMO (Elisp Library for Message Orchestration). + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. +;; + +;;; Commentary: +;; + +;;; Code: +;; + +(eval-when-compile (require 'cl)) + +(require 'elmo-vars) +(require 'elmo-util) +(require 'mime) + +;; +;; 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))) + + +;;; Message entity interface +;; +(defun elmo-msgdb-make-message-entity (&rest 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)))) + +(defsubst elmo-msgdb-message-entity-field (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)))) + +(defsubst elmo-msgdb-message-entity-set-field (entity field value) + (and entity + (case field + (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)))))))) + +(defun elmo-msgdb-copy-overview-entity (entity) + (cons (car entity) + (copy-sequence (cdr entity)))) + +;;; obsolete interface +;; +(defsubst elmo-msgdb-overview-entity-get-id (entity) + (and entity (car entity))) + +(defsubst elmo-msgdb-overview-entity-get-number (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))))) + + +;;; +;; +(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)))) + +(defun elmo-msgdb-match-condition-internal (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 (nth 1 condition) + entity flags numbers))) + (cond + ((elmo-filter-condition-p lhs) + (let ((rhs (elmo-msgdb-match-condition-internal + (nth 2 condition) entity flags numbers))) + (cond ((elmo-filter-condition-p rhs) + (list 'and lhs rhs)) + (rhs + lhs)))) + (lhs + (elmo-msgdb-match-condition-internal (nth 2 condition) + entity flags numbers))))) + ((eq (car condition) 'or) + (let ((lhs (elmo-msgdb-match-condition-internal (nth 1 condition) + entity flags numbers))) + (cond + ((elmo-filter-condition-p lhs) + (let ((rhs (elmo-msgdb-match-condition-internal (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 (nth 2 condition) + entity flags numbers))))))) + + +(require 'product) +(product-provide (provide 'modb-entity) (require 'elmo-version)) + +;;; modb-entity.el ends here diff --git a/elmo/modb-legacy.el b/elmo/modb-legacy.el new file mode 100644 index 0000000..572d475 --- /dev/null +++ b/elmo/modb-legacy.el @@ -0,0 +1,454 @@ +;;; modb-legacy.el --- Legacy Implement of MODB. + +;; Copyright (C) 2003 Yuuichi Teranishi + +;; Author: Yuuichi Teranishi +;; Hiroya Murata +;; Keywords: mail, net news + +;; This file is part of ELMO (Elisp Library for Message Orchestration). + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. +;; + +;;; Commentary: +;; + +;;; Code: +;; + +(eval-when-compile (require 'cl)) + +(require 'elmo-util) +(require 'modb) +(require 'modb-entity) + +;;; legacy implement +;; +(eval-and-compile + (luna-define-class modb-legacy (modb-generic) + (overview number-alist mark-alist index)) + (luna-define-internal-accessors 'modb-legacy)) + +;; for internal use only +(defsubst elmo-msgdb-get-overview (msgdb) + (modb-legacy-overview-internal msgdb)) + +(defsubst elmo-msgdb-get-number-alist (msgdb) + (modb-legacy-number-alist-internal msgdb)) + +(defsubst elmo-msgdb-get-mark-alist (msgdb) + (modb-legacy-mark-alist-internal msgdb)) + +(defsubst elmo-msgdb-get-index (msgdb) + (modb-legacy-index-internal msgdb)) + +(defsubst elmo-msgdb-get-entity-hashtb (msgdb) + (car (modb-legacy-index-internal msgdb))) + +(defsubst elmo-msgdb-get-mark-hashtb (msgdb) + (cdr (modb-legacy-index-internal msgdb))) + +(defsubst elmo-msgdb-get-path (msgdb) + (elmo-msgdb-location msgdb)) + +(defsubst elmo-msgdb-set-overview (msgdb overview) + (modb-legacy-set-overview-internal msgdb overview)) + +(defsubst elmo-msgdb-set-number-alist (msgdb number-alist) + (modb-legacy-set-number-alist-internal msgdb number-alist)) + +(defsubst elmo-msgdb-set-mark-alist (msgdb mark-alist) + (modb-legacy-set-mark-alist-internal msgdb mark-alist)) + +(defsubst elmo-msgdb-set-index (msgdb index) + (modb-legacy-set-index-internal msgdb index)) + +(defsubst elmo-msgdb-set-path (msgdb path) + (modb-generic-set-location-internal msgdb path)) + +(defvar elmo-msgdb-unread-marks-internal nil) +(defsubst elmo-msgdb-unread-marks () + "Return an unread mark list" + (or elmo-msgdb-unread-marks-internal + (setq elmo-msgdb-unread-marks-internal + (list elmo-msgdb-new-mark + elmo-msgdb-unread-uncached-mark + elmo-msgdb-unread-cached-mark)))) + +(defvar elmo-msgdb-answered-marks-internal nil) +(defsubst elmo-msgdb-answered-marks () + "Return an answered mark list" + (or elmo-msgdb-answered-marks-internal + (setq elmo-msgdb-answered-marks-internal + (list elmo-msgdb-answered-cached-mark + elmo-msgdb-answered-uncached-mark)))) + +(defvar elmo-msgdb-uncached-marks-internal nil) +(defsubst elmo-msgdb-uncached-marks () + (or elmo-msgdb-uncached-marks-internal + (setq elmo-msgdb-uncached-marks-internal + (list elmo-msgdb-new-mark + elmo-msgdb-answered-uncached-mark + elmo-msgdb-unread-uncached-mark + elmo-msgdb-read-uncached-mark)))) + +(defsubst elmo-msgdb-mark-to-flags (mark) + (append + (and (string= mark elmo-msgdb-new-mark) + '(new)) + (and (string= mark elmo-msgdb-important-mark) + '(important)) + (and (member mark (elmo-msgdb-unread-marks)) + '(unread)) + (and (member mark (elmo-msgdb-answered-marks)) + '(answered)) + (and (not (member mark (elmo-msgdb-uncached-marks))) + '(cached)))) + +(defsubst elmo-msgdb-flags-to-mark (flags) + (cond ((memq 'new flags) + elmo-msgdb-new-mark) + ((memq 'important flags) + elmo-msgdb-important-mark) + ((memq 'answered flags) + (if (memq 'cached flags) + elmo-msgdb-answered-cached-mark + elmo-msgdb-answered-uncached-mark)) + ((memq 'unread flags) + (if (memq 'cached flags) + elmo-msgdb-unread-cached-mark + elmo-msgdb-unread-uncached-mark)) + (t + (if (memq 'cached flags) + nil + elmo-msgdb-read-uncached-mark)))) + +(defsubst elmo-msgdb-get-mark (msgdb number) + "Get mark string from MSGDB which corresponds to the message with NUMBER." + (cadr (elmo-get-hash-val (format "#%d" number) + (elmo-msgdb-get-mark-hashtb msgdb)))) + +(defsubst elmo-msgdb-set-mark (msgdb number mark) + "Set MARK of the message with NUMBER in the MSGDB. +if MARK is nil, mark is removed." + (let ((elem (elmo-get-hash-val (format "#%d" number) + (elmo-msgdb-get-mark-hashtb msgdb)))) + (if elem + (if mark + ;; Set mark of the elem + (setcar (cdr elem) mark) + ;; Delete elem from mark-alist + (elmo-msgdb-set-mark-alist + msgdb + (delq elem (elmo-msgdb-get-mark-alist msgdb))) + (elmo-clear-hash-val (format "#%d" number) + (elmo-msgdb-get-mark-hashtb msgdb))) + (when mark + ;; Append new element. + (elmo-msgdb-set-mark-alist + msgdb + (nconc + (elmo-msgdb-get-mark-alist msgdb) + (list (setq elem (list number mark))))) + (elmo-set-hash-val (format "#%d" number) elem + (elmo-msgdb-get-mark-hashtb msgdb)))) + (modb-generic-set-flag-modified-internal msgdb t) + ;; return value. + t)) + +(defun elmo-msgdb-make-index (msgdb &optional overview mark-alist) + "Append OVERVIEW and MARK-ALIST to the index of MSGDB. +If OVERVIEW and MARK-ALIST are nil, make index for current MSGDB. +Return a list of message numbers which have duplicated message-ids." + (when msgdb + (let* ((overview (or overview (elmo-msgdb-get-overview msgdb))) + (mark-alist (or mark-alist (elmo-msgdb-get-mark-alist msgdb))) + (index (elmo-msgdb-get-index msgdb)) + (ehash (or (car index) ;; append + (elmo-make-hash (length overview)))) + (mhash (or (cdr index) ;; append + (elmo-make-hash (length overview)))) + duplicates) + (while overview + ;; key is message-id + (if (elmo-get-hash-val (caar overview) ehash) ; duplicated. + (setq duplicates (cons + (elmo-msgdb-overview-entity-get-number + (car overview)) + duplicates))) + (if (caar overview) + (elmo-set-hash-val (caar overview) (car overview) ehash)) + ;; key is number + (elmo-set-hash-val + (format "#%d" + (elmo-msgdb-overview-entity-get-number (car overview))) + (car overview) ehash) + (setq overview (cdr overview))) + (while mark-alist + ;; key is number + (elmo-set-hash-val + (format "#%d" (car (car mark-alist))) + (car mark-alist) mhash) + (setq mark-alist (cdr mark-alist))) + (setq index (or index (cons ehash mhash))) + (elmo-msgdb-set-index msgdb index) + duplicates))) + +(defun elmo-msgdb-clear-index (msgdb entity) + (let ((ehash (elmo-msgdb-get-entity-hashtb msgdb)) + (mhash (elmo-msgdb-get-mark-hashtb msgdb)) + number) + (when (and entity ehash) + (and (setq number (elmo-msgdb-overview-entity-get-number 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)) + (elmo-clear-hash-val (format "#%d" number) mhash))))) + +;;; Implement +;; +(luna-define-method elmo-msgdb-load ((msgdb modb-legacy)) + (let ((inhibit-quit t) + (path (elmo-msgdb-location msgdb))) + (when (file-exists-p (expand-file-name elmo-msgdb-mark-filename path)) + (modb-legacy-set-overview-internal + msgdb + (elmo-msgdb-overview-load path)) + (modb-legacy-set-number-alist-internal + msgdb + (elmo-msgdb-number-load path)) + (modb-legacy-set-mark-alist-internal + msgdb + (elmo-msgdb-mark-load path)) + (elmo-msgdb-make-index msgdb) + t))) + +(luna-define-method elmo-msgdb-save ((msgdb modb-legacy)) + (let ((path (elmo-msgdb-location msgdb))) + (when (elmo-msgdb-message-modified-p msgdb) + (elmo-msgdb-overview-save + path + (modb-legacy-overview-internal msgdb)) + (elmo-msgdb-number-save + path + (modb-legacy-number-alist-internal msgdb)) + (modb-generic-set-message-modified-internal msgdb nil)) + (when (elmo-msgdb-flag-modified-p msgdb) + (elmo-msgdb-mark-save + path + (modb-legacy-mark-alist-internal msgdb)) + (modb-generic-set-flag-modified-internal msgdb nil)))) + +(luna-define-method elmo-msgdb-append :around ((msgdb modb-legacy) + msgdb-append) + (if (eq (luna-class-name msgdb-append) + 'modb-legacy) + (let (duplicates) + (elmo-msgdb-set-overview + msgdb + (nconc (elmo-msgdb-get-overview msgdb) + (elmo-msgdb-get-overview msgdb-append))) + (elmo-msgdb-set-number-alist + msgdb + (nconc (elmo-msgdb-get-number-alist msgdb) + (elmo-msgdb-get-number-alist msgdb-append))) + (elmo-msgdb-set-mark-alist + msgdb + (nconc (elmo-msgdb-get-mark-alist msgdb) + (elmo-msgdb-get-mark-alist msgdb-append))) + (setq duplicates (elmo-msgdb-make-index + msgdb + (elmo-msgdb-get-overview msgdb-append) + (elmo-msgdb-get-mark-alist msgdb-append))) + (elmo-msgdb-set-path + msgdb + (or (elmo-msgdb-get-path msgdb) + (elmo-msgdb-get-path msgdb-append))) + (modb-generic-set-message-modified-internal msgdb t) + (modb-generic-set-flag-modified-internal msgdb t) + duplicates) + (luna-call-next-method))) + +(luna-define-method elmo-msgdb-clear :after ((msgdb modb-legacy)) + (elmo-msgdb-set-overview msgdb nil) + (elmo-msgdb-set-number-alist msgdb nil) + (elmo-msgdb-set-mark-alist msgdb nil) + (elmo-msgdb-set-index msgdb nil)) + +(luna-define-method elmo-msgdb-length ((msgdb modb-legacy)) + (length (modb-legacy-overview-internal msgdb))) + +(luna-define-method elmo-msgdb-flags ((msgdb modb-legacy) number) + (elmo-msgdb-mark-to-flags (elmo-msgdb-get-mark msgdb number))) + +(luna-define-method elmo-msgdb-set-flag ((msgdb modb-legacy) + number flag) + (case flag + (read + (elmo-msgdb-unset-flag msgdb number 'unread)) + (uncached + (elmo-msgdb-unset-flag msgdb number 'cached)) + (t + (let* ((cur-mark (elmo-msgdb-get-mark msgdb number)) + (flags (elmo-msgdb-mark-to-flags cur-mark)) + new-mark) + (and (memq 'new flags) + (setq flags (delq 'new flags))) + (or (memq flag flags) + (setq flags (cons flag flags))) + (when (and (eq flag 'unread) + (memq 'answered flags)) + (setq flags (delq 'answered flags))) + (setq new-mark (elmo-msgdb-flags-to-mark flags)) + (unless (string= new-mark cur-mark) + (elmo-msgdb-set-mark msgdb number new-mark)))))) + +(luna-define-method elmo-msgdb-unset-flag ((msgdb modb-legacy) + number flag) + (case flag + (read + (elmo-msgdb-set-flag msgdb number 'unread)) + (uncached + (elmo-msgdb-set-flag msgdb number 'cached)) + (t + (let* ((cur-mark (elmo-msgdb-get-mark msgdb number)) + (flags (elmo-msgdb-mark-to-flags cur-mark)) + new-mark) + (and (memq 'new flags) + (setq flags (delq 'new flags))) + (and (memq flag flags) + (setq flags (delq flag flags))) + (when (and (eq flag 'unread) + (memq 'answered flags)) + (setq flags (delq 'answered flags))) + (setq new-mark (elmo-msgdb-flags-to-mark flags)) + (unless (string= new-mark cur-mark) + (elmo-msgdb-set-mark msgdb number new-mark)))))) + +(luna-define-method elmo-msgdb-list-messages ((msgdb modb-legacy)) + (mapcar 'elmo-msgdb-overview-entity-get-number + (elmo-msgdb-get-overview msgdb))) + +(luna-define-method elmo-msgdb-list-flagged ((msgdb modb-legacy) flag) + (let ((case-fold-search nil) + mark-regexp matched) + (case flag + (new + (setq mark-regexp (regexp-quote elmo-msgdb-new-mark))) + (unread + (setq mark-regexp (elmo-regexp-opt (elmo-msgdb-unread-marks)))) + (answered + (setq mark-regexp (elmo-regexp-opt (elmo-msgdb-answered-marks)))) + (important + (setq mark-regexp (regexp-quote elmo-msgdb-important-mark))) + (read + (setq mark-regexp (elmo-regexp-opt (elmo-msgdb-unread-marks)))) + (digest + (setq mark-regexp (elmo-regexp-opt + (append (elmo-msgdb-unread-marks) + (list elmo-msgdb-important-mark))))) + (any + (setq mark-regexp (elmo-regexp-opt + (append + (elmo-msgdb-unread-marks) + (elmo-msgdb-answered-marks) + (list elmo-msgdb-important-mark)))))) + (when mark-regexp + (if (eq flag 'read) + (dolist (number (elmo-msgdb-list-messages msgdb)) + (let ((mark (elmo-msgdb-get-mark msgdb number))) + (unless (and mark (string-match mark-regexp mark)) + (setq matched (cons number matched))))) + (dolist (elem (elmo-msgdb-get-mark-alist msgdb)) + (if (string-match mark-regexp (cadr elem)) + (setq matched (cons (car elem) matched)))))) + matched)) + +(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 (elmo-msgdb-flags-to-mark flags)) + (elmo-msgdb-set-mark-alist + 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)))))) + +(luna-define-method elmo-msgdb-delete-messages ((msgdb modb-legacy) + numbers) + (let* ((overview (elmo-msgdb-get-overview msgdb)) + (number-alist (elmo-msgdb-get-number-alist msgdb)) + (mark-alist (elmo-msgdb-get-mark-alist msgdb)) + (index (elmo-msgdb-get-index msgdb)) + ov-entity) + ;; remove from current database. + (dolist (number numbers) + (setq overview + (delq + (setq ov-entity + (elmo-msgdb-message-entity msgdb number)) + overview)) + (setq number-alist (delq (assq number number-alist) number-alist)) + (setq mark-alist (delq (assq number mark-alist) mark-alist)) + ;; + (when index (elmo-msgdb-clear-index msgdb ov-entity))) + (elmo-msgdb-set-overview msgdb overview) + (elmo-msgdb-set-number-alist msgdb number-alist) + (elmo-msgdb-set-mark-alist msgdb mark-alist) + (elmo-msgdb-set-index msgdb index) + (modb-generic-set-message-modified-internal msgdb t) + (modb-generic-set-flag-modified-internal msgdb t) + t)) ;return value + +(luna-define-method elmo-msgdb-sort-entities ((msgdb modb-legacy) + predicate &optional app-data) + (message "Sorting...") + (let ((overview (elmo-msgdb-get-overview msgdb))) + (elmo-msgdb-set-overview + msgdb + (sort overview (lambda (a b) (funcall predicate a b app-data)))) + (message "Sorting...done") + 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))) + +(require 'product) +(product-provide (provide 'modb-legacy) (require 'elmo-version)) + +;;; mdb-legacy.el ends here diff --git a/elmo/modb.el b/elmo/modb.el new file mode 100644 index 0000000..b46bdf1 --- /dev/null +++ b/elmo/modb.el @@ -0,0 +1,159 @@ +;;; modb.el --- Message Orchestration DataBase. + +;; Copyright (C) 2003 Yuuichi Teranishi + +;; Author: Yuuichi Teranishi +;; Hiroya Murata +;; Keywords: mail, net news + +;; This file is part of ELMO (Elisp Library for Message Orchestration). + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. +;; + +;;; Commentary: +;; + +;;; Code: +;; + +(eval-when-compile (require 'cl)) + +(require 'luna) + +(eval-and-compile + (luna-define-class modb-generic () (location ; location for save. + message-modified ; message is modified. + flag-modified ; flag is modified. + )) + (luna-define-internal-accessors 'modb-generic)) + +(luna-define-generic elmo-msgdb-load (msgdb) + "Load the MSGDB.") + +(luna-define-generic elmo-msgdb-save (msgdb) + "Save the MSGDB.") + +(luna-define-generic elmo-msgdb-location (msgdb) + "Return the location of MSGDB.") + +(luna-define-generic elmo-msgdb-message-modified-p (msgdb) + "Return non-nil if message is modified.") + +(luna-define-generic elmo-msgdb-flag-modified-p (msgdb) + "Return non-nil if flag is modified.") + +(luna-define-generic elmo-msgdb-append (msgdb msgdb-append) + "Append the MSGDB-APPEND to the MSGDB. +Return a list of messages which have duplicated message-id.") + +(luna-define-generic elmo-msgdb-clear (msgdb) + "Clear the MSGDB structure.") + +(luna-define-generic elmo-msgdb-length (msgdb) + "Return number of messages in the MSGDB") + +(luna-define-generic elmo-msgdb-flags (msgdb number) + "Return a list of flag which corresponds to the message with NUMBER.") + +(luna-define-generic elmo-msgdb-set-flag (msgdb number flag) + "Set message flag. +MSGDB is the ELMO msgdb. +NUMBER is a message number to set flag. +FLAG is a symbol which is one of the following: +`new' ... Message which is new. +`read' ... Message which is already read. +`important' ... Message which is marked as important. +`answered' ... Message which is marked as answered. +`cached' ... Message which is cached.") + +(luna-define-generic elmo-msgdb-unset-flag (msgdb number flag) + "Unset message flag. +MSGDB is the ELMO msgdb. +NUMBER is a message number to set flag. +FLAG is a symbol which is one of the following: +`new' ... Message which is new. +`read' ... Message which is already read. +`important' ... Message which is marked as important. +`answered' ... Message which is marked as answered. +`cached' ... Message which is cached.") + +(luna-define-generic elmo-msgdb-list-messages (msgdb) + "Return a list of message numbers in the MSGDB.") + +(luna-define-generic elmo-msgdb-list-flagged (msgdb flag) + "Return a list of message numbers which is set FLAG in the MSGDB.") + +;;; (luna-define-generic elmo-msgdb-search (msgdb condition &optional numbers) +;;; "Search and return list of message numbers. +;;; MSGDB is the ELMO msgdb structure. +;;; CONDITION is a condition structure for searching. +;;; If optional argument NUMBERS is specified and is a list of message numbers, +;;; messages are searched from the list.") + +(luna-define-generic elmo-msgdb-append-entity (msgdb entity &optional flags) + "Append a ENTITY with FLAGS into the MSGDB. +Return non-nil if message-id of entity is duplicated.") + +(luna-define-generic elmo-msgdb-delete-messages (msgdb numbers) + "Delete messages which are contained NUMBERS from MSGDB.") + +(luna-define-generic elmo-msgdb-sort-entities (msgdb predicate &optional app-data) + "Sort entities of MSGDB, comparing with PREDICATE. +PREDICATE is called with two entities and APP-DATA. +Should return non-nil if the first entity is \"less\" than the second.") + +(luna-define-generic elmo-msgdb-message-entity (msgdb key) + "Return the message-entity structure which matches to the KEY. +KEY is a number or a string. +A number is for message number in the MSGDB. +A string is for message-id of the message.") + +;;; generic implement +;; +(luna-define-method elmo-msgdb-load ((msgdb modb-generic)) + t) + +(luna-define-method elmo-msgdb-location ((msgdb modb-generic)) + (modb-generic-location-internal msgdb)) + +(luna-define-method elmo-msgdb-message-modified-p ((msgdb modb-generic)) + (modb-generic-message-modified-internal msgdb)) + +(luna-define-method elmo-msgdb-flag-modified-p ((msgdb modb-generic)) + (modb-generic-flag-modified-internal msgdb)) + +(luna-define-method elmo-msgdb-append ((msgdb modb-generic) msgdb-append) + (let (duplicates) + (dolist (number (elmo-msgdb-list-messages msgdb-append)) + (when (elmo-msgdb-append-entity + msgdb + (elmo-msgdb-message-entity msgdb-append number) + (elmo-msgdb-flags msgdb-append number)) + (setq duplicates (cons number duplicates)))) + duplicates)) + +(luna-define-method elmo-msgdb-clear ((msgdb modb-generic)) + (modb-generic-set-message-modified-internal msgdb nil) + (modb-generic-set-flag-modified-internal msgdb nil)) + +;; for on demand loading +(provide 'modb-generic) + +(require 'product) +(product-provide (provide 'modb) (require 'elmo-version)) + +;;; modb.el ends here