X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-message.el;h=2355dc585e6f69fcf4ce2cb9233f08a6371289d7;hb=b2e555277b2bdb26aab81311036b32a2177a272b;hp=1ed057e06c3b565eebdd5711becd44f9f4d5210d;hpb=4c0926c573fd336d678d1795bd3ef84792e076da;p=elisp%2Fwanderlust.git diff --git a/wl/wl-message.el b/wl/wl-message.el index 1ed057e..2355dc5 100644 --- a/wl/wl-message.el +++ b/wl/wl-message.el @@ -1,4 +1,4 @@ -;;; wl-message.el -- Message displaying modules for Wanderlust. +;;; wl-message.el --- Message displaying modules for Wanderlust. ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi @@ -24,15 +24,16 @@ ;; ;;; Commentary: -;; +;; ;;; Code: -;; +;; (require 'wl-vars) (require 'wl-highlight) (require 'elmo) (require 'elmo-mime) +(require 'timer) (eval-when-compile (require 'wl-mime) @@ -40,16 +41,16 @@ (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)) -(defconst wl-message-buffer-prefetch-idle-time - (if (featurep 'lisp-float-type) (/ (float 1) (float 5)) 1)) (defvar wl-message-buffer-prefetch-get-next-function 'wl-summary-default-get-next-msg) -(defvar wl-message-buffer-prefetch-folder-type-list t) - (defvar wl-message-buffer-prefetch-debug nil) +(defvar wl-message-buffer-prefetch-timer nil) (defvar wl-message-buffer nil) ; message buffer. @@ -60,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) @@ -67,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) @@ -108,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 () @@ -130,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) @@ -171,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. @@ -205,9 +208,9 @@ Return its cache buffer." (if window (select-window window) (when wl-fixed-window-configuration - (delete-other-windows) - (and wl-stay-folder-window - (wl-summary-toggle-disp-folder))) + (delete-other-windows) + (and wl-stay-folder-window + (wl-summary-toggle-disp-folder))) ;; There's no buffer window. Search for message window and snatch it. (if (setq window (wl-message-buffer-window)) (select-window window) @@ -230,7 +233,7 @@ If ARG is specified, narrow to ARGth page." (setq arg (if arg (prefix-numeric-value arg) 0)) (save-excursion (condition-case () - (forward-page -1) ; Beginning of current page. + (forward-page -1) ; Beginning of current page. (beginning-of-buffer (goto-char (point-min)))) (forward-char 1) ; for compatibility with emacs-19.28 and emacs-19.29 @@ -266,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 @@ -302,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)) @@ -323,7 +326,7 @@ Returns non-nil if bottom of message." (let ((mail-reply-buffer buffer)) (wl-draft-yank-from-mail-reply-buffer nil))) -;; +;; (defun wl-message-mode () "A major mode for message displaying." @@ -356,14 +359,16 @@ Returns non-nil if bottom of message." (wl-message-select-buffer wl-message-buffer)) (wl-summary-goto-folder-subr wl-message-buffer-cur-folder 'no-sync nil nil t) - ; no summary-buf + ; no summary-buf (let ((sum-buf (current-buffer))) (wl-message-select-buffer wl-message-buffer) (setq wl-message-buffer-cur-summary-buffer sum-buf))))) (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 @@ -376,14 +381,14 @@ Returns non-nil if bottom of message." (setq entry (car alist) alist (cdr alist)) (goto-char (point-min)) - (while (re-search-forward (car entry) nil t) + (while (re-search-forward (car entry) (+ (point) (nth 4 entry)) t) (unless (get-text-property (point) 'keymap) (wl-message-add-button (match-beginning (nth 1 entry)) (match-end (nth 1 entry)) (nth 2 entry) (match-string (nth 3 entry)))))))))) - + (defun wl-message-add-buttons-to-header (start end) (save-excursion (save-restriction @@ -402,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)) @@ -416,7 +420,7 @@ Returns non-nil if bottom of message." message-buf strategy entity cache-used - header-end real-fld-num summary-win delim) + summary-win delim) (setq buffer-read-only nil) (setq cache-used (wl-message-buffer-display folder number flag force-reload)) @@ -425,39 +429,37 @@ Returns non-nil if bottom of message." (wl-message-select-buffer wl-message-buffer) (set-buffer message-buf) + (make-local-variable 'truncate-partial-width-windows) + (setq truncate-partial-width-windows nil) (setq truncate-lines wl-message-truncate-lines) (setq buffer-read-only nil) (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,9 +510,10 @@ Returns non-nil if bottom of message." (defun wl-message-display-internal (folder number flag &optional force-reload unread) - (let ((elmo-message-fetch-threshold wl-fetch-confirm-threshold)) + (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 + (prog1 (if (eq flag 'as-is) (let (wl-highlight-x-face-function) (prog1 (elmo-mime-display-as-is folder number @@ -529,79 +536,171 @@ Returns non-nil if bottom of message." (setq buffer-read-only t)))) (defsubst wl-message-buffer-prefetch-p (folder &optional number) - (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)))))) - ((consp wl-message-buffer-prefetch-folder-type-list) - (wl-string-match-member (elmo-folder-name-internal folder) - wl-message-buffer-prefetch-folder-type-list)) - (t wl-message-buffer-prefetch-folder-type-list))) - -(defvar wl-message-buffer-prefetch-timer nil) - -(defun wl-message-buffer-prefetch-next (folder number &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 summary charset)) - (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 summary charset))))))))) - -(defun wl-message-buffer-prefetch (folder number summary charset) - (when (buffer-live-p summary) - (save-excursion - (set-buffer summary) - (when (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) - result time1 time2 sec micro) - (if (not (wl-message-buffer-cache-hit (list folder - number message-id))) - (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)))))))))) - (setq wl-message-buffer-prefetch-timer nil)) + (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))