X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-message.el;h=c094061ffbfe19fa32255155b2989464ca95d9e8;hb=c20fb61cd99f50dd4eb03aa29a40b44c802efe17;hp=ad257ceb1cf85df298c977cc74541a13c4f4d7b6;hpb=6f1993df390517e34ddbeb5fa894e047a672e457;p=elisp%2Fwanderlust.git diff --git a/wl/wl-message.el b/wl/wl-message.el index ad257ce..c094061 100644 --- a/wl/wl-message.el +++ b/wl/wl-message.el @@ -33,6 +33,7 @@ (require 'wl-highlight) (require 'elmo) (require 'elmo-mime) +(require 'timer) (eval-when-compile (require 'wl-mime) @@ -40,7 +41,10 @@ (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) @@ -57,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) @@ -64,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) @@ -105,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 () @@ -127,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) @@ -168,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. @@ -263,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 @@ -299,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)) @@ -360,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 @@ -399,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)) @@ -429,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. @@ -478,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. @@ -503,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) @@ -528,93 +536,171 @@ 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)))) - -(defun wl-message-buffer-prefetch-next (folder number count &optional - summary charset) - (if (wl-message-buffer-prefetch-p folder) - (with-current-buffer (or summary (get-buffer wl-summary-buffer-name)) - (let* ((next (funcall wl-message-buffer-prefetch-get-next-function - number))) - (when (and next (wl-message-buffer-prefetch-p folder next)) - (if (not (fboundp 'run-with-idle-timer)) - (when (sit-for wl-message-buffer-prefetch-idle-time) - (wl-message-buffer-prefetch - folder next count summary charset)) - (setq wl-message-buffer-prefetch-timer nil) - (unless wl-message-buffer-prefetch-timer - (setq wl-message-buffer-prefetch-timer - (run-with-idle-timer - wl-message-buffer-prefetch-idle-time - nil - 'wl-message-buffer-prefetch - folder next count summary charset))))))))) - -(defun wl-message-buffer-prefetch (folder number count summary charset) - (setq wl-message-buffer-prefetch-timer nil) - (if (and (numberp count) - (>= (setq count (- count 1)) 0)) - (if (buffer-live-p summary) - (save-excursion - (set-buffer summary) - (if (string= (elmo-folder-name-internal folder) - (wl-summary-buffer-folder-name)) - (let* ((message-id (elmo-message-field folder number 'message-id)) - (wl-mime-charset charset) - (default-mime-charset charset) - (key (list (elmo-folder-name-internal folder) - number message-id)) - (hit (wl-message-buffer-cache-hit key)) - result time1 time2 sec micro) - (if (and hit (buffer-live-p hit)) - (wl-message-buffer-cache-sort - (wl-message-buffer-cache-entry-make key hit)) - (let* ((size (elmo-message-field folder number 'size))) - (when (or (elmo-message-file-p folder number) - (not - (and (integerp size) - elmo-message-fetch-threshold - (>= size - elmo-message-fetch-threshold)))) - ;;(not (elmo-file-cache-exists-p message-id))))) - (when wl-message-buffer-prefetch-debug - (setq time1 (current-time)) - (message "Prefetching %d..." number)) - (setq result (wl-message-buffer-display folder number - 'mime nil 'unread)) - (when wl-message-buffer-prefetch-debug - (setq time2 (current-time)) - (setq sec (- (nth 1 time2)(nth 1 time1))) - (setq micro (- (nth 2 time2)(nth 2 time1))) - (setq micro (+ micro (* 1000000 sec))) - (message "Prefetching %d...done(%f msec)." - number - (/ micro 1000.0)))))) - (wl-message-buffer-prefetch-next - folder number count summary charset))))) - (when wl-message-buffer-prefetch-debug - (message "Buffer Cached Messages %S" - (mapcar '(lambda (cache) - (nth 1 (car cache))) - wl-message-buffer-cache))))) + (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). +;;; (cancel-function-timers 'wl-message-buffer-prefetch-subr) + (if (fboundp 'run-with-idle-timer) + (if (featurep 'xemacs) + (let ((p itimer-list)) + (while (car p) + (if (eq 'wl-message-buffer-prefetch-subr + (itimer-function (car p))) + (delete-itimer (car p))) + (setq p (cdr p)))) + ;; FSF Emacs is correct + (cancel-function-timers 'wl-message-buffer-prefetch-subr)))) + +(defsubst wl-message-buffer-prefetch-set-timer (folder number count + summary charset) + (if (not (fboundp 'run-with-idle-timer)) + (when (sit-for wl-message-buffer-prefetch-idle-time) + (wl-message-buffer-prefetch-subr + folder number count summary charset)) + (run-with-idle-timer + wl-message-buffer-prefetch-idle-time + nil + '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 ((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) + (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) + (with-current-buffer summary + (if (and number + (numberp count) + (>= (setq count (- count 1)) 0) + (string= (elmo-folder-name-internal folder) + (wl-summary-buffer-folder-name))) + (let* ((wl-mime-charset charset) + (default-mime-charset charset) + (message-id (elmo-message-field folder number 'message-id)) + (key (list (elmo-folder-name-internal folder) + number message-id)) + (hit (wl-message-buffer-cache-hit key)) + result time1 time2 sec micro) + (when wl-message-buffer-prefetch-debug + (message "%d: count %d, hit %s" number count (buffer-name hit))) + (if (and hit (buffer-live-p hit)) + (progn + (wl-message-buffer-cache-sort + (wl-message-buffer-cache-entry-make key hit)) + (wl-message-buffer-prefetch-subr + folder + (wl-message-buffer-prefetch-get-next + folder number summary) + count summary charset)) + ;; prefetching + (when wl-message-buffer-prefetch-debug + (setq time1 (current-time)) + (message "Prefetching %d..." number)) + (setq result (wl-message-buffer-display + folder number 'mime nil 'unread)) + (when wl-message-buffer-prefetch-debug + (setq time2 (current-time)) + (setq sec (- (nth 1 time2)(nth 1 time1))) + (setq micro (- (nth 2 time2)(nth 2 time1))) + (setq micro (+ micro (* 1000000 sec))) + (message "Prefetching %d...done(%f msec)." + number + (/ micro 1000.0)) + (sit-for 0)) + ;; set next prefetch + (wl-message-buffer-prefetch-set-timer + folder + (wl-message-buffer-prefetch-get-next + folder number summary) + count summary charset) + (sit-for 0) + ;; success prefetch + ))) + ;; finish prefetch + (when wl-message-buffer-prefetch-debug + (message "Buffer Cached Messages: %s" + (mapconcat + '(lambda (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))