X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-message.el;h=81338cbe15fb5db988b6ecf7fda7d40df4dfe630;hb=611bdeb2f343b37fae32a9c8cacadc9d35c793c4;hp=de5cc186d0d9ff97f759f1dbbf875a76f8b0930c;hpb=dc7cb1655956a8fce5d267cd130b3eceeb5d1bda;p=elisp%2Fwanderlust.git

diff --git a/wl/wl-message.el b/wl/wl-message.el
index de5cc18..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,24 +51,28 @@
   '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-cur-summary-buffer nil)
 (defvar wl-message-buffer-cur-folder nil)
 (defvar wl-message-buffer-cur-number nil)
-(defvar wl-message-buffer-cur-flag nil)
+(defvar wl-message-buffer-cur-display-type nil)
 (defvar wl-message-buffer-cur-summary-buffer nil)
+(defvar wl-message-buffer-require-all-header 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)
+(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-cur-flag)
+(make-variable-buffer-local 'wl-message-buffer-cur-display-type)
 (make-variable-buffer-local 'wl-message-buffer-cur-summary-buffer)
+(make-variable-buffer-local 'wl-message-buffer-require-all-header)
 (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)
+(make-variable-buffer-local 'wl-message-buffer-flag-indicator)
+(make-variable-buffer-local 'wl-message-buffer-mime-entity)
 
 (defvar wl-fixed-window-configuration nil)
 
@@ -109,14 +114,13 @@ 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 ()
   "A major mode for original message buffer."
   (setq major-mode 'wl-original-message-mode)
   (setq buffer-read-only t)
-  (elmo-set-buffer-multibyte nil)
+  (set-buffer-multibyte nil)
   (setq mode-name "Wanderlust original message"))
 
 (defun wl-original-message-buffer-get (name)
@@ -131,11 +135,14 @@ 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))
+      (when wl-message-use-header-narrowing
+	(wl-message-header-narrowing-setup))
+      (run-hooks 'wl-message-buffer-created-hook))
     buffer))
 
 (defun wl-message-buffer-cache-add (key)
@@ -145,9 +152,12 @@ Return its cache buffer."
 	(buf nil))
     (if (< len wl-message-buffer-cache-size)
 	(setq buf (wl-message-buffer-create))
-      (setq buf (wl-message-buffer-cache-buffer-get
-		 (nth (1- len) wl-message-buffer-cache)))
-      (setcdr (nthcdr (- len 2) wl-message-buffer-cache) nil))
+      (let ((entry (nth (1- len) wl-message-buffer-cache)))
+	(if (buffer-live-p
+	     (setq buf (wl-message-buffer-cache-buffer-get entry)))
+	    (setcdr (nthcdr (- len 2) wl-message-buffer-cache) nil)
+	  (setq wl-message-buffer-cache (delq entry wl-message-buffer-cache))
+	  (setq buf (wl-message-buffer-create)))))
     (setq wl-message-buffer-cache
 	  (cons (wl-message-buffer-cache-entry-make key buf)
 		wl-message-buffer-cache))
@@ -172,7 +182,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.
@@ -252,68 +262,64 @@ If ARG is specified, narrow to ARGth page."
   "Scroll down current message by LINES.
 Returns non-nil if top of message."
   (interactive)
-  (let (cur-buf top real-top)
-    (unless (eq major-mode 'mime-view-mode)
-      (when (buffer-live-p wl-message-buffer)
-	(setq cur-buf (current-buffer))
-	(wl-message-select-buffer wl-message-buffer)))
-    (move-to-window-line 0)
-    (if (and wl-break-pages
-	     (bobp)
-	     (not (setq real-top (save-restriction (widen) (bobp)))))
-	(progn
-	  (wl-message-narrow-to-page -1)
-	  (goto-char (point-max))
-	  (recenter))
-      (if (not (bobp))
-	  (condition-case nil
-	      (scroll-down lines)
-	    (error))
-	(setq top t)))
-    (if real-top
-	(let ((f (assq (mime-preview-original-major-mode)
-		       mime-preview-over-to-previous-method-alist)))
-	  (if f (funcall (cdr f))))
-      (when cur-buf
-	(select-window (get-buffer-window cur-buf))))
+  (let (top real-top)
+    (save-selected-window
+      (unless (eq major-mode 'mime-view-mode)
+	(when (buffer-live-p wl-message-buffer)
+	  (wl-message-select-buffer wl-message-buffer)))
+      (move-to-window-line 0)
+      (if (and wl-break-pages
+	       (bobp)
+	       (not (setq real-top (save-restriction (widen) (bobp)))))
+	  (progn
+	    (wl-message-narrow-to-page -1)
+	    (goto-char (point-max))
+	    (recenter))
+	(if (not (bobp))
+	    (condition-case nil
+		(scroll-down (or lines wl-message-scroll-amount))
+	      (error))
+	  (setq top t)))
+      (if real-top
+	  (let ((f (assq (mime-preview-original-major-mode)
+			 mime-preview-over-to-previous-method-alist)))
+	    (if f (funcall (cdr f))))))
     top))
 
 (defun wl-message-next-page (&optional lines)
   "Scroll up current message by LINES.
 Returns non-nil if bottom of message."
   (interactive)
-  (let (cur-buf bottom)
-    (unless (eq major-mode 'mime-view-mode)
-      (when (buffer-live-p wl-message-buffer)
-	(setq cur-buf (current-buffer))
-	(wl-message-select-buffer wl-message-buffer)))
-    (move-to-window-line -1)
-    (if (save-excursion
-	  (end-of-line)
-	  (and (pos-visible-in-window-p)
-	       (eobp)))
-	(if (or (null wl-break-pages)
-		(save-excursion
-		  (save-restriction
-		    (widen) (forward-line) (eobp))))
-	    (setq bottom t)
-	  (wl-message-narrow-to-page 1)
-	  (setq bottom nil))
-      (condition-case ()
-	  (static-if (boundp 'window-pixel-scroll-increment)
-	      ;; XEmacs 21.2.20 and later.
-	      (let (window-pixel-scroll-increment)
-		(scroll-up lines))
-	    (scroll-up lines))
-	(end-of-buffer
-	 (goto-char (point-max))))
-      (setq bottom nil))
-    (if (eobp)
-	(let ((f (assq (mime-preview-original-major-mode)
-		       mime-preview-over-to-next-method-alist)))
-	  (if f (funcall (cdr f))))
-      (when cur-buf
-	(select-window (get-buffer-window cur-buf))))
+  (let (bottom)
+    (save-selected-window
+      (unless (eq major-mode 'mime-view-mode)
+	(when (buffer-live-p wl-message-buffer)
+	  (wl-message-select-buffer wl-message-buffer)))
+      (move-to-window-line -1)
+      (if (save-excursion
+	    (end-of-line)
+	    (and (pos-visible-in-window-p)
+		 (eobp)))
+	  (if (or (null wl-break-pages)
+		  (save-excursion
+		    (save-restriction
+		      (widen) (forward-line) (eobp))))
+	      (setq bottom t)
+	    (wl-message-narrow-to-page 1)
+	    (setq bottom nil))
+	(condition-case ()
+	    (static-if (boundp 'window-pixel-scroll-increment)
+		;; XEmacs 21.2.20 and later.
+		(let (window-pixel-scroll-increment)
+		  (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))
+      (if (eobp)
+	  (let ((f (assq (mime-preview-original-major-mode)
+			 mime-preview-over-to-next-method-alist)))
+	    (if f (funcall (cdr f))))))
     bottom))
 
 
@@ -334,15 +340,22 @@ Returns non-nil if bottom of message."
   (setq mode-name "Message"))
 
 (defun wl-message-exit ()
-  "Move to summary buffer."
+  "Move to summary buffer or mother buffer."
   (interactive)
-  (let (summary-buf summary-win)
-    (if (setq summary-buf wl-message-buffer-cur-summary-buffer)
-	(if (setq summary-win (get-buffer-window summary-buf))
-	    (select-window summary-win)
-	  (switch-to-buffer summary-buf)
-	  (wl-message-select-buffer wl-message-buffer)
-	  (select-window (get-buffer-window summary-buf))))
+  (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)
+	     (wl-message-select-buffer wl-message-buffer)
+	     (select-window (get-buffer-window summary-buf))))
+	  ((setq mother-buffer mime-mother-buffer)
+	   (kill-buffer (current-buffer))
+	   (when (buffer-live-p mother-buffer)
+	     (switch-to-buffer mother-buffer))))
     (run-hooks 'wl-message-exit-hook)))
 
 (defun wl-message-toggle-disp-summary ()
@@ -364,7 +377,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
@@ -409,22 +424,77 @@ Returns non-nil if bottom of message."
 	       (nth 3 entry) (match-string (nth 4 entry))))
 	    (goto-char end)))))))
 
-(defun wl-message-redisplay (folder number flag &optional force-reload)
+;; 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
-	 header-end real-fld-num summary-win delim)
+	 message-buf entity summary-win flags)
     (setq buffer-read-only nil)
-    (setq cache-used (wl-message-buffer-display
-		      folder number flag 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)
 
     (set-buffer message-buf)
+    (wl-deactivate-region)
     (make-local-variable 'truncate-partial-width-windows)
     (setq truncate-partial-width-windows nil)
     (setq truncate-lines wl-message-truncate-lines)
@@ -432,44 +502,44 @@ 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)
+    (setq wl-message-buffer-flag-indicator
+	  (wl-message-flag-indicator (elmo-message-flags folder 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.
-    (setq cache-used (cdr cache-used))
+    (ignore-errors (wl-message-narrow-to-page))
     (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 (and wl-message-use-header-narrowing
+	       (not (wl-message-display-all-header-p display-type)))
+      (wl-message-header-narrowing))
     (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)))
-    cache-used))
+    (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))))
 
 ;; Use message buffer cache.
