X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-message.el;h=81338cbe15fb5db988b6ecf7fda7d40df4dfe630;hb=ec4e50677163a03593169c0d1a1c5ea833ff52df;hp=ba764cf6af2348bd2269d68f38d6f3ce98593c47;hpb=fb4f133e468f265f592ce1dcb8190f98960314ec;p=elisp%2Fwanderlust.git diff --git a/wl/wl-message.el b/wl/wl-message.el index ba764cf..81338cb 100644 --- a/wl/wl-message.el +++ b/wl/wl-message.el @@ -28,6 +28,7 @@ ;;; Code: ;; +(eval-when-compile (require 'cl)) (require 'wl-vars) (require 'wl-highlight) @@ -50,7 +51,6 @@ 'wl-summary-default-get-next-msg) (defvar wl-message-buffer-prefetch-debug nil) -(defvar wl-message-buffer-prefetch-timer nil) (defvar wl-message-buffer nil) ; message buffer. @@ -62,6 +62,7 @@ (defvar wl-message-buffer-original-buffer nil) ; original buffer. (defvar wl-message-buffer-mode-line-formatter nil) (defvar wl-message-buffer-flag-indicator nil) +(defvar wl-message-buffer-mime-entity nil) (make-variable-buffer-local 'wl-message-buffer-cur-folder) (make-variable-buffer-local 'wl-message-buffer-cur-number) @@ -71,6 +72,7 @@ (make-variable-buffer-local 'wl-message-buffer-original-buffer) (make-variable-buffer-local 'wl-message-buffer-mode-line-formatter) (make-variable-buffer-local 'wl-message-buffer-flag-indicator) +(make-variable-buffer-local 'wl-message-buffer-mime-entity) (defvar wl-fixed-window-configuration nil) @@ -342,6 +344,9 @@ Returns non-nil if bottom of message." (interactive) (let (summary-buf summary-win mother-buffer) (cond ((setq summary-buf wl-message-buffer-cur-summary-buffer) + (unless (buffer-live-p summary-buf) + (error "Summary buffer not found: %s" + wl-message-buffer-cur-folder)) (if (setq summary-win (get-buffer-window summary-buf)) (select-window summary-win) (switch-to-buffer summary-buf) @@ -349,7 +354,8 @@ Returns non-nil if bottom of message." (select-window (get-buffer-window summary-buf)))) ((setq mother-buffer mime-mother-buffer) (kill-buffer (current-buffer)) - (switch-to-buffer mother-buffer))) + (when (buffer-live-p mother-buffer) + (switch-to-buffer mother-buffer)))) (run-hooks 'wl-message-exit-hook))) (defun wl-message-toggle-disp-summary () @@ -418,18 +424,72 @@ Returns non-nil if bottom of message." (nth 3 entry) (match-string (nth 4 entry)))) (goto-char end))))))) +;; display-type object definition. +(defun wl-message-make-display-type (mime header) + (let (symbol) + (prog1 + (setq symbol (intern (format "%s-%s-header" mime header))) + (put symbol + 'wl-message-display-type + (list :mime mime :header header))))) + +(defun wl-message-display-type-property (display-type prop) + (plist-get (get display-type 'wl-message-display-type) prop)) + +(defun wl-message-mime-analysis-p (display-type &optional header-or-body) + (let ((mode (wl-message-display-type-property display-type :mime))) + (case header-or-body + (header + (memq mode '(mime header-only))) + (t + (eq mode 'mime))))) + +(defun wl-message-display-all-header-p (display-type) + (eq (wl-message-display-type-property display-type :header) 'all)) + +(defun wl-message-display-no-merge-p (display-type) + (eq (wl-message-display-type-property display-type :mime) 'no-merge)) + +(defun wl-message-buffer-display-type (&optional message-buffer) + (if message-buffer + (with-current-buffer message-buffer + wl-message-buffer-cur-display-type) + wl-message-buffer-cur-display-type)) + +(defun wl-message-flag-indicator (flags) + (let ((flags (elmo-get-global-flags flags))) + (if (null flags) + "" + (concat + " (" + (mapconcat + (lambda (flag) + (let ((indicator (capitalize (symbol-name flag))) + face) + (when (and (assq flag wl-summary-flag-alist) + (facep + (setq face (intern + (format "wl-highlight-summary-%s-flag-face" + flag))))) + (put-text-property 0 (length indicator) 'face face indicator)) + indicator)) + (sort flags + (lambda (l r) + (> (length (memq (assq l wl-summary-flag-alist) + wl-summary-flag-alist)) + (length (memq (assq r wl-summary-flag-alist) + wl-summary-flag-alist))))) + ", ") + ")")))) + (defun wl-message-redisplay (folder number display-type &optional force-reload) (let* ((default-mime-charset wl-mime-charset) (buffer-read-only nil) (summary-buf (current-buffer)) - message-buf - strategy entity - cache-used - summary-win delim flags) + message-buf entity summary-win flags) (setq buffer-read-only nil) - (setq cache-used (wl-message-buffer-display - folder number display-type force-reload)) - (setq wl-message-buffer (car cache-used)) + (setq wl-message-buffer (wl-message-buffer-display + folder number display-type force-reload)) (setq message-buf wl-message-buffer) (wl-message-select-buffer wl-message-buffer) @@ -443,32 +503,7 @@ Returns non-nil if bottom of message." (setq wl-message-buffer-cur-folder (elmo-folder-name-internal folder)) (setq wl-message-buffer-cur-number number) (setq wl-message-buffer-flag-indicator - (if (setq flags (elmo-get-global-flags (elmo-message-flags - folder number))) - (let ((fl wl-summary-flag-alist) - flag-strings flag-string face) - (while fl - (when (memq (car (car fl)) flags) - (setq flag-string (capitalize - (symbol-name (car (car fl)))) - flags (delq (car (car fl)) flags)) - (when (facep (setq face - (intern - (format - "wl-highlight-summary-%s-flag-face" - (car (car fl)))))) - (put-text-property 0 (length flag-string) - 'face face flag-string)) - (setq flag-strings (nconc flag-strings - (list flag-string)))) - (setq fl (cdr fl))) - (setq flag-strings - (nconc flag-strings - (mapcar (lambda (flag) - (capitalize (symbol-name flag))) - flags))) - (concat " (" (mapconcat 'identity flag-strings ", ") ")")) - "")) + (wl-message-flag-indicator (elmo-message-flags folder number))) (wl-line-formatter-setup wl-message-buffer-mode-line-formatter wl-message-mode-line-format @@ -479,12 +514,12 @@ Returns non-nil if bottom of message." ; (when wl-highlight-body-too ; (wl-highlight-body)) (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))) - (when wl-message-use-header-narrowing + (when (and wl-message-use-header-narrowing + (not (wl-message-display-all-header-p display-type))) (wl-message-header-narrowing)) (goto-char (point-min)) (ignore-errors (run-hooks 'wl-message-redisplay-hook)) @@ -494,18 +529,17 @@ Returns non-nil if bottom of message." (set-buffer summary-buf) (setq summary-win (get-buffer-window summary-buf)) (if (window-live-p summary-win) - (select-window summary-win)) - cache-used)) + (select-window summary-win)))) ;; Use message buffer cache. (defun wl-message-buffer-display (folder number display-type &optional force-reload unread) - (let* ((msg-id (ignore-errors (elmo-message-field folder number - 'message-id))) + (let* ((msg-id (ignore-errors + (elmo-message-field folder number 'message-id))) (fname (elmo-folder-name-internal folder)) (hit (wl-message-buffer-cache-hit (list fname number msg-id))) - (read nil) - cache-used) + (redisplay nil) + entity) (when (and hit (not (buffer-live-p hit))) (wl-message-buffer-cache-delete (list fname number msg-id)) (setq hit nil)) @@ -514,63 +548,77 @@ Returns non-nil if bottom of message." ;; move hit to the top. (wl-message-buffer-cache-sort (wl-message-buffer-cache-entry-make (list fname number msg-id) hit)) - ;; 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)) + (setq entity wl-message-buffer-mime-entity) (unless (eq wl-message-buffer-cur-display-type display-type) - (setq read t)))) + (setq redisplay t)))) ;; delete tail and add new to the top. (setq hit (wl-message-buffer-cache-add (list fname number msg-id))) - (setq read t)) - (if (or force-reload read) - (condition-case err - (save-excursion - (set-buffer hit) - (setq - cache-used - (wl-message-display-internal folder number display-type - force-reload unread)) - (setq wl-message-buffer-cur-display-type display-type)) - (quit - (wl-message-buffer-cache-delete) - (error "Display message %s/%s is quitted" fname number)) - (error - (wl-message-buffer-cache-delete) - (signal (car err) (cdr err)) - nil))) ;; will not be used - (cons hit cache-used))) - -(defun wl-message-display-internal (folder number display-type - &optional force-reload unread) + (setq redisplay t)) + (when (or force-reload redisplay) + (condition-case err + (with-current-buffer hit + (when (or force-reload + (null entity) + (not (elmo-mime-entity-display-p + entity + (if (wl-message-mime-analysis-p display-type) + 'mime + 'as-is))) + (if (wl-message-display-no-merge-p display-type) + (elmo-mime-entity-reassembled-p entity) + (elmo-mime-entity-fragment-p entity))) + (setq entity (elmo-message-mime-entity + folder + number + (wl-message-get-original-buffer) + (and wl-message-auto-reassemble-message/partial + (not (wl-message-display-no-merge-p + display-type))) + force-reload + unread + (not (wl-message-mime-analysis-p display-type))))) + (unless entity + (error "Cannot display message %s/%s" fname number)) + (wl-message-display-internal entity display-type)) + (quit + (wl-message-buffer-cache-delete) + (error "Display message %s/%s is quitted" fname number)) + (error + (wl-message-buffer-cache-delete) + (signal (car err) (cdr err)) + nil))) ;; will not be used + hit)) + +(defun wl-message-display-internal (entity display-type) (let ((default-mime-charset wl-mime-charset) - (elmo-mime-charset wl-mime-charset)) - (setq wl-message-buffer-require-all-header (eq display-type - 'all-header)) - (prog1 - (if (eq display-type 'as-is) - (let (wl-highlight-x-face-function) - (prog1 (elmo-mime-display-as-is folder number - (current-buffer) - (wl-message-get-original-buffer) - 'wl-original-message-mode - force-reload - unread - (wl-message-define-keymap)) - (let (buffer-read-only) - (wl-highlight-message (point-min) (point-max) t)))) - (elmo-mime-message-display folder number - (current-buffer) - (wl-message-get-original-buffer) - 'wl-original-message-mode - force-reload - unread - (wl-message-define-keymap))) - (run-hooks 'wl-message-display-internal-hook) - (setq buffer-read-only t)))) + (elmo-mime-charset wl-mime-charset) + (wl-message-buffer-require-all-header + (wl-message-display-all-header-p display-type))) + (if (wl-message-mime-analysis-p display-type) + (elmo-mime-entity-display entity + (current-buffer) + 'wl-original-message-mode + (wl-message-define-keymap)) + (let* ((elmo-mime-display-header-analysis + (wl-message-mime-analysis-p display-type 'header)) + (wl-highlight-x-face-function + (and elmo-mime-display-header-analysis + wl-highlight-x-face-function))) + (elmo-mime-entity-display-as-is entity + (current-buffer) + 'wl-original-message-mode + (wl-message-define-keymap)) + (let (buffer-read-only) + (wl-highlight-message (point-min) (point-max) t)))) + (setq wl-message-buffer-cur-display-type display-type + wl-message-buffer-mime-entity entity) + (run-hooks 'wl-message-display-internal-hook) + (setq buffer-read-only t))) (defun wl-message-buffer-prefetch-p (folder &optional number) (and (or (not number) @@ -648,7 +696,7 @@ Returns non-nil if bottom of message." &optional summary charset) (let* ((summary (or summary (get-buffer wl-summary-buffer-name))) (num number)) - (when (and count + (when (and (> count 0) (wl-message-buffer-prefetch-p folder)) (unless (wl-message-buffer-prefetch-p folder number) (setq num @@ -662,7 +710,7 @@ Returns non-nil if bottom of message." &optional summary charset) (let* ((summary (or summary (get-buffer wl-summary-buffer-name))) next) - (when (and count + (when (and (> count 0) (wl-message-buffer-prefetch-p folder)) (setq next (wl-message-buffer-prefetch-get-next folder number summary)) (when next @@ -684,7 +732,10 @@ Returns non-nil if bottom of message." (key (list (elmo-folder-name-internal folder) number message-id)) (hit (wl-message-buffer-cache-hit key)) - result time1 time2 sec micro) + (display-type (wl-message-make-display-type + wl-summary-buffer-display-mime-mode + wl-summary-buffer-display-header-mode)) + 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)) @@ -700,8 +751,10 @@ Returns non-nil if bottom of message." (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)) + (wl-message-buffer-display folder number + display-type nil 'unread) + (when (elmo-message-use-cache-p folder number) + (elmo-message-set-cached folder number t)) (when wl-message-buffer-prefetch-debug (setq time2 (current-time)) (setq sec (- (nth 1 time2)(nth 1 time1)))