X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-message.el;h=c094061ffbfe19fa32255155b2989464ca95d9e8;hb=c20fb61cd99f50dd4eb03aa29a40b44c802efe17;hp=f2720a12811a1079be3f42c66768779228a29431;hpb=765d031be8f5cee20325d198e08fed00ead8efbc;p=elisp%2Fwanderlust.git diff --git a/wl/wl-message.el b/wl/wl-message.el index f2720a1..c094061 100644 --- a/wl/wl-message.el +++ b/wl/wl-message.el @@ -41,12 +41,15 @@ (defalias-maybe 'event-window 'ignore) (defalias-maybe 'posn-window 'ignore) (defalias-maybe 'event-start 'ignore) - (defalias-maybe 'mime-open-entity 'ignore)) + (defalias-maybe 'mime-open-entity 'ignore) + (defalias-maybe 'itimer-function 'ignore) + (defalias-maybe 'delete-itimer 'ignore) + (defvar-maybe itimer-list)) (defvar wl-message-buffer-prefetch-get-next-function 'wl-summary-default-get-next-msg) -(defvar wl-message-buffer-prefetch-debug t) +(defvar wl-message-buffer-prefetch-debug nil) (defvar wl-message-buffer-prefetch-timer nil) (defvar wl-message-buffer nil) ; message buffer. @@ -58,6 +61,7 @@ (defvar wl-message-buffer-cur-summary-buffer nil) (defvar wl-message-buffer-original-buffer nil) ; original buffer. (defvar wl-message-buffer-all-header-flag nil) +(defvar wl-message-buffer-mode-line-formatter nil) (make-variable-buffer-local 'wl-message-buffer-cur-folder) (make-variable-buffer-local 'wl-message-buffer-cur-number) @@ -65,6 +69,7 @@ (make-variable-buffer-local 'wl-message-buffer-cur-summary-buffer) (make-variable-buffer-local 'wl-message-buffer-original-buffer) (make-variable-buffer-local 'wl-message-buffer-all-header-flag) +(make-variable-buffer-local 'wl-message-buffer-mode-line-formatter) (defvar wl-fixed-window-configuration nil) @@ -106,7 +111,6 @@ With association ((\"folder\" message \"message-id\") . cache-buffer).") ; (setcdr pointer (list entry)) ; (setq wl-message-buffer-cache (cdr top)))) -(defconst wl-message-buffer-cache-name " *WL:Message*") (defconst wl-original-message-buffer-name " *Original*") (defun wl-original-message-mode () @@ -128,11 +132,12 @@ If original message buffer already exists, it is re-used." (defun wl-message-buffer-create () "Create a new message buffer." - (let* ((buffer (generate-new-buffer wl-message-buffer-cache-name)) + (let* ((buffer (generate-new-buffer wl-message-buffer-name)) (name (buffer-name buffer))) (with-current-buffer buffer (setq wl-message-buffer-original-buffer - (wl-original-message-buffer-get name))) + (wl-original-message-buffer-get name)) + (run-hooks 'wl-message-buffer-created-hook)) buffer)) (defun wl-message-buffer-cache-add (key) @@ -169,7 +174,7 @@ Return its cache buffer." wl-message-buffer (get-buffer-window wl-message-buffer)) (delete-window (get-buffer-window wl-message-buffer))) - (wl-kill-buffers (regexp-quote wl-message-buffer-cache-name)) + (wl-kill-buffers (regexp-quote wl-message-buffer-name)) (setq wl-message-buffer-cache nil)) ;;; Message buffer handling from summary buffer. @@ -264,7 +269,7 @@ Returns non-nil if top of message." (recenter)) (if (not (bobp)) (condition-case nil - (scroll-down lines) + (scroll-down (or lines wl-message-scroll-amount)) (error)) (setq top t))) (if real-top @@ -300,8 +305,8 @@ Returns non-nil if bottom of message." (static-if (boundp 'window-pixel-scroll-increment) ;; XEmacs 21.2.20 and later. (let (window-pixel-scroll-increment) - (scroll-up lines)) - (scroll-up lines)) + (scroll-up (or lines wl-message-scroll-amount))) + (scroll-up (or lines wl-message-scroll-amount))) (end-of-buffer (goto-char (point-max)))) (setq bottom nil)) @@ -361,7 +366,9 @@ Returns non-nil if bottom of message." (defun wl-message-get-original-buffer () "Get original buffer for current message buffer." - wl-message-buffer-original-buffer) + (if (buffer-live-p wl-message-buffer-original-buffer) + wl-message-buffer-original-buffer + (wl-original-message-buffer-get (buffer-name (current-buffer))))) (defun wl-message-add-buttons-to-body (start end) (save-excursion @@ -400,7 +407,6 @@ Returns non-nil if bottom of message." (point-max))) (goto-char start) (while (re-search-forward (nth 1 entry) end t) - (goto-char (match-end 0)) (wl-message-add-button (match-beginning (nth 2 entry)) (match-end (nth 2 entry)) @@ -430,34 +436,30 @@ Returns non-nil if bottom of message." (setq wl-message-buffer-cur-summary-buffer summary-buf) (setq wl-message-buffer-cur-folder (elmo-folder-name-internal folder)) (setq wl-message-buffer-cur-number number) + (wl-line-formatter-setup + wl-message-buffer-mode-line-formatter + wl-message-mode-line-format + wl-message-mode-line-format-spec-alist) (setq mode-line-buffer-identification - (format "Wanderlust: << %s / %s >>" - (if (memq 'modeline wl-use-folder-petname) - (wl-folder-get-petname (elmo-folder-name-internal - folder)) - (elmo-folder-name-internal folder)) number)) + (funcall wl-message-buffer-mode-line-formatter)) ;; highlight body ; (when wl-highlight-body-too ; (wl-highlight-body)) - (condition-case () - (wl-message-narrow-to-page) - (error nil)); ignore errors. + (ignore-errors (wl-message-narrow-to-page)) (setq cache-used (cdr cache-used)) (goto-char (point-min)) (when (re-search-forward "^$" nil t) (wl-message-add-buttons-to-header (point-min) (point)) (wl-message-add-buttons-to-body (point) (point-max))) (goto-char (point-min)) - (unwind-protect - (save-excursion - (run-hooks 'wl-message-redisplay-hook)) - ;; go back to summary mode - (set-buffer-modified-p nil) - (setq buffer-read-only t) - (set-buffer summary-buf) - (setq summary-win (get-buffer-window summary-buf)) - (if (window-live-p summary-win) - (select-window summary-win))) + (ignore-errors (run-hooks 'wl-message-redisplay-hook)) + ;; go back to summary mode + (set-buffer-modified-p nil) + (setq buffer-read-only t) + (set-buffer summary-buf) + (setq summary-win (get-buffer-window summary-buf)) + (if (window-live-p summary-win) + (select-window summary-win)) cache-used)) ;; Use message buffer cache. @@ -479,6 +481,10 @@ Returns non-nil if bottom of message." ;; buffer cache is used. (setq cache-used t) (with-current-buffer hit + ;; Rewind to the top page + (widen) + (goto-char (point-min)) + (ignore-errors (wl-message-narrow-to-page)) (unless (eq wl-message-buffer-cur-flag flag) (setq read t)))) ;; delete tail and add new to the top. @@ -504,7 +510,8 @@ Returns non-nil if bottom of message." (defun wl-message-display-internal (folder number flag &optional force-reload unread) - (let ((default-mime-charset wl-mime-charset)) + (let ((default-mime-charset wl-mime-charset) + (elmo-mime-charset wl-mime-charset)) (setq wl-message-buffer-all-header-flag (eq flag 'all-header)) (prog1 (if (eq flag 'as-is) @@ -529,25 +536,35 @@ Returns non-nil if bottom of message." (setq buffer-read-only t)))) (defsubst wl-message-buffer-prefetch-p (folder &optional number) - (or (cond - ((eq wl-message-buffer-prefetch-folder-type-list t) - t) - ((and number wl-message-buffer-prefetch-folder-type-list) - (memq (elmo-folder-type-internal - (elmo-message-folder folder number)) - wl-message-buffer-prefetch-folder-type-list)) - (wl-message-buffer-prefetch-folder-type-list - (let ((list wl-message-buffer-prefetch-folder-type-list) - type) - (catch 'done - (while (setq type (pop list)) - (if (elmo-folder-contains-type folder type) - (throw 'done t))))))) - (cond - ((consp wl-message-buffer-prefetch-folder-list) - (wl-string-match-member (elmo-folder-name-internal folder) - wl-message-buffer-prefetch-folder-list)) - (t wl-message-buffer-prefetch-folder-list)))) + (and (or (not number) + (elmo-message-file-p folder number) + (let ((size (elmo-message-field folder number 'size))) + (not (and (integerp size) + wl-message-buffer-prefetch-threshold + (>= size wl-message-buffer-prefetch-threshold))))) + (or (not number) + (elmo-folder-plugged-p folder) + (elmo-file-cache-exists-p + (elmo-message-field folder number 'message-id))) + (or (cond + ((eq wl-message-buffer-prefetch-folder-type-list t) + t) + ((and number wl-message-buffer-prefetch-folder-type-list) + (memq (elmo-folder-type-internal + (elmo-message-folder folder number)) + wl-message-buffer-prefetch-folder-type-list)) + (wl-message-buffer-prefetch-folder-type-list + (let ((list wl-message-buffer-prefetch-folder-type-list) + type) + (catch 'done + (while (setq type (pop list)) + (if (elmo-folder-contains-type folder type) + (throw 'done t))))))) + (cond + ((consp wl-message-buffer-prefetch-folder-list) + (wl-string-match-member (elmo-folder-name-internal folder) + wl-message-buffer-prefetch-folder-list)) + (t wl-message-buffer-prefetch-folder-list))))) (defsubst wl-message-buffer-prefetch-clear-timer () ;;; cannot use for the bug of fsf-compat package (1.09). @@ -575,56 +592,50 @@ Returns non-nil if bottom of message." 'wl-message-buffer-prefetch-subr folder number count summary charset))) +(defvar wl-message-buffer-prefetch-move-spec-plugged-alist nil) +(defvar wl-message-buffer-prefetch-move-spec-unplugged-alist nil) + (defun wl-message-buffer-prefetch-get-next (folder number summary) (if (buffer-live-p summary) (with-current-buffer summary - (let* ((next (funcall wl-message-buffer-prefetch-get-next-function - number)) - (size (elmo-message-field folder next 'size)) - (threshold (or wl-cache-prefetch-threshold - elmo-message-fetch-threshold))) - (unless (and (integerp size) - (integerp threshold)) - (debug)) - (if next - (cond - ((not (wl-message-buffer-prefetch-p folder next)) - ;; for Multi folder - (wl-message-buffer-prefetch-get-next - folder next summary)) - ((and (not (elmo-message-file-p folder next)) - (integerp size) - (integerp threshold) - (>= size threshold)) - (wl-message-buffer-prefetch-get-next - folder next summary)) - (t - next))))))) - -(defun wl-message-buffer-prefetch (folder number &optional - count summary charset) - (let* ((summary (or summary (get-buffer wl-summary-buffer-name)))) - (when (wl-message-buffer-prefetch-p folder) - (wl-message-buffer-prefetch-clear-timer) - (wl-message-buffer-prefetch-set-timer - folder - number - (or count 1) - summary - charset)))) - -(defun wl-message-buffer-prefetch-next (folder number &optional - count summary charset) + (let ((wl-summary-move-spec-plugged-alist + (or wl-message-buffer-prefetch-move-spec-plugged-alist + wl-summary-move-spec-plugged-alist)) + (wl-summary-move-spec-unplugged-alist + (or wl-message-buffer-prefetch-move-spec-unplugged-alist + wl-summary-move-spec-unplugged-alist)) + (next number)) + (while (and (setq next (funcall + wl-message-buffer-prefetch-get-next-function + next)) + (not (wl-message-buffer-prefetch-p folder next)))) + next)))) + +(defun wl-message-buffer-prefetch (folder number count + &optional summary charset) + (let* ((summary (or summary (get-buffer wl-summary-buffer-name))) + (num number)) + (when (and count + (wl-message-buffer-prefetch-p folder)) + (unless (wl-message-buffer-prefetch-p folder number) + (setq num + (wl-message-buffer-prefetch-get-next folder number summary))) + (when num + (wl-message-buffer-prefetch-clear-timer) + (wl-message-buffer-prefetch-set-timer + folder num count summary charset))))) + +(defun wl-message-buffer-prefetch-next (folder number count + &optional summary charset) (let* ((summary (or summary (get-buffer wl-summary-buffer-name))) - (next (wl-message-buffer-prefetch-get-next folder number summary))) - (when (wl-message-buffer-prefetch-p folder) - (wl-message-buffer-prefetch-clear-timer) - (wl-message-buffer-prefetch-set-timer - folder - next - (or count 1) - summary - charset)))) + next) + (when (and count + (wl-message-buffer-prefetch-p folder)) + (setq next (wl-message-buffer-prefetch-get-next folder number summary)) + (when next + (wl-message-buffer-prefetch-clear-timer) + (wl-message-buffer-prefetch-set-timer + folder next count summary charset))))) (defun wl-message-buffer-prefetch-subr (folder number count summary charset) (if (buffer-live-p summary) @@ -681,12 +692,14 @@ Returns non-nil if bottom of message." (message "Buffer Cached Messages: %s" (mapconcat '(lambda (cache) - (if (string= - (nth 0 (car cache)) - (elmo-folder-name-internal folder)) - (format "%d" - (nth 1 (car cache))) - (format "*%d" (nth 1 (car cache))))) + (if (numberp (nth 1 (car cache))) + (if (string= + (nth 0 (car cache)) + (elmo-folder-name-internal folder)) + (format "%d" + (nth 1 (car cache))) + (format "*%d" (nth 1 (car cache)))) + "-")) wl-message-buffer-cache " "))) ))) (defvar wl-message-button-map (make-sparse-keymap))