X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo.el;h=d17aeca7e4bbf6c5089112bd16d268a549a00f91;hb=4e796a3f149bcb0aa9824d1cd26285503c35339d;hp=fd028a5e6d37fd456fd32e2ce3d51192996e2b3c;hpb=8a904e672d37313e1299d795a71a8c9652439b00;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo.el b/elmo/elmo.el index fd028a5..d17aeca 100644 --- a/elmo/elmo.el +++ b/elmo/elmo.el @@ -77,7 +77,7 @@ Otherwise, entire fetching of the message is aborted without confirmation." (elmo-define-error 'elmo-error "Error" 'error) (elmo-define-error 'elmo-open-error "Cannot open" 'elmo-error) (elmo-define-error 'elmo-authenticate-error "Login failed" 'elmo-open-error) -(elmo-define-error 'elmo-imap4-bye-error "IMAP4 BYE response" 'elmo-open-error) +(elmo-define-error 'elmo-imap4-bye-error "IMAP4 session was terminated" 'elmo-open-error) (defun elmo-define-folder (prefix backend) "Define a folder. @@ -109,6 +109,7 @@ If a folder name begins with PREFIX, use BACKEND." message-modified ; message is modified. mark-modified ; mark is modified. process-duplicates ; read or hide + biff ; folder for biff )) (luna-define-internal-accessors 'elmo-folder)) @@ -193,7 +194,9 @@ If optional KEEP-KILLED is non-nil, killed-list is not cleared.") "Get diff of FOLDER. If optional NUMBERS is set, it is used as current NUMBERS. Otherwise, saved status for folder is used for comparison. -Return value is a cons cell of NEWS and MESSAGES.") +Return value is cons cell or list: + - a cons cell (NEWS . MESSAGES) + - a list (RECENT UNSEEN MESSAGES) ; RECENT means NEWS, UNSEEN means UNREAD.") (luna-define-generic elmo-folder-status (folder) "Returns a cons cell of (MAX-NUMBER . MESSAGES) in the FOLDER.") @@ -244,7 +247,7 @@ IMPORTANT-MARK is the important mark." (elmo-object-load (expand-file-name elmo-msgdb-global-mark-filename - elmo-msgdb-dir))))) + elmo-msgdb-directory))))) (if (and (string= important-mark (cdr mark-pair)) (setq num-pair (rassoc (car mark-pair) number-alist))) (setq result (cons (car num-pair) result)))) @@ -275,7 +278,7 @@ IMPORTANT-MARK is the important mark." (luna-define-generic elmo-folder-list-subfolders (folder &optional one-level) "Returns a list of subfolders contained in FOLDER. If optional argument ONE-LEVEL is non-nil, only children of FOLDER is returned. -(a folder which have children is returned as a list) +\(a folder which have children is returned as a list\) Otherwise, all descendent folders are returned.") (luna-define-generic elmo-folder-have-subfolder-p (folder) @@ -313,10 +316,18 @@ NUMBERS is a list of message numbers to be deleted.") (luna-define-generic elmo-folder-search (folder condition &optional numbers) "Search and return list of message numbers. FOLDER is the ELMO folder structure. -CONDITION is a condition string for searching. +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-message-match-condition (folder number + condition + numbers) + "Return non-nil when the message in the FOLDER with NUMBER is matched. +CONDITION is a condition structure for testing. +NUMBERS is a list of message numbers, +use to be test for \"last\" and \"first\" predicates.") + (luna-define-generic elmo-folder-msgdb-create (folder numbers new-mark already-mark seen-mark important-mark seen-list) "Create a message database (implemented in each backends). @@ -351,7 +362,7 @@ NUMBERS is a list of message numbers to be processed.") FOLDER is the destination folder(ELMO folder structure). If UNREAD is non-nil, message is appended as unread. If optional argument NUMBER is specified, the new message number is set -(if possible).") +\(if possible\).") (luna-define-generic elmo-folder-append-messages (folder src-folder @@ -474,6 +485,8 @@ Return newly created temporary directory name which contains temporary files.") (setq message-id (elmo-msgdb-overview-entity-get-id entity)) (setq number (elmo-msgdb-overview-entity-get-number entity)) (setq cache-file (elmo-file-cache-get message-id)) + (setq ignore-cache (or ignore-cache + (null (elmo-message-use-cache-p folder number)))) (if (or ignore-cache (null (elmo-file-cache-status cache-file))) ;; No cache or ignore-cache. @@ -679,11 +692,14 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).") (elmo-folder-persistent-internal folder)) (luna-define-method elmo-folder-creatable-p ((folder elmo-folder)) - t) ; default is creatable. + nil) ; default is not creatable. (luna-define-method elmo-folder-writable-p ((folder elmo-folder)) nil) ; default is not writable. +(luna-define-method elmo-folder-delete ((folder elmo-folder)) + (elmo-msgdb-delete-path folder)) + (luna-define-method elmo-folder-rename ((folder elmo-folder) new-name) (let* ((new-folder (elmo-make-folder new-name))) (unless (eq (elmo-folder-type-internal folder) @@ -695,6 +711,77 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).") (elmo-folder-send folder 'elmo-folder-rename-internal new-folder) (elmo-msgdb-rename-path folder new-folder))) +(defsubst elmo-folder-search-fast (folder condition numbers) + (when (and numbers + (vectorp condition) + (member (elmo-filter-key condition) '("first" "last"))) + (let ((len (length numbers)) + (lastp (string= (elmo-filter-key condition) "last")) + (value (string-to-number (elmo-filter-value condition)))) + (when (eq (elmo-filter-type condition) 'unmatch) + (setq lastp (not lastp) + value (- len value))) + (if lastp + (nthcdr (max (- len value) 0) numbers) + (when (> value 0) + (let ((last (nthcdr (1- value) numbers))) + (when last + (setcdr last nil)) + numbers)))))) + +(luna-define-method elmo-folder-search ((folder elmo-folder) + condition + &optional numbers) + (let ((numbers (or numbers (elmo-folder-list-messages folder)))) + (or (elmo-folder-search-fast folder condition numbers) + (let ((msgdb (elmo-folder-msgdb folder)) + (len (length numbers)) + matched) + (when (> len elmo-display-progress-threshold) + (elmo-progress-set 'elmo-folder-search len "Searching...")) + (unwind-protect + (dolist (number numbers) + (let ((entity (elmo-msgdb-overview-get-entity number msgdb)) + result) + (if entity + (setq result (elmo-msgdb-match-condition + condition + entity + numbers)) + (setq result condition)) + (when (elmo-filter-condition-p result) + (setq result (elmo-message-match-condition + folder + number + condition + numbers))) + (when result + (setq matched (cons number matched)))) + (elmo-progress-notify 'elmo-folder-search)) + (elmo-progress-clear 'elmo-folder-search)) + (nreverse matched))))) + +(luna-define-method elmo-message-match-condition ((folder elmo-folder) + number condition + numbers) + (let ((filename (cond + ((elmo-message-file-name folder number)) + ((let* ((cache (elmo-file-cache-get + (elmo-message-field folder number + 'message-id))) + (cache-path (elmo-file-cache-path cache))) + (when (and cache-path + (not (elmo-cache-path-section-p cache-path))) + cache-path)))))) + (when (and filename + (file-readable-p filename)) + (with-temp-buffer + (insert-file-contents-as-binary filename) + (elmo-set-buffer-multibyte default-enable-multibyte-characters) + ;; Should consider charset? + (decode-mime-charset-region (point-min) (point-max) elmo-mime-charset) + (elmo-buffer-field-condition-match condition number numbers))))) + (luna-define-method elmo-folder-pack-numbers ((folder elmo-folder)) nil) ; default is noop. @@ -778,13 +865,11 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).") (setq elmo-folder-info-hashtb hashtb))) (defsubst elmo-diff-new (diff) - (when (consp (cdr diff)) - (car diff))) + (car diff)) (defsubst elmo-diff-unread (diff) - (if (consp (cdr diff)) - (nth 1 diff) - (car diff))) + (when (consp (cdr diff)) + (nth 1 diff))) (defsubst elmo-diff-all (diff) (if (consp (cdr diff)) @@ -845,8 +930,7 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).") (if (and in-folder (null in-db)) (cdr in-folder) - (if (null (car in-folder)) - nil)))) + (car in-folder)))) (setq messages (cdr in-folder)) (if (and unsync messages (> unsync messages)) (setq unsync messages)) @@ -880,32 +964,39 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).") unread-marks same-number) (let (unseen seen-list succeed-numbers failure cache) (with-temp-buffer + (set-buffer-multibyte nil) (while numbers (setq failure nil) (condition-case nil - (progn - (elmo-message-fetch - src-folder (car numbers) - (if (and (not (elmo-folder-plugged-p src-folder)) - elmo-enable-disconnected-operation - (setq cache (elmo-file-cache-get - (elmo-message-field - src-folder (car numbers) - 'message-id))) - (eq (elmo-file-cache-status cache) 'entire)) - (elmo-make-fetch-strategy - 'entire t nil (elmo-file-cache-path cache)) - (elmo-make-fetch-strategy 'entire t)) - nil (current-buffer) - 'unread) - (unless (eq (buffer-size) 0) - (setq failure (not - (elmo-folder-append-buffer - folder - (setq unseen (member (elmo-message-mark - src-folder (car numbers)) - unread-marks)) - (if same-number (car numbers))))))) + (setq cache (elmo-file-cache-get + (elmo-message-field src-folder + (car numbers) + 'message-id)) + failure + (not + (and + (elmo-message-fetch + src-folder (car numbers) + (if (elmo-folder-plugged-p src-folder) + (elmo-make-fetch-strategy + 'entire 'maybe nil + (and cache (elmo-file-cache-path cache))) + (or (and elmo-enable-disconnected-operation + cache + (eq (elmo-file-cache-status cache) 'entire) + (elmo-make-fetch-strategy + 'entire t nil + (elmo-file-cache-path cache))) + (error "Unplugged"))) + nil (current-buffer) + 'unread) + (> (buffer-size) 0) + (elmo-folder-append-buffer + folder + (setq unseen (member (elmo-message-mark + src-folder (car numbers)) + unread-marks)) + (if same-number (car numbers)))))) (error (setq failure t))) ;; FETCH & APPEND finished (unless failure @@ -999,7 +1090,7 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).") "Get mark of the message. FOLDER is the ELMO folder structure. NUMBER is a number of the message." - (cadr (assq number (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder))))) + (elmo-msgdb-get-mark (elmo-folder-msgdb folder) number)) (defun elmo-folder-list-messages-mark-match (folder mark-regexp) "List messages in the FOLDER which have a mark that matches MARK-REGEXP" @@ -1016,33 +1107,13 @@ NUMBER is a number of the message." FOLDER is the ELMO folder structure. NUMBER is a number of the message. FIELD is a symbol of the field." - (case field - (message-id (elmo-msgdb-overview-entity-get-id - (elmo-msgdb-overview-get-entity - number (elmo-folder-msgdb folder)))) - (subject (elmo-msgdb-overview-entity-get-subject - (elmo-msgdb-overview-get-entity - number (elmo-folder-msgdb folder)))) - (size (elmo-msgdb-overview-entity-get-size - (elmo-msgdb-overview-get-entity - number (elmo-folder-msgdb folder)))) - (date (elmo-msgdb-overview-entity-get-date - (elmo-msgdb-overview-get-entity - number (elmo-folder-msgdb folder)))) - (to (elmo-msgdb-overview-entity-get-to - (elmo-msgdb-overview-get-entity - number (elmo-folder-msgdb folder)))) - (cc (elmo-msgdb-overview-entity-get-cc - (elmo-msgdb-overview-get-entity - number (elmo-folder-msgdb folder)))))) + (elmo-msgdb-get-field (elmo-folder-msgdb folder) number field)) (defun elmo-message-set-mark (folder number mark) "Set mark for the message in the FOLDER with NUMBER as MARK." - (elmo-msgdb-set-mark-alist + (elmo-msgdb-set-mark (elmo-folder-msgdb folder) - (elmo-msgdb-mark-set - (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder)) - number mark))) + number mark)) (luna-define-method elmo-message-use-cache-p ((folder elmo-folder) number) nil) ; default is not use cache. @@ -1069,6 +1140,19 @@ FIELD is a symbol of the field." ;; Do nothing. ) +(defsubst elmo-folder-replace-marks (folder alist) + "Replace marks of the FOLDER according to ALIST." + (let (pair) + (dolist (elem (elmo-msgdb-get-mark-alist (elmo-folder-msgdb folder))) + (when (setq pair (assoc (cadr elem) alist)) + (if (elmo-message-use-cache-p folder (car elem)) + (elmo-msgdb-set-mark (elmo-folder-msgdb folder) + (car elem) + (cdr pair)) + (elmo-msgdb-set-mark (elmo-folder-msgdb folder) + (car elem) + nil)))))) + (defun elmo-generic-folder-append-msgdb (folder append-msgdb) (if append-msgdb (let* ((number-alist (elmo-msgdb-get-number-alist append-msgdb)) @@ -1108,7 +1192,7 @@ FIELD is a symbol of the field." (elmo-folder-set-msgdb-internal folder (elmo-msgdb-append (elmo-folder-msgdb folder) - append-msgdb t)) + append-msgdb)) (length to-be-deleted)) 0)) @@ -1122,7 +1206,7 @@ FIELD is a symbol of the field." (if (and elmo-folder-update-threshold (> len elmo-folder-update-threshold) elmo-folder-update-confirm) - (if (y-or-n-p (format "Too many messages(%d). Continue? " len)) + (if (y-or-n-p (format "Too many messages(%d). Update all? " len)) appends (setq in elmo-folder-update-threshold) (catch 'end @@ -1132,7 +1216,7 @@ FIELD is a symbol of the field." in (string-to-int in)) (if (< len in) (throw 'end len)) - (if (y-or-n-p (format "%d messages are disappeared. OK? " + (if (y-or-n-p (format "%d messages are not appeared. OK? " (max (- len in) 0))) (throw 'end in)))) (nthcdr (max (- len in) 0) appends)) @@ -1152,8 +1236,7 @@ FIELD is a symbol of the field." (with-current-buffer outbuf (erase-buffer) (elmo-message-fetch-with-cache-process folder number - strategy section unread) - t) + strategy section unread)) (with-temp-buffer (elmo-message-fetch-with-cache-process folder number strategy section unread) @@ -1163,24 +1246,37 @@ FIELD is a symbol of the field." number strategy &optional section unread) - (let (cache-path cache-file) - (if (and (elmo-fetch-strategy-use-cache strategy) - (setq cache-path (elmo-fetch-strategy-cache-path strategy)) - (setq cache-file (elmo-file-cache-expand-path - cache-path - section)) - (file-exists-p cache-file) - (or (not (elmo-cache-path-section-p cache-file)) - (not (eq (elmo-fetch-strategy-entireness strategy) 'entire)))) - (insert-file-contents-as-binary cache-file) - (elmo-message-fetch-internal folder number strategy section unread) - (elmo-delete-cr-buffer) - (when (and (> (buffer-size) 0) - (elmo-fetch-strategy-save-cache strategy) - (elmo-fetch-strategy-cache-path strategy)) - (elmo-file-cache-save - (elmo-fetch-strategy-cache-path strategy) - section))))) + (let ((cache-path (elmo-fetch-strategy-cache-path strategy)) + (method-priorities + (cond ((eq (elmo-fetch-strategy-use-cache strategy) 'maybe) + '(entity cache)) + ((elmo-fetch-strategy-use-cache strategy) + '(cache entity)) + (t + '(entity)))) + result err) + (while (and method-priorities + (null result)) + (setq result + (case (car method-priorities) + (cache + (elmo-file-cache-load cache-path section)) + (entity + (when (and (condition-case error + (elmo-message-fetch-internal folder number + strategy + section + unread) + (error (setq err error) nil)) + (> (buffer-size) 0)) + (elmo-delete-cr-buffer) + (when (and (elmo-fetch-strategy-save-cache strategy) + cache-path) + (elmo-file-cache-save cache-path section)) + t))) + method-priorities (cdr method-priorities))) + (or result + (and err (signal (car err) (cdr err)))))) (luna-define-method elmo-folder-clear ((folder elmo-folder) &optional keep-killed) @@ -1228,9 +1324,9 @@ If update process is interrupted, return nil." (if ignore-msgdb (progn (setq seen-list (nconc - (elmo-msgdb-mark-alist-to-seen-list - number-alist mark-alist - (concat important-mark read-uncached-mark)) + (elmo-msgdb-seen-list + (elmo-folder-msgdb folder) + (list important-mark read-uncached-mark)) seen-list)) (elmo-folder-clear folder (eq ignore-msgdb 'visible-only)))) (unless no-check (elmo-folder-check folder)) @@ -1254,16 +1350,7 @@ If update process is interrupted, return nil." (length new-list))) (setq diff-2 (elmo-list-diff (car diff) new-list))) (elmo-msgdb-append-to-killed-list folder (car diff-2))) - ;; Don't delete important marked messages. - (setq delete-list - (if (eq (elmo-folder-type-internal folder) 'mark) - (cadr diff) - (elmo-delete-if - (lambda (x) - (and (setq mark (cadr (assq x mark-alist))) - (string= mark important-mark))) - ;; delete message list - (cadr diff)))) + (setq delete-list (cadr diff)) (if (or (equal diff '(nil nil)) (equal diff '(nil)) (and (eq (length (car diff)) 0) @@ -1311,43 +1398,18 @@ If update process is interrupted, return nil." (elmo-folder-msgdb folder)))) ;;; -(defun elmo-msgdb-search (folder condition msgdb) - "Search messages which satisfy CONDITION from FOLDER with MSGDB." - (let* ((condition (car (elmo-parse-search-condition condition))) - (overview (elmo-msgdb-get-overview msgdb)) - (number-alist (elmo-msgdb-get-number-alist msgdb)) - (number-list (mapcar 'car number-alist)) - (length (length overview)) - (i 0) - result) - (if (not (elmo-condition-in-msgdb-p condition)) - (elmo-folder-search folder condition number-list) - (while overview - (if (elmo-msgdb-search-internal condition (car overview) - number-list) - (setq result - (cons - (elmo-msgdb-overview-entity-get-number (car overview)) - result))) - (setq i (1+ i)) - (elmo-display-progress - 'elmo-msgdb-search "Searching..." (/ (* i 100) length)) - (setq overview (cdr overview))) - (nreverse result)))) - -(defun elmo-msgdb-load (folder) - (message "Loading msgdb for %s..." (elmo-folder-name-internal folder)) - (let* ((path (elmo-folder-msgdb-path folder)) - (overview (elmo-msgdb-overview-load path)) - (msgdb (list overview - (elmo-msgdb-number-load path) - (elmo-msgdb-mark-load path) - (elmo-msgdb-make-overview-hashtb overview)))) - (message "Loading msgdb for %s...done" (elmo-folder-name-internal folder)) +(defun elmo-msgdb-load (folder &optional silent) + (unless silent + (message "Loading msgdb for %s..." (elmo-folder-name-internal folder))) + (let ((msgdb (elmo-load-msgdb (elmo-folder-msgdb-path folder)))) (elmo-folder-set-info-max-by-numdb folder (elmo-msgdb-get-number-alist msgdb)) + + (unless silent + (message "Loading msgdb for %s...done" + (elmo-folder-name-internal folder))) msgdb)) - + (defun elmo-msgdb-delete-path (folder) (let ((path (elmo-folder-msgdb-path folder))) (if (file-directory-p path) @@ -1402,7 +1464,7 @@ Return a hashtable for newsgroups." (elmo-crosspost-alist-save elmo-crosspost-message-alist) (setq elmo-crosspost-message-alist-modified nil)))) -(defun elmo-folder-make-temp-dir (folder) +(defun elmo-folder-make-temporary-directory (folder) ;; Make a temporary directory for FOLDER. (let ((temp-dir (make-temp-name (concat @@ -1461,12 +1523,16 @@ Return a hashtable for newsgroups." 'elmo-imap4-default-user) (elmo-define-obsolete-variable 'elmo-default-imap4-port 'elmo-imap4-default-port) +(elmo-define-obsolete-variable 'elmo-default-imap4-stream-type + 'elmo-imap4-default-stream-type) (elmo-define-obsolete-variable 'elmo-default-nntp-server 'elmo-nntp-default-server) (elmo-define-obsolete-variable 'elmo-default-nntp-user 'elmo-nntp-default-user) (elmo-define-obsolete-variable 'elmo-default-nntp-port 'elmo-nntp-default-port) +(elmo-define-obsolete-variable 'elmo-default-nntp-stream-type + 'elmo-nntp-default-stream-type) (elmo-define-obsolete-variable 'elmo-default-pop3-server 'elmo-pop3-default-server) (elmo-define-obsolete-variable 'elmo-default-pop3-user @@ -1475,9 +1541,23 @@ Return a hashtable for newsgroups." 'elmo-pop3-default-authenticate-type) (elmo-define-obsolete-variable 'elmo-default-pop3-port 'elmo-pop3-default-port) +(elmo-define-obsolete-variable 'elmo-default-pop3-stream-type + 'elmo-pop3-default-stream-type) +(elmo-define-obsolete-variable 'elmo-cache-dirname + 'elmo-cache-directory) +(elmo-define-obsolete-variable 'elmo-msgdb-dir + 'elmo-msgdb-directory) + +;; Obsolete functions. +;; 2001-12-11: *-dir -> *-directory +(defalias 'elmo-folder-make-temp-dir 'elmo-folder-make-temporary-directory) +(make-obsolete 'elmo-folder-make-temp-dir + 'elmo-folder-make-temporary-directory) + ;; autoloads (autoload 'elmo-dop-queue-flush "elmo-dop") +(autoload 'elmo-nntp-post "elmo-nntp") (require 'product) (product-provide (provide 'elmo) (require 'elmo-version))