* wl-draft.el (wl-draft-generate-clone-buffer, wl-draft-config-exec): Suppress compil...

[elisp/wanderlust.git] / wl / wl-message.el

diff --git a/wl/wl-message.el b/wl/wl-message.el
index 467845e..c49281e 100644 (file)
--- a/wl/wl-message.el
+++ b/wl/wl-message.el
@@ -29,6 +29,7 @@
 ;;; Code:
 ;;
 (eval-when-compile (require 'cl))
+(eval-when-compile (require 'static))
 
 (require 'wl-vars)
 (require 'wl-highlight)
@@ -51,7 +52,6 @@
   'wl-summary-default-get-next-msg)
 
 (defvar wl-message-buffer-prefetch-debug nil)
-(defvar wl-message-buffer-prefetch-timer nil)
 
 (defvar wl-message-buffer nil) ; message buffer.
 
@@ -86,21 +86,21 @@
 With association ((\"folder\" message \"message-id\") . cache-buffer).")
 
 (defmacro wl-message-buffer-cache-buffer-get (entry)
-  (` (cdr (, entry))))
+  `(cdr ,entry))
 
 (defmacro wl-message-buffer-cache-folder-get (entry)
-  (` (car (car (, entry)))))
+  `(car (car ,entry)))
 
 (defmacro wl-message-buffer-cache-message-get (entry)
-  (` (cdr (car (, entry)))))
+  `(cdr (car ,entry)))
 
 (defmacro wl-message-buffer-cache-entry-make (key buf)
-  (` (cons (, 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))))
+  `(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'."
@@ -208,8 +208,8 @@ Return its cache buffer."
        (mes (cdr wl-message-window-size))
        whi)
     (when (and window
-              (not (eq (save-excursion (set-buffer (window-buffer window))
-                                       wl-message-buffer-cur-summary-buffer)
+              (not (eq (with-current-buffer (window-buffer window)
+                         wl-message-buffer-cur-summary-buffer)
                        (current-buffer))))
       (delete-window window)
       (run-hooks 'wl-message-window-deleted-hook)
@@ -345,6 +345,9 @@ Returns non-nil if bottom of message."
   (interactive)
   (let (summary-buf summary-win mother-buffer)
     (cond ((setq summary-buf wl-message-buffer-cur-summary-buffer)
+          (unless (buffer-live-p summary-buf)
+            (error "Summary buffer not found: %s"
+                   wl-message-buffer-cur-folder))
           (if (setq summary-win (get-buffer-window summary-buf))
               (select-window summary-win)
             (switch-to-buffer summary-buf)
@@ -352,7 +355,8 @@ Returns non-nil if bottom of message."
             (select-window (get-buffer-window summary-buf))))
          ((setq mother-buffer mime-mother-buffer)
           (kill-buffer (current-buffer))
-          (switch-to-buffer mother-buffer)))
+          (when (buffer-live-p mother-buffer)
+            (switch-to-buffer mother-buffer))))
     (run-hooks 'wl-message-exit-hook)))
 
 (defun wl-message-toggle-disp-summary ()
@@ -444,12 +448,41 @@ Returns non-nil if bottom of message."
 (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)
@@ -471,32 +504,7 @@ Returns non-nil if bottom of message."
     (setq wl-message-buffer-cur-folder (elmo-folder-name-internal folder))
     (setq wl-message-buffer-cur-number number)
     (setq wl-message-buffer-flag-indicator
-         (if (setq flags (elmo-get-global-flags (elmo-message-flags
-                                                 folder number)))
-             (let ((fl wl-summary-flag-alist)
-                   flag-strings flag-string face)
-               (while fl
-                 (when (memq (car (car fl)) flags)
-                   (setq flag-string (capitalize
-                                      (symbol-name (car (car fl))))
-                         flags (delq (car (car fl)) flags))
-                   (when (facep (setq face
-                                      (intern
-                                       (format
-                                        "wl-highlight-summary-%s-flag-face"
-                                        (car (car fl))))))
-                     (put-text-property 0 (length flag-string)
-                                        'face face flag-string))
-                   (setq flag-strings (nconc flag-strings
-                                             (list flag-string))))
-                 (setq fl (cdr fl)))
-               (setq flag-strings
-                     (nconc flag-strings
-                            (mapcar (lambda (flag)
-                                      (capitalize (symbol-name flag)))
-                                    flags)))
-               (concat " (" (mapconcat 'identity flag-strings ", ") ")"))
-           ""))
+         (wl-message-flag-indicator (elmo-message-flags folder number)))
     (wl-line-formatter-setup
      wl-message-buffer-mode-line-formatter
      wl-message-mode-line-format
@@ -554,19 +562,24 @@ Returns non-nil if bottom of message."
       (setq redisplay t))
     (when (or force-reload redisplay)
       (condition-case err
-         (save-excursion
-           (set-buffer hit)
+         (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))))
+                             '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)))))