X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-message.el;h=c49281e9e826fef3e6efa4a129d19ca3c089794c;hb=d88a739b6a9dddf6fca245e740a1f4ce9a1404bd;hp=f323d3b68de0ded0bf35ab59025ed292ed3e6e54;hpb=e3e5f572d472484c24a40f53375103b9c9a0a7a9;p=elisp%2Fwanderlust.git

diff --git a/wl/wl-message.el b/wl/wl-message.el
index f323d3b..c49281e 100644
--- a/wl/wl-message.el
+++ b/wl/wl-message.el
@@ -1,6 +1,6 @@
-;;; wl-message.el -- Message displaying modules for Wanderlust.
+;;; wl-message.el --- Message displaying modules for Wanderlust.
 
-;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
 
 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
 ;; Keywords: mail, net news
@@ -24,290 +24,231 @@
 ;;
 
 ;;; Commentary:
-;; 
+;;
 
 ;;; Code:
-;; 
+;;
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'static))
 
 (require 'wl-vars)
 (require 'wl-highlight)
+(require 'elmo)
+(require 'elmo-mime)
+(require 'timer)
 
 (eval-when-compile
-  (if wl-use-semi
-      (progn
-	(require 'wl-mime)
-	(require 'mime-view)
-	(require 'mmelmo-imap4))
-    (require 'tm-wl))
-  (mapcar
-   (function
-    (lambda (symbol)
-      (unless (boundp symbol)
-	(set (make-local-variable symbol) nil))))
-   '(mime-view-ignored-field-list mmelmo-imap4-skipped-parts))
-  (defun-maybe event-window (a))
-  (defun-maybe posn-window (a))
-  (defun-maybe event-start (a))
-  (defun-maybe mime-open-entity (a b)))
-
-(defvar wl-original-buf-name "*Message*")
-(defvar wl-message-buf-name "Message")
-(defvar wl-message-buffer-cur-summary-buffer nil)
+  (require 'wl-mime)
+  (require 'mime-view)
+  (defalias-maybe 'event-window 'ignore)
+  (defalias-maybe 'posn-window 'ignore)
+  (defalias-maybe 'event-start '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)
+
+(defvar wl-message-buffer-prefetch-debug nil)
+
+(defvar wl-message-buffer nil) ; message buffer.
+
 (defvar wl-message-buffer-cur-folder nil)
 (defvar wl-message-buffer-cur-number 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-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-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-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)
 
-(defvar wl-original-buffer-cur-folder nil)
-(defvar wl-original-buffer-cur-number nil)
-(defvar wl-original-buffer-cur-msgdb  nil)
+(defvar wl-message-buffer-cache-size 10) ; At least 1.
 
-(mapcar
- (function make-variable-buffer-local)
- (list 'wl-message-buffer-cur-folder
-       'wl-message-buffer-cur-number))
+;;; Message buffer cache.
 
-(provide 'wl-message)
+(defvar wl-message-buffer-cache nil
+  "Message cache.  (old ... new) order alist.
+With association ((\"folder\" message \"message-id\") . cache-buffer).")
 
-(defvar wl-fixed-window-configuration nil)
+(defmacro wl-message-buffer-cache-buffer-get (entry)
+  `(cdr ,entry))
+
+(defmacro wl-message-buffer-cache-folder-get (entry)
+  `(car (car ,entry)))
+
+(defmacro wl-message-buffer-cache-message-get (entry)
+  `(cdr (car ,entry)))
+
+(defmacro wl-message-buffer-cache-entry-make (key buf)
+  `(cons ,key ,buf))
+
+(defmacro wl-message-buffer-cache-hit (key)
+  "Return value assosiated with key."
+  `(wl-message-buffer-cache-buffer-get
+    (assoc ,key wl-message-buffer-cache)))
+
+(defun wl-message-buffer-cache-sort (entry)
+  "Move ENTRY to the top of `wl-message-buffer-cache'."
+  (setq wl-message-buffer-cache
+	(cons entry (delete entry wl-message-buffer-cache))))
+;  (let* ((pointer (cons nil wl-message-buffer-cache))
+;	 (top pointer))
+;    (while (cdr pointer)
+;      (if (equal (car (cdr pointer)) entry)
+;	  (setcdr pointer (cdr (cdr pointer)))
+;	(setq pointer (cdr pointer))))
+;    (setcdr pointer (list entry))
+;    (setq wl-message-buffer-cache (cdr top))))
+
+(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)
+  (set-buffer-multibyte nil)
+  (setq mode-name "Wanderlust original message"))
+
+(defun wl-original-message-buffer-get (name)
+  "Get original message buffer for NAME.
+If original message buffer already exists, it is re-used."
+  (let* ((name (concat wl-original-message-buffer-name name))
+	 (buffer (get-buffer name)))
+    (unless (and buffer (buffer-live-p buffer))
+      (with-current-buffer (setq buffer (get-buffer-create name))
+	(wl-original-message-mode)))
+    buffer))
+
+(defun wl-message-buffer-create ()
+  "Create a new message buffer."
+  (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))
+      (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)
+  "Add (KEY . buf) to the top of `wl-message-buffer-cache'.
+Return its cache buffer."
+  (let ((len (length wl-message-buffer-cache))
+	(buf nil))
+    (if (< len wl-message-buffer-cache-size)
+	(setq buf (wl-message-buffer-create))
+      (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))
+    buf))
+
+(defun wl-message-buffer-cache-delete (&optional key)
+  "Delete the most recent cache entry"
+  (if key
+      (setq wl-message-buffer-cache
+	    (delq (assoc key wl-message-buffer-cache)
+		  wl-message-buffer-cache))
+    (let ((buf (wl-message-buffer-cache-buffer-get
+		(car wl-message-buffer-cache))))
+      (setq wl-message-buffer-cache
+	    (nconc (cdr wl-message-buffer-cache)
+		   (list (wl-message-buffer-cache-entry-make nil buf)))))))
+
+(defun wl-message-buffer-cache-clean-up ()
+  "A function to flush all decoded messages in cache list."
+  (interactive)
+  (if (and (eq major-mode 'wl-summary-mode)
+	   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-name))
+  (setq wl-message-buffer-cache nil))
+
+;;; Message buffer handling from summary buffer.
 
 (defun wl-message-buffer-window ()
-  (let* ((mes-buf (concat "^" (default-value 'wl-message-buf-name)))
-	 (start-win (selected-window))
+  "Get message buffer window if any."
+  (let* ((start-win (selected-window))
 	 (cur-win start-win))
     (catch 'found
       (while (progn
 	       (setq cur-win (next-window cur-win))
-	       (if (string-match mes-buf (buffer-name (window-buffer cur-win)))
-		   (throw 'found cur-win))
+	       (with-current-buffer (window-buffer cur-win)
+		 (if (or (eq major-mode 'wl-message-mode)
+			 (eq major-mode 'mime-view-mode))
+		     (throw 'found cur-win)))
 	       (not (eq cur-win start-win)))))))
 
-(defun wl-select-buffer (buffer)
-  (let ((gbw (or (get-buffer-window buffer)
-		 (wl-message-buffer-window)))
+(defun wl-message-select-buffer (buffer)
+  "Select BUFFER as a message buffer."
+  (let ((window (get-buffer-window buffer))
 	(sum (car wl-message-window-size))
 	(mes (cdr wl-message-window-size))
 	whi)
-    (when (and gbw
-	       (not (eq (save-excursion (set-buffer (window-buffer gbw))
-					wl-message-buffer-cur-summary-buffer)
+    (when (and window
+	       (not (eq (with-current-buffer (window-buffer window)
+			  wl-message-buffer-cur-summary-buffer)
 			(current-buffer))))
-      (delete-window gbw)
+      (delete-window window)
       (run-hooks 'wl-message-window-deleted-hook)
-      (setq gbw nil))
-    (if gbw
-	(select-window gbw)
-;      (if (or (null mes)
-;	      wl-stay-folder-window)
-;	  (delete-other-windows))
+      (setq window nil))
+    (if window
+	(select-window window)
       (when wl-fixed-window-configuration
-        (delete-other-windows)
-        (and wl-stay-folder-window
-             (wl-summary-toggle-disp-folder)))
-      (setq whi (1- (window-height)))
-      (if mes
-	  (progn
-	    (let ((total (+ sum mes)))
-	      (setq sum (max window-min-height (/ (* whi sum) total)))
-	      (setq mes (max window-min-height (/ (* whi mes) total))))
-            (if (< whi (+ sum mes))
-                (enlarge-window (- (+ sum mes) whi)))))
-      (split-window (get-buffer-window (current-buffer)) sum)
-      (other-window 1))
+	(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)
+	(setq whi (1- (window-height)))
+	(if mes
+	    (progn
+	      (let ((total (+ sum mes)))
+		(setq sum (max window-min-height (/ (* whi sum) total)))
+		(setq mes (max window-min-height (/ (* whi mes) total))))
+	      (if (< whi (+ sum mes))
+		  (enlarge-window (- (+ sum mes) whi)))))
+	(split-window (get-buffer-window (current-buffer)) sum)
+	(other-window 1)))
     (switch-to-buffer buffer)))
 
-;;
-;; called by wl-summary-mode buffer
-;;
-(defvar wl-message-func-called-hook nil)
-
-(defun wl-message-scroll-down (amount)
-  (let ((view-message-buffer (get-buffer-create wl-message-buf-name))
-	(cur-buf (current-buffer)))
-    (wl-select-buffer view-message-buffer)
-    (if (bobp)
-	()
-      (scroll-down))
-    (select-window (get-buffer-window cur-buf))))
-
-(defun wl-message-scroll-up (amount)
-  (let ((view-message-buffer (get-buffer-create wl-message-buf-name))
-	(cur-buf (current-buffer)))
-    (wl-select-buffer view-message-buffer)
-    (save-excursion
-      (save-restriction
-	(widen)
-	(forward-page 1)
-	(if (pos-visible-in-window-p (point))
-	    (wl-message-narrow-to-page 1))))		;Go to next page.
-    (if (eobp)
-	()
-      (scroll-up))
-    (select-window (get-buffer-window cur-buf))))
-  
-(defun wl-message-follow-current-entity (buffer)
-  "Follow to current message"
-  (wl-draft-reply (wl-message-get-original-buffer)
-		  'to-all wl-message-buffer-cur-summary-buffer)
-  (let ((mail-reply-buffer buffer))
-    (wl-draft-yank-from-mail-reply-buffer nil)))
-
-(defun wl-message-original-mode ()
-  (setq major-mode 'wl-message-original-mode)
-  (setq mode-name "Original")
-  (setq buffer-read-only t)
-  (if (fboundp 'set-buffer-file-coding-system)
-      (set-buffer-file-coding-system wl-cs-noconv)))
-
-(defun wl-message-mode ()
-  (interactive)
-  (setq major-mode 'wl-message-mode)
-  (setq buffer-read-only t)
-  (setq mode-name "Message"))
-
-(defun wl-message-get-buffer-create ()
-  (let ((buf-name wl-message-buf-name))
-    (or (get-buffer buf-name)
-	(save-excursion
-	  (set-buffer (get-buffer-create buf-name))
-	  (wl-message-mode)
-	  (run-hooks 'wl-message-buffer-created-hook)
-	  (get-buffer buf-name)))))
-
-(defun wl-message-original-get-buffer-create ()
-  (or (get-buffer wl-original-buf-name)
-      (save-excursion
-	(set-buffer (get-buffer-create wl-original-buf-name))
-	(wl-message-original-mode)
-	(get-buffer wl-original-buf-name))))
-  
-(defun wl-message-exit ()
-  (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-select-buffer wl-message-buf-name)
-	  (select-window (get-buffer-window summary-buf))))
-    (run-hooks 'wl-message-exit-hook)))
-
-(defun wl-message-decode (outbuf inbuf flag)
-  (cond
-   ((eq flag 'all-header)
-    (save-excursion
-      (set-buffer inbuf)
-      (let ((buffer-read-only nil))
-	(decode-mime-charset-region (point-min)
-				    (save-excursion
-				      (goto-char (point-min))
-				      (re-search-forward "^$" nil t)
-				      (point))
-				    wl-mime-charset)))
-    (wl-message-decode-with-all-header outbuf inbuf))
-   ((eq flag 'no-mime)
-    (save-excursion
-      (set-buffer inbuf)
-      (let ((buffer-read-only nil))
-	(save-excursion
-	  (set-buffer outbuf)
-	  (elmo-set-buffer-multibyte nil))
-	(copy-to-buffer outbuf (point-min) (point-max))
-	(set-buffer outbuf)
-	(local-set-key "q" 'wl-message-exit)
-	(local-set-key "p" 'wl-message-exit)
-	(local-set-key "n" 'wl-message-exit)
-	(elmo-set-buffer-multibyte default-enable-multibyte-characters)
-	;;(decode-mime-charset-region (point-min) (point-max) wl-mime-charset)
-	;; we can call decode-coding-region() directly, because multibyte flag is t.
-	(decode-coding-region (point-min) (point-max) wl-cs-autoconv)
-	(wl-highlight-message (point-min)
-			      (save-excursion
-				(goto-char (point-min))
-				(re-search-forward "^$" nil t)) nil))))
-   (t					; normal
-    (save-excursion
-      (set-buffer inbuf)
-      (let ((buffer-read-only nil))
-	(decode-mime-charset-region (point-min)
-				    (save-excursion
-				      (goto-char (point-min))
-				      (re-search-forward "^$" nil t)
-				      (point))
-				    wl-mime-charset)))
-    (wl-message-decode-mode outbuf inbuf))))
-
-(defun wl-message-prev-page (&optional lines)
-  "Scroll down this message. Returns non-nil if top of message"
-  (interactive)
-  (let ((cur-buf (current-buffer))
-	(view-message-buffer (get-buffer-create wl-message-buf-name))
-	ret-val)
-    (wl-select-buffer view-message-buffer)
-    (move-to-window-line 0)
-    (if (and wl-break-pages
-	     (bobp)
-	     (not (save-restriction (widen) (bobp))))
-	(progn
-	  (wl-message-narrow-to-page -1)
-	  (goto-char (point-max))
-	  (recenter -1))
-      (if (not (bobp))
-	  (scroll-down lines)
-	(setq ret-val t)))
-    (select-window (get-buffer-window cur-buf))
-    ret-val))
-
-(static-if (fboundp 'luna-make-entity)
-    (defsubst wl-message-make-mime-entity (backend number backend folder msgdb)
-      (luna-make-entity (mm-expand-class-name 'elmo)
-			:location (get-buffer-create
-				   (concat mmelmo-entity-buffer-name "0"))
-			:imap (eq backend 'elmo-imap4)
-			:folder folder
-			:number number
-			:msgdb msgdb :size 0))
-  (defsubst wl-message-make-mime-entity (backend number backend folder msgdb)
-    (mime-open-entity backend (list folder number msgdb nil))))
-
-(defun wl-message-next-page (&optional lines)
-  "Scroll up this message. Returns non-nil if bottom of message"
-  (interactive)
-  (let ((cur-buf (current-buffer))
-	(view-message-buffer (get-buffer-create wl-message-buf-name))
-	ret-val)
-    (wl-select-buffer view-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 ret-val t)
-	  (wl-message-narrow-to-page 1)
-	  (setq ret-val nil))
-      (condition-case ()
-	  (scroll-up lines)
-	(end-of-buffer
-	 (goto-char (point-max))))
-      (setq ret-val nil))
-    (select-window (get-buffer-window cur-buf))
-    ret-val
-    ))
-
 (defun wl-message-narrow-to-page (&optional arg)
+  "Narrow to page.
+If ARG is specified, narrow to ARGth page."
   (interactive "P")
   (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
     (widen)
     (cond
-     ((> arg 0)	(forward-page arg))
+     ((> arg 0) (forward-page arg))
      ((< arg 0) (forward-page (1- arg))))
     (forward-page)
     (if wl-break-pages
@@ -316,7 +257,107 @@
 			    (forward-page -1)
 			    (if (and (eolp) (not (bobp)))
 				(forward-line))
-			    (point)))) ))
+			    (point))))))
+
+(defun wl-message-prev-page (&optional lines)
+  "Scroll down current message by LINES.
+Returns non-nil if top of message."
+  (interactive)
+  (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 (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))
+
+
+(defun wl-message-follow-current-entity (buffer)
+  "Follow to current message."
+  (wl-draft-reply (wl-message-get-original-buffer)
+		  nil wl-message-buffer-cur-summary-buffer) ; reply to all
+  (let ((mail-reply-buffer buffer))
+    (wl-draft-yank-from-mail-reply-buffer nil)))
+
+;;
+
+(defun wl-message-mode ()
+  "A major mode for message displaying."
+  (interactive)
+  (setq major-mode 'wl-message-mode)
+  (setq buffer-read-only t)
+  (setq mode-name "Message"))
+
+(defun wl-message-exit ()
+  "Move to summary buffer or mother buffer."
+  (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)
+	     (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 ()
   (interactive)
@@ -327,264 +368,457 @@
 	(if (setq summary-win (get-buffer-window summary-buf))
 	    (delete-window summary-win)
 	  (switch-to-buffer summary-buf)
-	  (wl-select-buffer wl-message-buf-name))
+	  (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-select-buffer wl-message-buf-name)
+	(wl-message-select-buffer wl-message-buffer)
 	(setq wl-message-buffer-cur-summary-buffer sum-buf)))))
 
-(defun wl-message-normal-get-original-buffer ()
-  (let (ret-val)
-    (if (setq ret-val (get-buffer wl-original-buf-name))
-	ret-val
-      (set-buffer (setq ret-val
-			(get-buffer-create wl-original-buf-name)))
-      (wl-message-original-mode)
-      ret-val)))
-
+(defun wl-message-get-original-buffer ()
+  "Get original buffer for current message buffer."
+  (if (buffer-live-p wl-message-buffer-original-buffer)
+      wl-message-buffer-original-buffer
+    (wl-original-message-buffer-get (buffer-name (current-buffer)))))
 
-(if wl-use-semi
-    (defalias 'wl-message-get-original-buffer
-      'mmelmo-get-original-buffer)
-  (defalias 'wl-message-get-original-buffer
-    'wl-message-normal-get-original-buffer))
-
-(defvar wl-message-redisplay-func 'wl-normal-message-redisplay)
-(defvar wl-message-cache-used nil) ;whether cache is used or not.
-
-(defun wl-message-redisplay (folder number flag msgdb &optional force-reload)
-  (let ((default-mime-charset wl-mime-charset)
-	(buffer-read-only nil))
-    (setq wl-message-cache-used nil)
-    (if wl-message-redisplay-func
-	(funcall wl-message-redisplay-func
-		 folder number flag msgdb force-reload))))
-
-;; nil means don't fetch all.
-(defun wl-message-decide-backend (folder number message-id size)
-  (let ((dont-do-that (and
-		       (not (setq wl-message-cache-used
-				  (or
-				   (elmo-buffer-cache-hit
-				    (list folder number message-id))
-				   (elmo-cache-exists-p message-id
-							folder number))))
-		       (integerp size)
-		       (not (elmo-local-file-p folder number))
-		       wl-fetch-confirm-threshold
-		       (>= size wl-fetch-confirm-threshold)
-		       (not (y-or-n-p
-			     (format "Fetch entire message? (%dbytes)"
-				     size))))))
-    (message "")
-    (cond ((and dont-do-that
-		(eq (elmo-folder-number-get-type folder number) 'imap4)
-		(not (and (elmo-use-cache-p folder number)
-			  (elmo-cache-exists-p message-id folder number))))
-	   'elmo-imap4)
-	  (t (if (not dont-do-that) 'elmo)))))
-
-(defmacro wl-message-original-buffer-folder ()
-  wl-original-buffer-cur-folder)
-
-(defmacro wl-message-original-buffer-number ()
-  wl-original-buffer-cur-number)
-
-(defun wl-message-set-original-buffer-information (folder number)
-  (when (or (not (string= folder (or wl-original-buffer-cur-folder "")))
-	    (not (eq number (or wl-original-buffer-cur-number 0))))
-    (setq wl-original-buffer-cur-folder folder)
-    (setq wl-original-buffer-cur-number number)))
-
-;; Works on FLIM-1.9.0/SEMI-1.8.2 or later (maybe).
-(defun wl-mmelmo-message-redisplay (folder number flag msgdb
-					   &optional force-reload)
-  (let* ((cur-buf (current-buffer))
-	 (view-message-buffer (wl-message-get-buffer-create))
-	 (message-id (cdr (assq number
-				(elmo-msgdb-get-number-alist msgdb))))
-	 (size (elmo-msgdb-overview-entity-get-size
-		(assoc message-id
-		       (elmo-msgdb-get-overview msgdb))))
-	 (backend (wl-message-decide-backend folder number message-id size))
-	 cur-entity ret-val header-end real-fld-num summary-win)
-    (require 'mmelmo)
-    (wl-select-buffer view-message-buffer)
-    (set-buffer view-message-buffer)
-    (unwind-protect
-	(progn
-	  (setq wl-message-buffer-cur-summary-buffer cur-buf)
-	  (setq wl-message-buffer-cur-folder folder)
-	  (setq wl-message-buffer-cur-number number)
-	  (setq buffer-read-only nil)
-	  (erase-buffer)
-	  (if backend
-	      (let (mime-display-header-hook ;; bind to nil...
-		    (mime-view-ignored-field-list
-		     (if (eq flag 'all-header)
-			 nil
-		       mime-view-ignored-field-list))
-		    (mmelmo-force-reload force-reload)
-		    (mmelmo-imap4-threshold wl-fetch-confirm-threshold))
-		(setq real-fld-num (elmo-get-real-folder-number
-				    folder number))
-		(setq cur-entity
-		      (wl-message-make-mime-entity
-		       backend
-		       (if (eq backend 'elmo-imap4)
-			   (cdr real-fld-num)
-			 number)
-		       backend
-		       (if (eq backend 'elmo-imap4)
-			   (car real-fld-num)
-			 folder)
-		       msgdb))
-		(setq mmelmo-imap4-skipped-parts nil)
-		;;; mime-display-message sets buffer-read-only variable as t.
-		;;; which makes buffer read-only status confused...
-		(wl-mime-display-message cur-entity view-message-buffer
-					 nil nil 'mmelmo-original-mode)
-		(if mmelmo-imap4-skipped-parts
-		    (progn
-		      (message "Skipped fetching of %s."
-			       (mapconcat
-				(lambda (x)
-				  (format "[%s]" x))
-				mmelmo-imap4-skipped-parts ","))))
-		(if (and (eq backend 'elmo-imap4)
-			 (null mmelmo-imap4-skipped-parts))
-		    (message "No required part was skipped."))
-		(setq ret-val (not (eq backend 'elmo-imap4))))
-	    (message "Skipped fetching.")
-	    (setq ret-val nil)))
-      (setq buffer-read-only nil)
-      (wl-message-set-original-buffer-information folder number)
-      (wl-message-overload-functions)
-      ;; highlight body
-      (when wl-highlight-body-too
-	(wl-highlight-body))
-      (condition-case ()
-	  (wl-message-narrow-to-page)
-	(error nil));; ignore errors.
-      (setq mode-line-buffer-identification
-	    (format "Wanderlust: << %s / %s >>"
-		    (if (memq 'modeline wl-use-folder-petname)
-			(wl-folder-get-petname folder)
-		      folder) number))
-      (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 cur-buf)
-	(setq summary-win (get-buffer-window cur-buf))
-	(if (window-live-p summary-win)
-	    (select-window summary-win))))
-    ret-val
-    ))
-
-(defun wl-normal-message-redisplay (folder number flag msgdb
-					   &optional force-reload)
-  (interactive)
-  (let* ((cur-buf (current-buffer))
-	 (original-message-buffer (wl-message-get-original-buffer))
-	 (view-message-buffer (wl-message-get-buffer-create))
-	 (message-id (cdr (assq number
-				(elmo-msgdb-get-number-alist msgdb))))
-	 (size (elmo-msgdb-overview-entity-get-size
-		(assoc message-id
-		       (elmo-msgdb-get-overview msgdb))))
-	 header-end ret-val summary-win
-	 )
-    (wl-select-buffer view-message-buffer)
-    (unwind-protect
-	(progn
-	  (setq wl-message-buffer-cur-summary-buffer cur-buf)
-	  (setq wl-message-buffer-cur-folder folder)
-	  (setq wl-message-buffer-cur-number number)
-	  (setq buffer-read-only nil)
-	  (erase-buffer)
-	  (if (or (eq (elmo-folder-number-get-type folder number) 'localdir)
-		  (not (and (integerp size)
-			    wl-fetch-confirm-threshold
-			    (>= size wl-fetch-confirm-threshold)
-			    (not (elmo-cache-exists-p message-id
-						      folder number))
-			    (not (y-or-n-p
-				  (format "Fetch entire message? (%dbytes)"
-					  size))))))
-	      (progn
-		(save-excursion
-		  (set-buffer original-message-buffer)
-		  (let ((buffer-read-only nil))
-		    (elmo-read-msg-with-buffer-cache
-		     folder number original-message-buffer msgdb force-reload)))
-		;; decode MIME message.
-		(wl-message-decode
-		 view-message-buffer
-		 original-message-buffer flag)
-		(setq ret-val t))
-	    (save-excursion
-	      (set-buffer view-message-buffer)
-	      (insert "\n\n"))))
-      (setq buffer-read-only nil)
-      (wl-message-set-original-buffer-information folder number)
-      (wl-message-overload-functions)
-      ;; highlight body
-      (and wl-highlight-body-too (wl-highlight-body))
-      (condition-case ()
-	  (wl-message-narrow-to-page)
-	(error nil)) ; ignore errors.
-      (setq mode-line-buffer-identification
-	    (format "Wanderlust: << %s / %s >>"
-		    (if (memq 'modeline wl-use-folder-petname)
-			(wl-folder-get-petname folder)
-		      folder)
-		    number))
-      (goto-char (point-min))
-      (unwind-protect
-	  (run-hooks 'wl-message-redisplay-hook)
-	;; go back to summary mode
-	(set-buffer-modified-p nil)
-	(setq buffer-read-only t)
-	(set-buffer cur-buf)
-	(setq summary-win (get-buffer-window cur-buf))
-	(if (window-live-p summary-win)
-	    (select-window summary-win)))
-      ret-val
-      )))
-
-(defun wl-message-refer-article-or-url (e)
-  "Read article specified by message-id around point. If failed,
-   attempt to execute button-dispatcher."
-  (interactive "e")
-  (let ((window (get-buffer-window (current-buffer)))
-	mouse-window point beg end msg-id)
-    (unwind-protect
+(defun wl-message-add-buttons-to-body (start end)
+  (save-excursion
+    (save-restriction
+      (narrow-to-region start end)
+      (let ((case-fold-search t)
+	    (alist wl-message-body-button-alist)
+	    entry)
+	(while alist
+	  (setq entry (car alist)
+		alist (cdr alist))
+	  (goto-char (point-min))
+	  (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
+      (narrow-to-region start end)
+      (let ((case-fold-search t)
+	    (alist wl-message-header-button-alist)
+	    entry)
+	(while alist
+	  (setq entry (car alist)
+		alist (cdr alist))
+	  (goto-char (point-min))
+	  (while (re-search-forward (car entry) nil t)
+	    (setq start (match-beginning 0)
+		  end (if (re-search-forward "^[^ \t]" nil t)
+			  (match-beginning 0)
+			(point-max)))
+	    (goto-char start)
+	    (while (re-search-forward (nth 1 entry) end t)
+	      (wl-message-add-button
+	       (match-beginning (nth 2 entry))
+	       (match-end (nth 2 entry))
+	       (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 entity summary-win flags)
+    (setq buffer-read-only nil)
+    (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)
+    (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)
+    (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
+	  (funcall wl-message-buffer-mode-line-formatter))
+    ;; highlight body
+;    (when wl-highlight-body-too
+;      (wl-highlight-body))
+    (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))
+    (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 display-type
+					 &optional force-reload unread)
+  (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)))
+	 (redisplay nil)
+	 entity)
+    (when (and hit (not (buffer-live-p hit)))
+      (wl-message-buffer-cache-delete (list fname number msg-id))
+      (setq hit nil))
+    (if hit
 	(progn
-	  (mouse-set-point e)
-	  (setq mouse-window (get-buffer-window (current-buffer)))
-	  (setq point (point))
-	  (setq beg (save-excursion (beginning-of-line) (point)))
-	  (setq end (save-excursion (end-of-line) (point)))
-	  (search-forward ">" end t)      ;Move point to end of "<....>".
-	  (if (and (re-search-backward "\\(<[^<> \t\n]+@[^<> \t\n]+>\\)"
-				       beg t)
-		   (not (string-match "mailto:"
-				      (setq msg-id (wl-match-buffer 1)))))
-	      (progn
-		(goto-char point)
-		(switch-to-buffer-other-window
-		 wl-message-buffer-cur-summary-buffer)
-		(if (wl-summary-jump-to-msg-by-message-id msg-id)
-		    (wl-summary-redisplay)))
-	    (wl-message-button-dispatcher e)))
-      (if (eq mouse-window (get-buffer-window (current-buffer)))
-	  (select-window window)))))
+	  ;; move hit to the top.
+	  (wl-message-buffer-cache-sort
+	   (wl-message-buffer-cache-entry-make (list fname number msg-id) hit))
+	  (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 redisplay t))))
+      ;; delete tail and add new to the top.
+      (setq hit (wl-message-buffer-cache-add (list fname number msg-id)))
+      (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)))
+	     (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-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-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
+				  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 0)
+	       (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 0)
+	       (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))
+		   (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))
+		  (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))
+		(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)))
+		  (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))
+
+(defun wl-message-add-button (from to function &optional data)
+  "Create a button between FROM and TO with callback FUNCTION and DATA."
+  (add-text-properties
+   from to
+   (nconc (list 'wl-message-button-callback function)
+	  (if data
+	      (list 'wl-message-button-data data))))
+  (let ((ov (make-overlay from to)))
+    (overlay-put ov 'mouse-face 'highlight)
+    (overlay-put ov 'local-map wl-message-button-map)
+    (overlay-put ov 'evaporate t)))
+
+(defun wl-message-button-dispatcher (event)
+  "Select the button under point."
+  (interactive "@e")
+  (mouse-set-point event)
+  (let ((callback (get-text-property (point) 'wl-message-button-callback))
+	(data (get-text-property (point) 'wl-message-button-data)))
+    (if callback
+	(funcall callback data)
+      (wl-message-button-dispatcher-internal event))))
+
+(defun wl-message-button-refer-article (data)
+  "Read article specified by Message-ID DATA at point."
+  (switch-to-buffer-other-window
+   wl-message-buffer-cur-summary-buffer)
+  (if (wl-summary-jump-to-msg-by-message-id data)
+      (wl-summary-redisplay)))
 
 (defun wl-message-uu-substring (buf outbuf &optional first last)
   (save-excursion
@@ -592,23 +826,144 @@
     (search-forward "\n\n")
     (let ((sp (point))
 	  ep filename case-fold-search)
-      (if first
-	  (progn
-	    (re-search-forward "^begin[ \t]+[0-9]+[ \t]+\\([^ ].*\\)" nil t)
-	    (setq filename (buffer-substring (match-beginning 1)(match-end 1))))
-	(re-search-forward "^M.*$" nil t)) ; uuencoded string
-      (beginning-of-line)
-      (setq sp (point))
-      (goto-char (point-max))
-      (if last
-	  (re-search-backward "^end" sp t)
-        (re-search-backward "^M.*$" sp t)) ; uuencoded string
+      (catch 'done
+	(if first
+	    (progn
+	      (if (re-search-forward "^begin[ \t]+[0-9]+[ \t]+\\([^ ].*\\)" nil t)
+		  (setq filename (buffer-substring (match-beginning 1)(match-end 1)))
+		(throw 'done nil)))
+	  (re-search-forward "^M.*$" nil t)) ; uuencoded string
+	(beginning-of-line)
+	(setq sp (point))
+	(goto-char (point-max))
+	(if last
+	    (re-search-backward "^end" sp t)
+	  (re-search-backward "^M.*$" sp t)) ; uuencoded string
+	(forward-line 1)
+	(setq ep (point))
+	(set-buffer outbuf)
+	(goto-char (point-max))
+	(insert-buffer-substring buf sp ep)
+	(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 ep (point))
-      (set-buffer outbuf)
-      (goto-char (point-max))
-      (insert-buffer-substring buf sp ep)
-      (set-buffer buf)
-      filename)))
+      (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))
 
 ;;; wl-message.el ends here