2001-12-23 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+ * 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 <teranisi@gohome.org>
(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
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
(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)
(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
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))
(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)
(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
(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)
(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
(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
;; 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))
(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
(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)
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)
projects / elisp / wanderlust.git / commitdiff