X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo.el;h=b2a437ca37244e528dca31376de45a200eeef68e;hb=5c1eebd3c1ab3423cd2c1749be5af1a128905783;hp=1cc9ba705d4a902cc4f19c693d5506d5be23f8ad;hpb=51f9787799e1f8a5ad1f9cde0fd99489dae071c3;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo.el b/elmo/elmo.el index 1cc9ba7..b2a437c 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)))) @@ -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). @@ -684,6 +695,9 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).") (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 +709,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 +863,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)) @@ -880,32 +963,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 @@ -1119,9 +1209,10 @@ FIELD is a symbol of the field." (defun elmo-folder-confirm-appends (appends) (let ((len (length appends)) in) - (if (and (> len elmo-folder-update-threshold) + (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 @@ -1131,11 +1222,12 @@ 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)) - (if (and (> len elmo-folder-update-threshold) + (if (and elmo-folder-update-threshold + (> len elmo-folder-update-threshold) (not elmo-folder-update-confirm)) (nthcdr (max (- len elmo-folder-update-threshold) 0) appends) appends)))) @@ -1150,8 +1242,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) @@ -1161,24 +1252,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) @@ -1252,16 +1356,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) @@ -1309,30 +1404,6 @@ 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)) @@ -1400,7 +1471,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 @@ -1459,12 +1530,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 @@ -1473,6 +1548,19 @@ 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")