From: hmurata Date: Sun, 23 Dec 2001 18:40:40 +0000 (+0000) Subject: * elmo.el (elmo-generic-folder-append-messages): Make X-Git-Tag: wl-2_9_5~68 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=47972777916535ae9ea19df8ae993dd0aba58546;p=elisp%2Fwanderlust.git * elmo.el (elmo-generic-folder-append-messages): Make fetch-strategy with `use-cache' as 'maybe. Check return value of `elmo-message-fetch'. (elmo-message-fetch): Return return value of `elmo-message-fetch-with-cache-process'. (elmo-message-fetch-with-cache-process): Return non-nil if fetching was succeed. Load cache when fetching was failed and fetch-strategy-use-cache is 'maybe. * elmo-util.el (elmo-file-cache-load): New function. * elmo-multi.el (elmo-message-use-cache-p): Remove duplicated defun. * elmo-archive.el (elmo-archive-message-fetch-internal): Return non-nil if fetching was succeed. * elmo-imap4.el (elmo-imap4-message-fetch): Likewise. * elmo-nmz.el (elmo-map-message-fetch): Likewise. * elmo-nntp.el (elmo-nntp-read-body): Likewise. (elmo-message-fetch-with-cache-process): Likwise. * elmo-pop3.el (elmo-pop3-read-body): Likewise. * elmo-shimbun.el (elmo-map-message-fetch): Likewise. --- diff --git a/elmo/ChangeLog b/elmo/ChangeLog index c63b0e3..6ad0a89 100644 --- a/elmo/ChangeLog +++ b/elmo/ChangeLog @@ -1,5 +1,33 @@ 2001-12-23 Hiroya Murata + * elmo.el (elmo-generic-folder-append-messages): Make + fetch-strategy with `use-cache' as 'maybe. Check return value of + `elmo-message-fetch'. + (elmo-message-fetch): Return return value of + `elmo-message-fetch-with-cache-process'. + (elmo-message-fetch-with-cache-process): Return non-nil if + fetching was succeed. Load cache when fetching was failed and + fetch-strategy-use-cache is 'maybe. + + * elmo-util.el (elmo-file-cache-load): New function. + + * elmo-multi.el (elmo-message-use-cache-p): Remove duplicated + defun. + + * elmo-archive.el (elmo-archive-message-fetch-internal): Return + non-nil if fetching was succeed. + + * elmo-imap4.el (elmo-imap4-message-fetch): Likewise. + + * elmo-nmz.el (elmo-map-message-fetch): Likewise. + + * elmo-nntp.el (elmo-nntp-read-body): Likewise. + (elmo-message-fetch-with-cache-process): Likwise. + + * elmo-pop3.el (elmo-pop3-read-body): Likewise. + + * elmo-shimbun.el (elmo-map-message-fetch): Likewise. + * elmo-version.el (elmo-version): Up to 2.9.2. 2001-12-23 Yuuichi Teranishi diff --git a/elmo/elmo-archive.el b/elmo/elmo-archive.el index f55cfe4..fe7a2b8 100644 --- a/elmo/elmo-archive.el +++ b/elmo/elmo-archive.el @@ -551,11 +551,12 @@ TYPE specifies the archiver's symbol." (method (elmo-archive-get-method type 'cat)) (args (list arc (elmo-concat-path prefix (int-to-string number))))) - (when (file-exists-p arc) - (and - (as-binary-process - (elmo-archive-call-method method args t)) - (elmo-delete-cr-buffer))))) + (and (file-exists-p arc) + (as-binary-process + (elmo-archive-call-method method args t)) + (progn + (elmo-delete-cr-buffer) + t)))) (luna-define-method elmo-message-fetch-internal ((folder elmo-archive-folder) number strategy diff --git a/elmo/elmo-imap4.el b/elmo/elmo-imap4.el index 8d14bf7..2e7e1bd 100644 --- a/elmo/elmo-imap4.el +++ b/elmo/elmo-imap4.el @@ -2530,7 +2530,8 @@ If optional argument REMOVE is non-nil, remove FLAG." response 'fetch))) (with-current-buffer outbuf (erase-buffer) - (insert response))))) + (insert response) + t)))) (luna-define-method elmo-message-fetch-plugged ((folder elmo-imap4-folder) number strategy diff --git a/elmo/elmo-multi.el b/elmo/elmo-multi.el index 546dd60..800cf34 100644 --- a/elmo/elmo-multi.el +++ b/elmo/elmo-multi.el @@ -104,13 +104,6 @@ (setq children (cdr children))) match)) -(luna-define-method elmo-message-use-cache-p ((folder elmo-multi-folder) - number) - (elmo-message-use-cache-p - (nth (- (/ number (elmo-multi-folder-divide-number-internal folder)) 1) - (elmo-multi-folder-children-internal folder)) - (% number (elmo-multi-folder-divide-number-internal folder)))) - (luna-define-method elmo-message-folder ((folder elmo-multi-folder) number) (nth (- (/ number (elmo-multi-folder-divide-number-internal folder)) 1) @@ -564,7 +557,7 @@ (luna-define-method elmo-message-file-name ((folder elmo-multi-folder) number) (let ((pair (elmo-multi-real-folder-number folder number))) (elmo-message-file-name (car pair) (cdr pair)))) - + (luna-define-method elmo-folder-plugged-p ((folder elmo-multi-folder)) (let ((flds (elmo-multi-folder-children-internal folder))) (catch 'plugged diff --git a/elmo/elmo-nmz.el b/elmo/elmo-nmz.el index cda62cb..5fb36b9 100644 --- a/elmo/elmo-nmz.el +++ b/elmo/elmo-nmz.el @@ -189,29 +189,30 @@ If the value is a list, all elements are used as index paths for namazu." location strategy &optional section unseen) (when (file-exists-p location) - (insert-file-contents-as-binary location) - (unless (or (std11-field-body "To") - (std11-field-body "Cc") - (std11-field-body "Subject")) - (let (charset guess uid) - (erase-buffer) - (set-buffer-multibyte t) - (insert-file-contents location) - (setq charset (detect-mime-charset-region (point-min) - (point-max))) - (goto-char (point-min)) - (setq guess (mime-find-file-type location)) - (setq uid (nth 2 (file-attributes location))) - (insert "From: " (concat (user-full-name uid) - " <"(user-login-name uid) "@" - (system-name) ">") "\n") - (insert "Subject: " location "\n") - (insert "Content-Type: " - (concat (nth 0 guess) "/" (nth 1 guess)) - "; charset=" (upcase (symbol-name charset)) - "\nMIME-Version: 1.0\n\n") - (encode-mime-charset-region (point-min) (point-max) charset) - (set-buffer-multibyte nil))))) + (prog1 + (insert-file-contents-as-binary location) + (unless (or (std11-field-body "To") + (std11-field-body "Cc") + (std11-field-body "Subject")) + (let (charset guess uid) + (erase-buffer) + (set-buffer-multibyte t) + (insert-file-contents location) + (setq charset (detect-mime-charset-region (point-min) + (point-max))) + (goto-char (point-min)) + (setq guess (mime-find-file-type location)) + (setq uid (nth 2 (file-attributes location))) + (insert "From: " (concat (user-full-name uid) + " <"(user-login-name uid) "@" + (system-name) ">") "\n") + (insert "Subject: " location "\n") + (insert "Content-Type: " + (concat (nth 0 guess) "/" (nth 1 guess)) + "; charset=" (upcase (symbol-name charset)) + "\nMIME-Version: 1.0\n\n") + (encode-mime-charset-region (point-min) (point-max) charset) + (set-buffer-multibyte nil)))))) (luna-define-method elmo-map-folder-list-message-locations ((folder elmo-nmz-folder)) diff --git a/elmo/elmo-nntp.el b/elmo/elmo-nntp.el index 4bbf723..102b94c 100644 --- a/elmo/elmo-nntp.el +++ b/elmo/elmo-nntp.el @@ -389,7 +389,8 @@ Don't cache if nil.") (with-current-buffer outbuf (erase-buffer) (insert-buffer-substring (elmo-network-session-buffer session) - start (- end 3)))))) + start (- end 3)))) + t)) (defun elmo-nntp-select-group (session group &optional force) (let (response) @@ -963,12 +964,14 @@ Don't cache if nil.") (with-current-buffer (elmo-network-session-buffer session) (std11-field-body "Newsgroups"))))) -(luna-define-method elmo-message-fetch-with-cache-process :after +(luna-define-method elmo-message-fetch-with-cache-process :around ((folder elmo-nntp-folder) number strategy &optional section unread) - (elmo-nntp-setup-crosspost-buffer folder number) - (unless unread - (elmo-nntp-folder-update-crosspost-message-alist - folder (list number)))) + (when (luna-call-next-method) + (elmo-nntp-setup-crosspost-buffer folder number) + (unless unread + (elmo-nntp-folder-update-crosspost-message-alist + folder (list number))) + t)) (luna-define-method elmo-message-fetch-plugged ((folder elmo-nntp-folder) number strategy diff --git a/elmo/elmo-pop3.el b/elmo/elmo-pop3.el index 94caee7..c1e63bd 100644 --- a/elmo/elmo-pop3.el +++ b/elmo/elmo-pop3.el @@ -825,7 +825,8 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (setq end (point)) (with-current-buffer outbuf (erase-buffer) - (insert-buffer-substring (process-buffer process) start (- end 3)))))) + (insert-buffer-substring (process-buffer process) start (- end 3))) + t))) (luna-define-method elmo-folder-open-internal ((folder elmo-pop3-folder)) (if (and (not elmo-inhibit-number-mapping) @@ -872,7 +873,7 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (when (null (setq response (elmo-pop3-read-response process t))) (error "Fetching message failed")) - (setq response (elmo-pop3-read-body process outbuf))) + (setq response (elmo-pop3-read-body process outbuf))) (setq elmo-pop3-total-size nil)) (unless elmo-inhibit-display-retrieval-progress (elmo-display-progress diff --git a/elmo/elmo-shimbun.el b/elmo/elmo-shimbun.el index 06eab4b..c11e5e6 100644 --- a/elmo/elmo-shimbun.el +++ b/elmo/elmo-shimbun.el @@ -431,7 +431,8 @@ update overview when message is fetched." (when (setq shimbun-id (elmo-shimbun-header-extra-field header "x-shimbun-id")) (goto-char (point-min)) - (insert (format "X-Shimbun-Id: %s\n" shimbun-id)))) + (insert (format "X-Shimbun-Id: %s\n" shimbun-id))) + t) (error "Unplugged"))) (luna-define-method elmo-message-encache :around ((folder diff --git a/elmo/elmo-util.el b/elmo/elmo-util.el index b6dc41d..be810a9 100644 --- a/elmo/elmo-util.el +++ b/elmo/elmo-util.el @@ -1610,6 +1610,24 @@ Return t if cache is saved successfully." ;; ignore error (error))) +(defun elmo-file-cache-load (cache-path section) + "Load cache on PATH into the current buffer. +Return t if cache is loaded successfully." + (condition-case nil + (let (cache-file) + (when (and cache-path + (if (elmo-cache-path-section-p cache-path) + section + (null section)) + (setq cache-file (elmo-file-cache-expand-path + cache-path + section)) + (file-exists-p cache-file)) + (insert-file-contents-as-binary cache-file) + t)) + ;; igore error + (error))) + (defun elmo-cache-path-section-p (path) "Return non-nil when PATH is `section' cache path." (file-directory-p path)) diff --git a/elmo/elmo.el b/elmo/elmo.el index ceb29d8..3edc6ad 100644 --- a/elmo/elmo.el +++ b/elmo/elmo.el @@ -889,29 +889,35 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).") (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 @@ -1158,8 +1164,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) @@ -1169,24 +1174,26 @@ 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)) + err) + (or (and (eq (elmo-fetch-strategy-use-cache strategy) t) + (elmo-file-cache-load cache-path section)) + (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) + (and (eq (elmo-fetch-strategy-use-cache strategy) 'maybe) + (elmo-file-cache-load cache-path section)) + (and err + (signal (car err) (cdr err)))))) (luna-define-method elmo-folder-clear ((folder elmo-folder) &optional keep-killed)