-(defun wl-message-buffer-display (folder number flag
+(defun wl-message-buffer-display (folder number display-type
 					 &optional force-reload unread)
-  (let* ((msg-id (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))
@@ -478,59 +548,79 @@ 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
-	    (unless (eq wl-message-buffer-cur-flag flag)
-	      (setq read t))))
+	    ;; 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 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 flag
-					    force-reload unread))
-	      (setq wl-message-buffer-cur-flag flag))
-	  (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 flag
-					   &optional force-reload unread)
-  (let ((default-mime-charset wl-mime-charset))
-    (setq wl-message-buffer-all-header-flag (eq flag 'all-header))
-    (prog1
-	(if (eq flag '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))))
-
-(defsubst wl-message-buffer-prefetch-p (folder &optional number)
+      (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)
+	(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)
 	   (elmo-message-file-p folder number)
 	   (let ((size (elmo-message-field folder number 'size)))
@@ -587,18 +677,14 @@ 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)
+(defvar wl-message-buffer-prefetch-move-spec-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))
+	(let ((wl-summary-move-spec-alist
+	       (or wl-message-buffer-prefetch-move-spec-alist
+		   wl-summary-move-spec-alist))
 	      (next number))
 	  (while (and (setq next (funcall
 				  wl-message-buffer-prefetch-get-next-function
@@ -610,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
@@ -624,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
@@ -646,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))
@@ -662,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)))
@@ -755,6 +846,122 @@ Returns non-nil if bottom of message."
 	(set-buffer buf)
 	filename))))
 
+;;; Header narrowing courtesy of Hideyuki Shirai.
+(defun wl-message-header-narrowing ()
+  "Narrowing headers."
+  (unless (eq this-command 'wl-summary-redisplay-all-header)
+    (save-excursion
+      (save-restriction
+	(goto-char (point-min))
+	(if (re-search-forward "^$" nil t)
+	    (beginning-of-line)
+	  (goto-char (point-max)))
+	(narrow-to-region (point-min) (point))
+	(let ((fields wl-message-header-narrowing-fields))
+	  (while fields
+	    (wl-message-header-narrowing-1 (concat "^" (car fields) ":"))
+	    (setq fields (cdr fields))))))))
+
+(defvar wl-message-header-narrowing-map (make-sparse-keymap))
+(define-key wl-message-header-narrowing-map [mouse-2]
+  'wl-message-header-narrowing-again-at-mouse)
+
+(defvar wl-message-header-narrowing-widen-map (make-sparse-keymap))
+(define-key wl-message-header-narrowing-widen-map [mouse-2]
+  'wl-message-header-narrowing-widen-at-mouse)
+
+(defun wl-message-header-narrowing-again-at-mouse (event)
+  (interactive "e")
+  (save-window-excursion
+    (save-excursion
+      (mouse-set-point event)
+      (wl-message-header-narrowing))))
+
+(defun wl-message-header-narrowing-1 (hregexp)
+  (let ((case-fold-search t)
+	ov start end)
+    (goto-char (point-min))
+    (while (re-search-forward hregexp nil t)
+      (setq start (match-beginning 0))
+      (forward-line 1)
+      (setq end (progn (while (looking-at "^[ \t]") (forward-line))
+		       (forward-line -1)
+		       (line-end-position)))
+      (if (<= (count-lines start end) wl-message-header-narrowing-lines)
+	  (forward-line 1)
+	(goto-char start)
+	(forward-line (1- wl-message-header-narrowing-lines))
+	(end-of-line)
+	(setq start (point))
+	(unless (eq (get-char-property start 'invisible)
+		    'wl-message-header-narrowing)
+	  (setq ov (or
+		    (let ((ovs (overlays-at start))
+			  ov)
+		      (while (and ovs (not (overlayp ov)))
+			(if (overlay-get (car ovs)
+					 'wl-message-header-narrowing)
+			    (setq ov (car ovs)))
+			(setq ovs (cdr ovs)))
+		      ov)
+		    (make-overlay start end)))
+	  (overlay-put ov 'wl-message-header-narrowing t)
+	  (overlay-put ov 'evaporate t)
+	  (overlay-put ov 'invisible 'wl-message-header-narrowing)
+	  (overlay-put ov 'after-string
+		       wl-message-header-narrowing-string))))))
+
+(defun wl-message-header-narrowing-widen-at-mouse (event)
+  (interactive "e")
+  (save-selected-window
+    (select-window (posn-window (event-start event)))
+    (let* ((win (selected-window))
+	   (wpos (window-start win))
+	   (pos (mouse-set-point event))
+	   (ovs (overlays-in (1- pos) (1+ pos)))	;; Uum...
+	   ov)
+      (while (and ovs (not (overlayp ov)))
+	(when (overlay-get (car ovs) 'wl-message-header-narrowing)
+	  (setq ov (car ovs)))
+	(setq ovs (cdr ovs)))
+      (when (overlayp ov)
+	(overlay-put ov 'face 'wl-message-header-narrowing-face)
+	(overlay-put ov 'local-map wl-message-header-narrowing-map)
+	(overlay-put ov 'invisible nil)
+	(overlay-put ov 'after-string nil))
+      (set-window-start win wpos))))
+
+(defun wl-message-header-narrowing-setup ()
+  (when (boundp 'line-move-ignore-invisible)
+    (set (make-local-variable 'line-move-ignore-invisible) t))
+  (set-text-properties 0 (length wl-message-header-narrowing-string)
+		       `(face
+			 wl-message-header-narrowing-face
+			 keymap
+			 ,wl-message-header-narrowing-widen-map)
+		       wl-message-header-narrowing-string))
+
+(defun wl-message-header-narrowing-toggle ()
+  "Toggle header narrowing."
+  (interactive)
+  (when wl-message-use-header-narrowing
+    (save-excursion
+      (goto-char (point-min))
+      (if (re-search-forward "^$" nil t)
+	  (beginning-of-line)
+	(goto-char (point-max)))
+      (let ((ovs (overlays-in (point-min) (point)))
+	    ov hn-ovs)
+	(while (setq ov (car ovs))
+	  (when (overlay-get ov 'wl-message-header-narrowing)
+	    (setq hn-ovs (cons ov hn-ovs)))
+	  (setq ovs (cdr ovs)))
+	(if hn-ovs
+	    (while hn-ovs
+	      (delete-overlay (car hn-ovs))
+	      (setq hn-ovs (cdr hn-ovs)))
+	  (wl-message-header-narrowing))))))
+
 (require 'product)
 (product-provide (provide 'wl-message) (require 'wl-version))