X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-message.el;h=b8f98517e6126a07888d063eadc72b6a564dc3b1;hb=8b003dd16e3d4a1f0d29b5fcd0f57a2ee294f967;hp=0d36a10e36c1bf927d82a7c0fbe89ee7e4280209;hpb=1d107a7b0e5b7f1b97a9764b3d35a369da2216d3;p=elisp%2Fwanderlust.git

diff --git a/wl/wl-message.el b/wl/wl-message.el
index 0d36a10..b8f9851 100644
--- a/wl/wl-message.el
+++ b/wl/wl-message.el
@@ -31,110 +31,280 @@
 
 (require 'wl-vars)
 (require 'wl-highlight)
+(require 'elmo)
+(require 'elmo-mime) ; XXX should modify for tm.
 
 (eval-when-compile
   (if wl-use-semi
       (progn
 	(require 'wl-mime)
-	(require 'mime-view)
-	(require 'mmelmo-imap4))
+	(require 'mime-view))
     (require 'tm-wl))
   (defalias-maybe 'event-window 'ignore)
   (defalias-maybe 'posn-window 'ignore)
   (defalias-maybe 'event-start 'ignore)
   (defalias-maybe 'mime-open-entity 'ignore))
 
-(defvar wl-original-buf-name "*Message*")
-(defvar wl-message-buf-name "Message")
+(defconst wl-message-buffer-prefetch-idle-time
+  (if (featurep 'lisp-float-type) (/ (float 1) (float 5)) 1))
+(defvar wl-message-buffer-prefetch-get-next-function
+  'wl-summary-default-get-next-msg)
+
+(defvar wl-message-buffer-prefetch-folder-type-list t)
+
+(defvar wl-message-buffer-prefetch-debug t)
+
+(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-original-buffer-cur-folder nil)
-(defvar wl-original-buffer-cur-number nil)
-(defvar wl-original-buffer-cur-msgdb  nil)
-
-(defvar mmelmo-imap4-skipped-parts)
+(defvar wl-message-buffer-cur-flag nil)
+(defvar wl-message-buffer-cur-summary-buffer nil)
+(defvar wl-message-buffer-original-buffer nil) ; original buffer.
 
 (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-summary-buffer)
+(make-variable-buffer-local 'wl-message-buffer-original-buffer)
 
 (defvar wl-fixed-window-configuration nil)
 
+(defvar wl-message-buffer-cache-size 10) ; At least 1.
+
+;;; Message buffer cache.
+
+(defvar wl-message-buffer-cache nil
+  "Message cache.  (old ... new) order alist.
+With association ((\"folder\" message \"message-id\") . cache-buffer).")
+
+(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-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)
+  (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-cache-name))
+	 (name (buffer-name buffer)))
+    (with-current-buffer buffer
+      (setq wl-message-buffer-original-buffer
+	    (wl-original-message-buffer-get name)))
+    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))
+      (setq buf (wl-message-buffer-cache-buffer-get
+		 (nth (1- len) wl-message-buffer-cache)))
+      (setcdr (nthcdr (- len 2) wl-message-buffer-cache) nil))
+    (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-cache-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))
+    (when (and window
+	       (not (eq (save-excursion (set-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))
+      ;; 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-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.
+      (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 (1- arg))))
+    (forward-page)
+    (if wl-break-pages
+	(narrow-to-region (point)
+			  (progn
+			    (forward-page -1)
+			    (if (and (eolp) (not (bobp)))
+				(forward-line))
+			    (point))))))
+
+(defun wl-message-prev-page (&optional lines)
+  "Scroll down current message by LINES.
+Returns non-nil if top of message."
+  (interactive)
+  (if (buffer-live-p wl-message-buffer)
+      (let ((cur-buf (current-buffer))
+	    top)
+	(wl-message-select-buffer wl-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))
+	  (if (not (bobp))
+	      (condition-case nil
+		  (scroll-down lines)
+		(error))
+	    (setq top t)))
+	(select-window (get-buffer-window cur-buf))
+	top)))
+
+(defun wl-message-next-page (&optional lines)
+  "Scroll up current message by LINES.
+Returns non-nil if bottom of message."
+  (interactive)
+  (if (buffer-live-p wl-message-buffer)
+      (let ((cur-buf (current-buffer))
+	    bottom)
+	(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))
+	(select-window (get-buffer-window cur-buf))
+	bottom)))
+
+
 (defun wl-message-follow-current-entity (buffer)
   "Follow to current message."
   (wl-draft-reply (wl-message-get-original-buffer)
@@ -142,184 +312,27 @@
   (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 ()
+  "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-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 ()
+  "Move to summary 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-select-buffer wl-message-buf-name)
+	  (wl-message-select-buffer wl-message-buffer)
 	  (select-window (get-buffer-window summary-buf))))
     (run-hooks 'wl-message-exit-hook)))
 
-(defvar wl-message-mode-map nil)
-(if wl-message-mode-map
-    ()
-  (setq wl-message-mode-map (make-sparse-keymap))
-  (define-key wl-message-mode-map "q" 'wl-message-exit)
-  (define-key wl-message-mode-map "n" 'wl-message-exit)
-  (define-key wl-message-mode-map "p" 'wl-message-exit))
-
-(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)
-	(use-local-map wl-message-mode-map)
-	(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 ()
-	  (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 ret-val nil))
-    (select-window (get-buffer-window cur-buf))
-    ret-val
-    ))
-
-(defun wl-message-narrow-to-page (&optional arg)
-  (interactive "P")
-  (setq arg (if arg (prefix-numeric-value arg) 0))
-  (save-excursion
-    (condition-case ()
-        (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 (1- arg))))
-    (forward-page)
-    (if wl-break-pages
-	(narrow-to-region (point)
-			  (progn
-			    (forward-page -1)
-			    (if (and (eolp) (not (bobp)))
-				(forward-line))
-			    (point)))) ))
-
 (defun wl-message-toggle-disp-summary ()
   (interactive)
   (let ((summary-buf (get-buffer wl-message-buffer-cur-summary-buffer))
@@ -329,238 +342,208 @@
 	(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
       (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 (get-buffer wl-original-buf-name)))
-    (if (not ret-val)
-	(save-excursion
-	  (set-buffer (setq ret-val
-			    (get-buffer-create wl-original-buf-name)))
-	  (wl-message-original-mode)))
-    ret-val))
-
-
-(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
-		(elmo-msgdb-overview-get-entity number 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...
-		    (wl-message-ignored-field-list
-		     (if (eq flag 'all-header)
-			 nil
-		       wl-message-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...
-		(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
-		(elmo-msgdb-overview-get-entity number msgdb)))
-	 header-end ret-val summary-win)
-    (wl-select-buffer view-message-buffer)
+(defun wl-message-get-original-buffer ()
+  "Get original buffer for current message buffer."
+  wl-message-buffer-original-buffer)
+
+(defun wl-message-redisplay (folder number flag &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)
+    (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 message-buf wl-message-buffer)
+    (wl-message-select-buffer wl-message-buffer)
+
+    (set-buffer message-buf)
+    (setq buffer-read-only nil)
+    (setq wl-message-buffer-cur-summary-buffer summary-buf)
+    (setq wl-message-buffer-cur-folder (elmo-folder-name-internal folder))
+    (setq wl-message-buffer-cur-number number)
+    (wl-message-overload-functions)
+    (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))
+    ;; 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))
+    (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))
+
+;; Use message buffer cache.
+(defun wl-message-buffer-display (folder number flag
+					 &optional force-reload unread)
+  (let* ((msg-id (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)
+    (when (and hit (not (buffer-live-p hit)))
+      (wl-message-buffer-cache-delete (list fname number msg-id))
+      (setq hit nil))
+    (if hit
 	(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 (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)
-			    wl-fetch-confirm-threshold
-			    (>= size wl-fetch-confirm-threshold)
-			    (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))
+	  ;; 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))))
+      ;; 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 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
-      )))
+	      (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 ((elmo-message-ignored-field-list
+	 (if (eq flag 'all-header)
+	     nil
+	   wl-message-ignored-field-list))
+	(elmo-message-visible-field-list wl-message-visible-field-list)
+	(elmo-message-sorted-field-list wl-message-sort-field-list)
+	(elmo-message-fetch-threshold wl-fetch-confirm-threshold))
+    (prog1 
+	(if (eq flag 'as-is)
+	    (let (wl-highlight-x-face-function)
+	      (elmo-mime-display-as-is folder number
+				       (current-buffer)
+				       (wl-message-get-original-buffer)
+				       'wl-original-message-mode
+				       force-reload
+				       unread))
+	  (elmo-mime-message-display folder number
+				     (current-buffer)
+				     (wl-message-get-original-buffer)
+				     'wl-original-message-mode
+				     force-reload
+				     unread))
+      (setq buffer-read-only t))))
+
+(defsubst wl-message-buffer-prefetch-p (folder &optional number)
+  (cond 
+   ((eq wl-message-buffer-prefetch-folder-type-list t)
+    t)
+   ((and number wl-message-buffer-prefetch-folder-type-list)
+    (memq (elmo-folder-type-internal
+	   (elmo-message-folder folder number))
+	  wl-message-buffer-prefetch-folder-type-list))
+   (wl-message-buffer-prefetch-folder-type-list
+    (let ((list wl-message-buffer-prefetch-folder-type-list)
+	  type)
+      (catch 'done
+	(while (setq type (pop list))
+	  (if (elmo-folder-contains-type folder type)
+	      (throw 'done t))))))
+   ((consp wl-message-buffer-prefetch-folder-type-list)
+    (wl-string-match-member (elmo-folder-name-internal folder)
+			    wl-message-buffer-prefetch-folder-type-list))
+   (t wl-message-buffer-prefetch-folder-type-list)))
+
+
+(defvar wl-message-buffer-prefetch-timer nil)
+
+(defun wl-message-buffer-prefetch-next (folder number &optional
+					       summary charset)
+  (if (wl-message-buffer-prefetch-p folder)
+      (with-current-buffer (or summary (get-buffer wl-summary-buffer-name))
+	(let* ((next (funcall wl-message-buffer-prefetch-get-next-function
+			      number)))
+	  (when (and next (wl-message-buffer-prefetch-p folder next))
+	    (if (not (fboundp 'run-with-idle-timer))
+		(when (sit-for wl-message-buffer-prefetch-idle-time)
+		  (wl-message-buffer-prefetch folder next summary charset))
+	      (unless wl-message-buffer-prefetch-timer
+		(setq wl-message-buffer-prefetch-timer
+		      (run-with-idle-timer
+		       wl-message-buffer-prefetch-idle-time
+		       nil
+		       'wl-message-buffer-prefetch
+		       folder next summary charset)))))))))
+
+(defun wl-message-buffer-prefetch (folder number summary charset)
+  (when (buffer-live-p summary)
+    (save-excursion
+      (set-buffer summary)
+      (when (string= (elmo-folder-name-internal folder)
+		     (wl-summary-buffer-folder-name))
+	(let ((message-id (elmo-message-field folder number 'message-id))
+	      (wl-mime-charset      charset)
+	      (default-mime-charset charset)
+	      result time1 time2 sec micro)
+	  (if (not (wl-message-buffer-cache-hit (list folder
+						      number message-id)))
+	      (let* ((size (elmo-message-field folder number 'size)))
+		(when (or (elmo-message-file-p folder number)
+			  (not 
+			   (and (integerp size)
+				elmo-message-fetch-threshold
+				(>= size
+				    elmo-message-fetch-threshold))))
+		  ;;(not (elmo-file-cache-exists-p message-id)))))
+		  (when wl-message-buffer-prefetch-debug
+		    (setq time1 (current-time))
+		    (message "Prefetching %d..." number))
+		  (setq result (wl-message-buffer-display folder number
+							  'mime nil 'unread))
+		  (when wl-message-buffer-prefetch-debug
+		    (setq time2 (current-time))
+		    (setq sec  (- (nth 1 time2)(nth 1 time1)))
+		    (setq micro (- (nth 2 time2)(nth 2 time1)))
+		    (setq micro (+ micro (* 1000000 sec)))
+		    (message "Prefetching %d...done(%f msec)."
+			     number
+			     (/ micro 1000.0))))))))))
+  (setq wl-message-buffer-prefetch-timer nil))
 
 (defvar wl-message-button-map (make-sparse-keymap))