;;; Code:
;;
+(eval-when-compile (require 'cl))
(require 'wl-vars)
(require 'wl-highlight)
'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.
(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)
(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)
(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)
(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 ()
(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)
(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
; (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))
(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))
;; 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
- (wl-message-display-all-header-p display-type))
- (prog1
- (if (wl-message-mime-analysis-p display-type)
- (elmo-mime-message-display folder number
- (current-buffer)
- (wl-message-get-original-buffer)
- 'wl-original-message-mode
- force-reload
- unread
- (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)))
- (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)))))
- (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)
&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
&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
(display-type (wl-message-make-display-type
wl-summary-buffer-display-mime-mode
wl-summary-buffer-display-header-mode))
- result time1 time2 sec micro)
+ 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))
(when wl-message-buffer-prefetch-debug
(setq time1 (current-time))
(message "Prefetching %d..." number))
- (setq result (wl-message-buffer-display
- folder number display-type 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