2003-09-13 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+ * elmo.el (elmo-generic-folder-append-messages): Follow the API
+ change.
+ (elmo-message-mark): Abolish.
+ (elmo-folder-synchronize): Use `elmo-msgdb-out-of-date-messages'
+ instead of `elmo-msgdb-change-mark'.
+
+ * elmo-pipe.el (elmo-message-mark): Abolish.
+
+ * elmo-multi.el (elmo-message-mark): Ditto.
+
+ * elmo-msgdb.el (elmo-msgdb-new-mark): Changed to constant.
+ (elmo-msgdb-unread-uncached-mark): Ditto.
+ (elmo-msgdb-unread-cached-mark): Ditto.
+ (elmo-msgdb-read-uncached-mark): Ditto.
+ (elmo-msgdb-answered-cached-mark): Ditto.
+ (elmo-msgdb-answered-uncached-mark): Ditto.
+ (elmo-msgdb-important-mark): Ditto.
+ (elmo-msgdb-flags-to-mark): Remove arguments `cached' and
+ `use-cache'.
+ (elmo-msgdb-append-entity): Changed 3rd arg from `mark' to
+ `flags'.
+ (elmo-flag-table-load): Changed flag to list of flag.
+ (elmo-flag-table-set): If flags is nil, set read flag.
+ (elmo-flag-table-get): Return derived flags from global mark,
+ cache status and saved flags.
+ (elmo-msgdb-flag-table): Follow the change above.
+ (elmo-msgdb-out-of-date-messages): New function.
+
+ * elmo-shimbun.el (elmo-folder-msgdb-create): Follow the API change.
+
+ * elmo-sendlog.el (elmo-folder-msgdb-create): Ditto.
+
+ * elmo-pop3.el (elmo-pop3-msgdb-create-message): Ditto.
+
+ * elmo-nntp.el (elmo-nntp-create-msgdb-from-overview-string): Ditto.
+ (elmo-nntp-msgdb-create-message): Ditto.
+
+ * elmo-map.el (elmo-folder-pack-numbers): Ditto.
+
+ * elmo-maildir.el (elmo-maildir-list-location): Treat flags as
+ independent.
+ (elmo-folder-msgdb-create): Follow the API change.
+
+ * elmo-localdir.el (elmo-folder-msgdb-create): Ditto.
+ (elmo-folder-append-messages): Ditto.
+
+ * elmo-imap4.el (elmo-imap4-fetch-callback-1-subr): Ditto.
+ (elmo-folder-append-buffer): Ditto.
+
+ * elmo-filter.el (elmo-folder-msgdb-create): Ditto.
+
+ * elmo-cache.el (elmo-folder-msgdb-create): Ditto.
+
+ * elmo-archive.el (elmo-archive-msgdb-create-as-numlist-subr1): Ditto.
+ (elmo-archive-parse-mmdf): Ditto.
+
* elmo-version.el (elmo-version): Up to 2.11.11.
2003-09-10 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
(file (elmo-archive-get-archive-name folder))
(method (elmo-archive-get-method type 'cat))
(new-msgdb (elmo-make-msgdb))
- entity i percent num message-id gmark)
+ entity i percent num message-id)
(with-temp-buffer
(setq num (length numlist))
(setq i 0)
(elmo-archive-folder-archive-prefix-internal folder)))
(when entity
(setq message-id (elmo-msgdb-overview-entity-get-id entity))
- (setq gmark
- (or (elmo-msgdb-global-mark-get message-id)
- (elmo-msgdb-mark
- (elmo-flag-table-get flag-table message-id)
- (elmo-file-cache-status
- (elmo-file-cache-get message-id))
- 'new)))
- (elmo-msgdb-append-entity new-msgdb entity gmark))
+ (elmo-msgdb-append-entity
+ new-msgdb
+ entity
+ (elmo-flag-table-get flag-table message-id)))
(when (> num elmo-display-progress-threshold)
(setq i (1+ i))
(setq percent (/ (* i 100) num))
(let ((delim elmo-mmdf-delimiter)
(new-msgdb (elmo-make-msgdb))
number sp ep rest entity
- message-id gmark)
+ message-id)
(goto-char (point-min))
(setq rest msgs)
(while (and rest (re-search-forward delim nil t)
(narrow-to-region sp ep)
(setq entity (elmo-archive-msgdb-create-entity-subr number))
(setq message-id (elmo-msgdb-overview-entity-get-id entity))
- (setq gmark
- (or (elmo-msgdb-global-mark-get message-id)
- (elmo-msgdb-mark
- (elmo-flag-table-get flag-table message-id)
- (elmo-file-cache-status
- (elmo-file-cache-get message-id))
- 'new)))
- (elmo-msgdb-append-entity new-msgdb entity gmark)
+ (elmo-msgdb-append-entity
+ new-msgdb
+ entity
+ (elmo-flag-table-get flag-table message-id))
(widen)))
(forward-line 1)
(setq rest (cdr rest)))
(let ((i 0)
(len (length numbers))
(new-msgdb (elmo-make-msgdb))
- entity message-id mark)
+ entity message-id)
(message "Creating msgdb...")
(while numbers
(setq entity
(car numbers) (elmo-message-file-name folder (car numbers))))
(when entity
(setq message-id (elmo-msgdb-overview-entity-get-id entity))
- (setq mark (or (elmo-msgdb-global-mark-get message-id)
- (elmo-msgdb-mark
- (elmo-flag-table-get flag-table message-id)
- (elmo-file-cache-status
- (elmo-file-cache-get message-id))
- 'new)))
- (elmo-msgdb-append-entity new-msgdb entity mark))
+ (elmo-msgdb-append-entity new-msgdb entity
+ (elmo-flag-table-get flag-table message-id)))
(when (> len elmo-display-progress-threshold)
(setq i (1+ i))
(elmo-display-progress
(len (length numlist))
(msgdb (elmo-folder-msgdb target-folder))
(new-msgdb (elmo-make-msgdb))
- message-id entity mark)
+ message-id entity)
(when (> len elmo-display-progress-threshold)
(elmo-progress-set 'elmo-folder-msgdb-create
len "Creating msgdb..."))
(dolist (number numlist)
(setq entity (elmo-msgdb-overview-get-entity number msgdb))
(when entity
- (setq mark (elmo-msgdb-get-mark msgdb number))
- (elmo-msgdb-append-entity new-msgdb entity mark))
+ (elmo-msgdb-append-entity new-msgdb entity
+ (elmo-msgdb-flags msgdb number)))
(elmo-progress-notify 'elmo-folder-msgdb-create))
(elmo-progress-clear 'elmo-folder-msgdb-create))
new-msgdb)
;; cons of flag-table and result of use-flag-p.
(defsubst elmo-imap4-fetch-callback-1-subr (entity flags app-data)
"A msgdb entity callback function."
- (let* ((use-flag (cdr app-data))
- (app-data (car app-data))
- mark)
- (if (elmo-string-member-ignore-case "\\Flagged" flags)
- (elmo-msgdb-global-mark-set (car entity)
- elmo-msgdb-important-mark))
- (if (setq mark (elmo-msgdb-global-mark-get (car entity)))
- (unless (elmo-string-member-ignore-case "\\Seen" flags)
- (setq elmo-imap4-seen-messages
- (cons
- (elmo-msgdb-overview-entity-get-number entity)
- elmo-imap4-seen-messages)))
- (setq mark (or (if (elmo-file-cache-status
- (elmo-file-cache-get (car entity)))
- ;; cached.
- (if (and use-flag (member "\\Seen" flags))
- (if (elmo-string-member-ignore-case
- "\\Answered" flags)
- elmo-msgdb-answered-cached-mark
- nil)
- elmo-msgdb-unread-cached-mark)
- ;; uncached.
- (if (elmo-string-member-ignore-case "\\Answered" flags)
- elmo-msgdb-answered-uncached-mark
- (if (and use-flag
- (elmo-string-member-ignore-case
- "\\Seen" flags))
- (if (elmo-string-member-ignore-case
- "\\Answered" flags)
- elmo-msgdb-answered-uncached-mark
- (if elmo-imap4-use-cache
- elmo-msgdb-read-uncached-mark))
- elmo-msgdb-new-mark))))))
+ (let ((use-flag (cdr app-data))
+ (flag-table (car app-data))
+ (msg-id (elmo-msgdb-overview-entity-get-id entity))
+ saved-flags flag-list)
+ (when (elmo-string-member-ignore-case "\\Flagged" flags)
+ (elmo-msgdb-global-mark-set msg-id elmo-msgdb-important-mark))
+ (setq saved-flags (elmo-flag-table-get flag-table msg-id)
+ flag-list
+ (if use-flag
+ (append
+ (and (elmo-string-member-ignore-case "\\Recent" flags)
+ '(new))
+ (and (elmo-string-member-ignore-case "\\Flagged" flags)
+ '(important))
+ (and (not (elmo-string-member-ignore-case "\\Seen" flags))
+ '(unread))
+ (and (elmo-string-member-ignore-case "\\Answered" flags)
+ '(answered))
+ (and (elmo-file-cache-exists-p msg-id)
+ '(cached))))
+ saved-flags)
+ (when (and (or (memq 'important flag-list)
+ (memq 'answered flag-list))
+ (memq 'unread flag-list))
+ (setq elmo-imap4-seen-messages
+ (cons (elmo-msgdb-overview-entity-get-number entity)
+ elmo-imap4-seen-messages)))
(elmo-msgdb-append-entity elmo-imap4-current-msgdb
entity
- mark)))
+ flag-list)))
;; Current buffer is process buffer.
(defun elmo-imap4-fetch-callback-1 (element app-data)
(elmo-imap4-folder-mailbox-internal folder)))))
(luna-define-method elmo-folder-append-buffer
- ((folder elmo-imap4-folder) &optional flag number)
+ ((folder elmo-imap4-folder) &optional flags number)
(if (elmo-folder-plugged-p folder)
(let ((session (elmo-imap4-get-session folder))
send-buffer result)
"append "
(elmo-imap4-mailbox (elmo-imap4-folder-mailbox-internal
folder))
- (cond
- ((eq flag 'read) " (\\Seen) ")
- ((eq flag 'answered) " (\\Answered)")
- (t " () "))
+ (if (and flags (elmo-folder-use-flag-p folder))
+ (concat " ("
+ (mapconcat
+ 'identity
+ (append
+ (and (memq 'important flags)
+ '("\\Flagged"))
+ (and (not (memq 'unread flags))
+ '("\\Seen"))
+ (and (memq 'answered flags)
+ '("\\Answered")))
+ " ")
+ ") ")
+ " () ")
(elmo-imap4-buffer-literal send-buffer))))
(kill-buffer send-buffer))
result)
;; Unplugged
(if elmo-enable-disconnected-operation
- (elmo-folder-append-buffer-dop folder flag number)
+ (elmo-folder-append-buffer-dop folder flags number)
(error "Unplugged"))))
(eval-when-compile
(when numbers
(let ((dir (elmo-localdir-folder-directory-internal folder))
(new-msgdb (elmo-make-msgdb))
- entity message-id gmark
+ entity message-id
(i 0)
(len (length numbers)))
(message "Creating msgdb...")
dir (car numbers)))
(when entity
(setq message-id (elmo-msgdb-overview-entity-get-id entity))
- (setq gmark (or (elmo-msgdb-global-mark-get message-id)
- (unless (eq 'read (elmo-flag-table-get
- flag-table message-id))
- (elmo-msgdb-mark
- (elmo-flag-table-get flag-table message-id)
- (elmo-file-cache-status
- (elmo-file-cache-get message-id))
- 'new))))
- (elmo-msgdb-append-entity new-msgdb entity gmark))
+ (elmo-msgdb-append-entity
+ new-msgdb
+ entity
+ (elmo-flag-table-get flag-table message-id)))
(when (> len elmo-display-progress-threshold)
(setq i (1+ i))
(elmo-display-progress
(table (elmo-flag-table-load (elmo-folder-msgdb-path folder)))
(succeeds numbers)
(next-num (1+ (car (elmo-folder-status folder))))
- mark flag id)
+ flags id)
(while numbers
- (setq mark (and src-msgdb-exists
- (elmo-message-mark src-folder (car numbers)))
- flag (cond
- ((null mark) 'read)
- ((member mark (elmo-msgdb-answered-marks))
- 'answered)
- ;;
- ((not (member mark (elmo-msgdb-unread-marks)))
- 'read)))
+ (setq flags (elmo-message-flags src-folder (car numbers)))
(elmo-copy-file
(elmo-message-file-name src-folder (car numbers))
(expand-file-name
(when (setq id (and src-msgdb-exists
(elmo-message-field src-folder (car numbers)
'message-id)))
- (elmo-flag-table-set table id flag))
+ (elmo-flag-table-set table id flags))
(elmo-progress-notify 'elmo-folder-move-messages)
(if (and (setq numbers (cdr numbers))
(not same-number))
(int-to-string new-number) t))
(elmo-msgdb-overview-entity-set-number entity new-number))
(elmo-msgdb-append-entity new-msgdb entity
- (elmo-msgdb-get-mark msgdb old-number))
+ (elmo-msgdb-flags msgdb old-number))
(setq new-number (1+ new-number))))
(message "Packing...done")
(elmo-folder-set-msgdb-internal folder new-msgdb)))
(cur (directory-files cur-dir
nil "^[^.].*$" t))
unread-locations flagged-locations answered-locations
- seen flagged answered sym locations)
+ sym locations flag-list)
(setq locations
(mapcar
(lambda (x)
(if (string-match "^\\([^:]+\\):\\([^:]+\\)$" x)
(progn
- (setq seen nil answered nil flagged nil)
- (save-match-data
- (cond
- ((string-match "F" (elmo-match-string 2 x))
- (setq flagged t))
- ((string-match "R" (elmo-match-string 2 x))
- (setq answered t))
- ((string-match "S" (elmo-match-string 2 x))
- (setq seen t))))
- (setq sym (elmo-match-string 1 x))
- (cond
- (flagged (setq flagged-locations
- (cons sym flagged-locations)))
- (answered (setq answered-locations
- (cons sym answered-locations)))
- (seen)
- (t
- (setq unread-locations (cons sym unread-locations))))
+ (setq sym (elmo-match-string 1 x)
+ flag-list (string-to-char-list
+ (elmo-match-string 2 x)))
+ (when (memq ?F flag-list)
+ (setq flagged-locations
+ (cons sym flagged-locations)))
+ (when (memq ?R flag-list)
+ (setq answered-locations
+ (cons sym answered-locations)))
+ (unless (memq ?S flag-list)
+ (setq unread-locations
+ (cons sym unread-locations)))
sym)
x))
cur))
((folder elmo-maildir-folder))
(elmo-maildir-folder-answered-locations-internal folder))
-(luna-define-method elmo-folder-msgdb-create
- ((folder elmo-maildir-folder) numbers flag-table)
+(luna-define-method elmo-folder-msgdb-create ((folder elmo-maildir-folder)
+ numbers flag-table)
(let* ((unread-list (elmo-maildir-folder-unread-locations-internal folder))
(flagged-list (elmo-maildir-folder-flagged-locations-internal folder))
(answered-list (elmo-maildir-folder-answered-locations-internal
(len (length numbers))
(new-msgdb (elmo-make-msgdb))
(i 0)
- entity message-id flag
- file location pair mark cache-status file-flag)
+ entity message-id flags location)
(message "Creating msgdb...")
(dolist (number numbers)
(setq location (elmo-map-message-location folder number))
(setq entity
(elmo-msgdb-create-overview-entity-from-file
number
- (setq file
- (elmo-maildir-message-file-name folder location))))
+ (elmo-maildir-message-file-name folder location)))
(when entity
- (setq message-id (elmo-message-entity-field
- entity 'message-id)
+ (setq message-id (elmo-message-entity-field entity 'message-id)
;; Precede flag-table to file-info.
- flag (elmo-flag-table-get flag-table message-id)
- file-flag nil
- mark nil
- cache-status
- (elmo-file-cache-status (elmo-file-cache-get message-id)))
-
+ flags (copy-sequence
+ (elmo-flag-table-get flag-table message-id)))
+
;; Already flagged on filename (precede it to flag-table).
- (cond
- ((member location flagged-list)
- (setq file-flag 'important
- mark elmo-msgdb-important-mark))
- ((member location answered-list)
- (setq file-flag 'answered
- mark (elmo-msgdb-mark 'answered cache-status)))
- ((member location unread-list)
- (setq file-flag 'unread
- mark (elmo-msgdb-mark 'unread cache-status)))
- (t (setq file-flag 'read)))
-
- ;; Set mark according to flag-table if file status is unread or read.
- (when (or (eq file-flag 'read)
- (eq file-flag 'unread))
- ;;
- (unless (eq 'read flag)
- (setq mark (elmo-msgdb-mark flag cache-status 'new)))
- ;; Update filename's info portion according to the flag-table.
- (cond
- ((and (or (eq flag 'important)
- (setq mark (elmo-msgdb-global-mark-get
- (elmo-message-entity-field
- entity 'message-id))))
- (not (eq file-flag 'important)))
- (elmo-maildir-set-mark file ?F)
- ;; Delete from unread location list.
- (elmo-maildir-folder-set-unread-locations-internal
- folder
- (delete location
- (elmo-maildir-folder-unread-locations-internal
- folder)))
- ;; Append to flagged location list.
- (elmo-maildir-folder-set-flagged-locations-internal
- folder
- (cons location
- (elmo-maildir-folder-flagged-locations-internal
+ (when (member location flagged-list)
+ (or (memq 'important flags)
+ (setq flags (cons 'important flags))))
+ (when (member location answered-list)
+ (or (memq 'answered flags)
+ (setq flags (cons 'answered flags))))
+ (unless (member location unread-list)
+ (and (memq 'unread flags)
+ (setq flags (delq 'unread flags))))
+
+ ;; Update filename's info portion according to the flag-table.
+ (when (and (memq 'important flags)
+ (not (member location flagged-list)))
+ (elmo-maildir-set-mark
+ (elmo-maildir-message-file-name folder location)
+ ?F)
+ ;; Append to flagged location list.
+ (elmo-maildir-folder-set-flagged-locations-internal
+ folder
+ (cons location
+ (elmo-maildir-folder-flagged-locations-internal
+ folder)))
+ (setq flags (delq 'unread flags)))
+ (when (and (memq 'answered flags)
+ (not (member location answered-list)))
+ (elmo-maildir-set-mark
+ (elmo-maildir-message-file-name folder location)
+ ?R)
+ ;; Append to answered location list.
+ (elmo-maildir-folder-set-answered-locations-internal
+ folder
+ (cons location
+ (elmo-maildir-folder-answered-locations-internal folder)))
+ (setq flags (delq 'unread flags)))
+ (when (and (not (memq 'unread flags))
+ (member location unread-list))
+ (elmo-maildir-set-mark
+ (elmo-maildir-message-file-name folder location)
+ ?S)
+ ;; Delete from unread locations.
+ (elmo-maildir-folder-set-unread-locations-internal
+ folder
+ (delete location
+ (elmo-maildir-folder-unread-locations-internal
folder))))
- ((and (eq flag 'answered)
- (not (eq file-flag 'answered)))
- (elmo-maildir-set-mark file ?R)
- ;; Delete from unread locations.
- (elmo-maildir-folder-set-unread-locations-internal
- folder
- (delete location
- (elmo-maildir-folder-unread-locations-internal folder)))
- ;; Append to answered location list.
- (elmo-maildir-folder-set-answered-locations-internal
- folder
- (cons location
- (elmo-maildir-folder-answered-locations-internal folder))))
- ((and (eq flag 'read)
- (not (eq file-flag 'read)))
- (elmo-maildir-set-mark file ?S)
- ;; Delete from unread locations.
- (elmo-maildir-folder-set-unread-locations-internal
- folder
- (delete location
- (elmo-maildir-folder-unread-locations-internal
- folder))))))
- (elmo-msgdb-append-entity new-msgdb entity mark)
+ (unless (memq 'unread flags)
+ (setq flags (delq 'new flags)))
+ (elmo-msgdb-append-entity new-msgdb entity flags)
(when (> len elmo-display-progress-threshold)
(setq i (1+ i))
(elmo-display-progress
(dir (elmo-maildir-folder-directory-internal folder))
(table (elmo-flag-table-load (elmo-folder-msgdb-path folder)))
(succeeds numbers)
- filename mark flag id)
+ filename flags id)
(dolist (number numbers)
- (setq mark (and src-msgdb-exists
- (elmo-message-mark src-folder (car numbers)))
- flag (cond
- ((null mark) 'read)
- ((member mark (elmo-msgdb-answered-marks))
- 'answered)
- ((not (member mark (elmo-msgdb-unread-marks)))
- 'read))
+ (setq flags (elmo-message-flags src-folder (car numbers))
filename (elmo-maildir-temporal-filename dir))
(elmo-copy-file
(elmo-message-file-name src-folder number)
(when (setq id (and src-msgdb-exists
(elmo-message-field src-folder (car numbers)
'message-id)))
- (elmo-flag-table-set table id flag))
+ (elmo-flag-table-set table id flags))
(elmo-progress-notify 'elmo-folder-move-messages))
(when (elmo-folder-persistent-p folder)
(elmo-flag-table-save (elmo-folder-msgdb-path folder) table))
(setq entity (elmo-msgdb-message-entity msgdb old-number))
(elmo-msgdb-overview-entity-set-number entity number)
(elmo-msgdb-append-entity new-msgdb entity
- (elmo-msgdb-get-mark msgdb old-number))
+ (elmo-msgdb-flags msgdb old-number))
(setq location
(cons (cons number
(elmo-map-message-location folder old-number))
(require 'std11)
(require 'mime)
-(defcustom elmo-msgdb-new-mark "N"
- "Mark for new message."
- :type '(string :tag "Mark")
- :group 'elmo)
-
-(defcustom elmo-msgdb-unread-uncached-mark "U"
- "Mark for unread and uncached message."
- :type '(string :tag "Mark")
- :group 'elmo)
-
-(defcustom elmo-msgdb-unread-cached-mark "!"
- "Mark for unread but already cached message."
- :type '(string :tag "Mark")
- :group 'elmo)
-
-(defcustom elmo-msgdb-read-uncached-mark "u"
- "Mark for read but uncached message."
- :type '(string :tag "Mark")
- :group 'elmo)
-
-(defcustom elmo-msgdb-answered-cached-mark "&"
- "Mark for answered and cached message."
- :type '(string :tag "Mark")
- :group 'elmo)
-
-(defcustom elmo-msgdb-answered-uncached-mark "A"
- "Mark for answered but cached message."
- :type '(string :tag "Mark")
- :group 'elmo)
-
-(defcustom elmo-msgdb-important-mark "$"
- "Mark for important message."
- :type '(string :tag "Mark")
- :group 'elmo)
+(defconst elmo-msgdb-new-mark "N"
+ "Mark for new message.")
+
+(defconst elmo-msgdb-unread-uncached-mark "U"
+ "Mark for unread and uncached message.")
+
+(defconst elmo-msgdb-unread-cached-mark "!"
+ "Mark for unread but already cached message.")
+
+(defconst elmo-msgdb-read-uncached-mark "u"
+ "Mark for read but uncached message.")
+
+(defconst elmo-msgdb-answered-cached-mark "&"
+ "Mark for answered and cached message.")
+
+(defconst elmo-msgdb-answered-uncached-mark "A"
+ "Mark for answered but cached message.")
+
+(defconst elmo-msgdb-important-mark "$"
+ "Mark for important message.")
;;; MSGDB interface.
;;
(and (not (member mark (elmo-msgdb-uncached-marks)))
'(cached))))
-(defsubst elmo-msgdb-flags-to-mark (flags cached use-cache)
+(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 cached
+ (if (memq 'cached flags)
elmo-msgdb-answered-cached-mark
elmo-msgdb-answered-uncached-mark))
((memq 'unread flags)
- (if cached
+ (if (memq 'cached flags)
elmo-msgdb-unread-cached-mark
elmo-msgdb-unread-uncached-mark))
(t
- (if (or cached (not use-cache))
+ (if (memq 'cached flags)
nil
elmo-msgdb-read-uncached-mark))))
elmo-msgdb-unread-uncached-mark
elmo-msgdb-read-uncached-mark))))
-(defun elmo-msgdb-append-entity (msgdb entity &optional mark)
+(defun elmo-msgdb-append-entity (msgdb entity &optional flags)
(when entity
(let ((number (elmo-msgdb-overview-entity-get-number entity))
- (message-id (elmo-msgdb-overview-entity-get-id entity)))
+ (message-id (elmo-msgdb-overview-entity-get-id entity))
+ mark)
(elmo-msgdb-set-overview
msgdb
(nconc (elmo-msgdb-get-overview msgdb)
msgdb
(nconc (elmo-msgdb-get-number-alist msgdb)
(list (cons number message-id))))
- (when mark
+ (when (setq mark (elmo-msgdb-flags-to-mark flags))
(elmo-msgdb-set-mark-alist
msgdb
(nconc (elmo-msgdb-get-mark-alist msgdb)
(let ((table (elmo-make-hash))
;; For backward compatibility
(seen-file (expand-file-name elmo-msgdb-seen-filename dir))
- seen-list)
+ value)
(when (file-exists-p seen-file)
- (setq seen-list (elmo-object-load seen-file))
+ (dolist (msgid (elmo-object-load seen-file))
+ (elmo-set-hash-val msgid '(read) table))
(delete-file seen-file))
- (dolist (msgid seen-list)
- (elmo-set-hash-val msgid 'read table))
(dolist (pair (elmo-object-load
(expand-file-name elmo-flag-table-filename dir)))
- (elmo-set-hash-val (car pair) (cdr pair) table))
+ (setq value (cdr pair))
+ (elmo-set-hash-val (car pair)
+ (cond ((consp value)
+ value)
+ ;; Following cases for backward compatibility.
+ (value
+ (list value))
+ (t
+ '(unread)))
+ table))
table))
-(defun elmo-flag-table-set (flag-table msg-id flag)
- (elmo-set-hash-val msg-id flag flag-table))
+(defun elmo-flag-table-set (flag-table msg-id flags)
+ (elmo-set-hash-val msg-id (or flags '(read)) flag-table))
(defun elmo-flag-table-get (flag-table msg-id)
- (elmo-get-hash-val msg-id flag-table))
+ (let ((flags (elmo-get-hash-val msg-id flag-table)))
+ (if flags
+ (append
+ (and (elmo-msgdb-global-mark-get msg-id)
+ '(important))
+ (and (elmo-file-cache-exists-p msg-id)
+ '(cached))
+ (elmo-list-delete '(important cached read)
+ (copy-sequence flags)
+ #'delq))
+ '(new unread))))
(defun elmo-flag-table-save (dir flag-table)
(elmo-object-save
(defun elmo-msgdb-flag-table (msgdb &optional flag-table)
;; Make a table of msgid flag (read, answered)
- (let ((flag-table (or flag-table (elmo-make-hash (elmo-msgdb-length msgdb))))
- mark)
- (dolist (ov (elmo-msgdb-get-overview msgdb))
- (setq mark (elmo-msgdb-get-mark
- msgdb
- (elmo-msgdb-overview-entity-get-number ov)))
- (cond
- ((null mark)
- (elmo-set-hash-val
- (elmo-msgdb-overview-entity-get-id ov)
- 'read
- flag-table))
- ((and mark (member mark (elmo-msgdb-answered-marks)))
- (elmo-set-hash-val
- (elmo-msgdb-overview-entity-get-id ov)
- 'answered
- flag-table))
- ((and mark (not (member mark
- (elmo-msgdb-unread-marks))))
- (elmo-set-hash-val
- (elmo-msgdb-overview-entity-get-id ov)
- 'read
- flag-table))))
+ (let ((flag-table (or flag-table
+ (elmo-make-hash (elmo-msgdb-length msgdb))))
+ entity)
+ (dolist (number (elmo-msgdb-list-messages msgdb))
+ (setq entity (elmo-msgdb-message-entity msgdb number))
+ (elmo-flag-table-set
+ flag-table
+ (elmo-msgdb-overview-entity-get-id entity)
+ (elmo-msgdb-flags msgdb number)))
flag-table))
;;
(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))
+
(defsubst elmo-msgdb-mark (flag cached &optional new)
(if new
(case flag
(let ((pair (elmo-multi-real-folder-number folder number)))
(elmo-message-field (car pair) (cdr pair) field)))
-(luna-define-method elmo-message-mark ((folder elmo-multi-folder) number)
- (let ((pair (elmo-multi-real-folder-number folder number)))
- (elmo-message-mark (car pair) (cdr pair))))
-
(luna-define-method elmo-message-flags ((folder elmo-multi-folder) number)
(let ((pair (elmo-multi-real-folder-number folder number)))
(elmo-message-flags (car pair) (cdr pair))))
flag-table
&optional numlist)
(let ((new-msgdb (elmo-make-msgdb))
- ov-list gmark message-id entity
+ ov-list message-id entity
ov-entity num
extras extra ext field field-index)
(setq ov-list (elmo-nntp-parse-overview-string str))
(while extras
(setq ext (downcase (car extras)))
(when (setq field-index (cdr (assoc ext elmo-nntp-overview-index)))
- (when (> (length ov-entity) field-index)
+ (when (> (length ov-entity) field-index)
(setq field (aref ov-entity field-index))
(when (eq field-index 8) ;; xref
(setq field (elmo-msgdb-remove-field-string field)))
- (setq extra (cons (cons ext field) extra))))
+ (setq extra (cons (cons ext field) extra))))
(setq extras (cdr extras)))
(setq entity (elmo-msgdb-make-message-entity
:message-id (aref ov-entity 4)
:size (string-to-int (aref ov-entity 6))
:extra extra))
(setq message-id (elmo-message-entity-field entity 'message-id))
- (setq gmark (or (elmo-msgdb-global-mark-get message-id)
- (elmo-msgdb-mark
- (elmo-flag-table-get flag-table message-id)
- (elmo-file-cache-status
- (elmo-file-cache-get message-id))
- 'new)))
- (elmo-msgdb-append-entity new-msgdb entity gmark))
+ (elmo-msgdb-append-entity new-msgdb entity
+ (elmo-flag-table-get flag-table message-id)))
(setq ov-list (cdr ov-list)))
new-msgdb))
(defun elmo-nntp-msgdb-create-message (len flag-table)
(save-excursion
(let ((new-msgdb (elmo-make-msgdb))
- beg entity i num gmark message-id)
+ beg entity i num message-id)
(elmo-set-buffer-multibyte nil)
(goto-char (point-min))
(setq i 0)
(elmo-msgdb-create-overview-from-buffer num))
(when entity
(setq message-id
- (elmo-message-entity-field entity 'message-id)
- gmark
- (or (elmo-msgdb-global-mark-get message-id)
- (elmo-msgdb-mark
- (elmo-flag-table-get flag-table message-id)
- (elmo-file-cache-status
- (elmo-file-cache-get message-id))
- 'new)))
- (elmo-msgdb-append-entity new-msgdb entity gmark)))))
+ (elmo-message-entity-field entity 'message-id))
+ (elmo-msgdb-append-entity
+ new-msgdb
+ entity
+ (elmo-flag-table-get flag-table message-id))))))
(when (> len elmo-display-progress-threshold)
(setq i (1+ i))
(if (or (zerop (% i 20)) (= i len))
(luna-define-method elmo-folder-count-flags ((folder elmo-pipe-folder))
(elmo-folder-count-flags (elmo-pipe-folder-dst-internal folder)))
-(luna-define-method elmo-message-mark ((folder elmo-pipe-folder) number)
- (elmo-message-mark (elmo-pipe-folder-dst-internal folder) number))
-
(luna-define-method elmo-message-flags ((folder elmo-pipe-folder) number)
(elmo-message-flags (elmo-pipe-folder-dst-internal folder) number))
loc-alist)
(save-excursion
(let ((new-msgdb (elmo-make-msgdb))
- beg entity i number message-id gmark)
+ beg entity i number message-id)
(set-buffer buffer)
(elmo-set-buffer-multibyte default-enable-multibyte-characters)
(goto-char (point-min))
loc-alist)))
(elmo-msgdb-overview-entity-set-number entity number)))
(setq message-id (elmo-message-entity-field entity 'message-id))
- (setq gmark (or (elmo-msgdb-global-mark-get message-id)
- (elmo-msgdb-mark
- (elmo-flag-table-get flag-table message-id)
- (elmo-file-cache-status
- (elmo-file-cache-get message-id))
- 'new)))
- (elmo-msgdb-append-entity new-msgdb entity gmark))))
+ (elmo-msgdb-append-entity
+ new-msgdb
+ entity
+ (elmo-flag-table-get flag-table message-id)))))
(when (> num elmo-display-progress-threshold)
(setq i (1+ i))
(if (or (zerop (% i 5)) (= i num))
(let ((i 0)
(len (length numbers))
(new-msgdb (elmo-make-msgdb))
- entity message-id mark)
+ entity message-id)
(message "Creating msgdb...")
(while numbers
(setq entity
(elmo-folder-killed-list-internal folder)
(list (car numbers))))
(setq message-id (elmo-msgdb-overview-entity-get-id entity))
- (setq mark (or (elmo-msgdb-global-mark-get message-id)
- (elmo-msgdb-mark
- (elmo-flag-table-get flag-table message-id)
- (elmo-file-cache-status
- (elmo-file-cache-get message-id))
- 'new)))
- (elmo-msgdb-append-entity new-msgdb entity mark))
+ (elmo-msgdb-append-entity new-msgdb entity
+ (elmo-flag-table-get flag-table message-id)))
(when (> len elmo-display-progress-threshold)
(setq i (1+ i))
(elmo-display-progress
(luna-define-method elmo-folder-msgdb-create ((folder elmo-shimbun-folder)
numlist flag-table)
(let ((new-msgdb (elmo-make-msgdb))
- entity i percent length msgid gmark)
+ entity i percent length msgid)
(setq length (length numlist))
(setq i 0)
(message "Creating msgdb...")
folder (car numlist)))
(when entity
(setq msgid (elmo-msgdb-overview-entity-get-id entity))
- (setq gmark (or (elmo-msgdb-global-mark-get msgid)
- (elmo-msgdb-mark
- (elmo-flag-table-get flag-table msgid)
- (elmo-file-cache-status
- (elmo-file-cache-get msgid))
- 'new)))
- (elmo-msgdb-append-entity new-msgdb entity gmark))
+ (elmo-msgdb-append-entity new-msgdb entity
+ (elmo-flag-table-get flag-table msgid)))
(when (> length elmo-display-progress-threshold)
(setq i (1+ i))
(setq percent (/ (* i 100) length))
(defun elmo-generic-folder-append-messages (folder src-folder numbers
same-number)
(let ((src-msgdb-exists (not (zerop (elmo-folder-length src-folder))))
- unseen table flag mark
+ unseen table flags
succeed-numbers failure cache id)
(setq table (elmo-flag-table-load (elmo-folder-msgdb-path folder)))
(with-temp-buffer
id (and src-msgdb-exists
(elmo-message-field src-folder (car numbers)
'message-id))
- mark (and src-msgdb-exists
- (elmo-message-mark src-folder (car numbers)))
- flag (and id
- (cond
- ((null mark) 'read)
- ((member mark (elmo-msgdb-answered-marks))
- 'answered)
- ;;
- ((not (member mark (elmo-msgdb-unread-marks)))
- 'read))))
+ flags (elmo-message-flags src-folder (car numbers)))
(condition-case nil
(setq cache (elmo-file-cache-get id)
failure
(> (buffer-size) 0)
(elmo-folder-append-buffer
folder
- flag
+ flags
(if same-number (car numbers))))))
(error (setq failure t)))
;; FETCH & APPEND finished
(unless failure
(when id
- (elmo-flag-table-set table id flag))
+ (elmo-flag-table-set table id flags))
(setq succeed-numbers (cons (car numbers) succeed-numbers)))
(elmo-progress-notify 'elmo-folder-move-messages)
(setq numbers (cdr numbers)))
'sugar' flag:
`read' (set unread flag)")
-(luna-define-generic elmo-message-mark (folder number)
- "Get mark of the message.
-FOLDER is the ELMO folder structure.
-NUMBER is a number of the message.")
-
-(luna-define-method elmo-message-mark ((folder elmo-folder) number)
- (when (zerop (elmo-folder-length folder))
- (error "Cannot treat this folder correctly."))
- (elmo-msgdb-get-mark (elmo-folder-msgdb folder) number))
-
(luna-define-generic elmo-message-field (folder number field)
"Get message field value in the msgdb.
FOLDER is the ELMO folder structure.
(when delete-list
(elmo-folder-detach-messages folder delete-list))
(when new-list
- (elmo-msgdb-change-mark (elmo-folder-msgdb folder)
- elmo-msgdb-new-mark
- elmo-msgdb-unread-uncached-mark)
+ (elmo-msgdb-out-of-date-messages (elmo-folder-msgdb folder))
(setq new-msgdb (elmo-folder-msgdb-create
folder new-list flag-table))
;; Clear flag-table
2003-09-13 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+ * wl-folder.el (wl-folder-count-incorporates): Don't use
+ `elmo-msgdb-mark-load'
+
* Version number is increased to 2.11.11.
2003-09-13 Yoichi NAKAYAMA <yoichi@geiin.org>
(cons 0 0))))))
(defun wl-folder-count-incorporates (folder)
- (let ((marks (elmo-msgdb-mark-load
- (elmo-folder-msgdb-path folder)))
- (sum 0))
- (while marks
- (if (member (cadr (car marks))
- wl-summary-incorporate-marks)
- (incf sum))
- (setq marks (cdr marks)))
+ (let ((sum 0))
+ (dolist (number (elmo-folder-list-flagged folder 'any))
+ (when (member (wl-summary-message-mark folder number)
+ wl-summary-incorporate-marks)
+ (incf sum)))
sum))
(defun wl-folder-prefetch-current-entity (&optional no-check)
projects / elisp / wanderlust.git / commitdiff