* wl-vars.el (wl-draft-preview-attributes): New user option.

(wl-draft-preview-attributes-list): Ditto.
(wl-draft-preview-attributes-buffer-lines): Ditto.
(wl-draft-preview-attributes-buffer-name): Ditto.

* wl-mime.el (wl-draft-preview-message): Display attributes.

diff --git a/wl/ChangeLog b/wl/ChangeLog
index b7d9e7a..cc6b341 100644 (file)
--- a/wl/ChangeLog
+++ b/wl/ChangeLog
@@ -1,3 +1,12 @@
+2003-08-26  Yuuichi Teranishi  <teranisi@gohome.org>
+
+       * wl-vars.el (wl-draft-preview-attributes): New user option.
+       (wl-draft-preview-attributes-list): Ditto.
+       (wl-draft-preview-attributes-buffer-lines): Ditto.
+       (wl-draft-preview-attributes-buffer-name): Ditto.
+
+       * wl-mime.el (wl-draft-preview-message): Display attributes.
+
 2003-08-26  Hiroya Murata  <lapis-lazuli@pop06.odn.ne.jp>
 
        * wl-summary.el (wl-summary-detect-mark-position): Bind

diff --git a/wl/wl-mime.el b/wl/wl-mime.el
index 16f56c0..ef80d00 100644 (file)
--- a/wl/wl-mime.el
+++ b/wl/wl-mime.el
@@ -146,7 +146,8 @@ It calls following-method selected from variable
 (defun wl-draft-preview-message ()
   "Preview editing message."
   (interactive)
-  (let* (recipients-message
+  (let* (wl-recipients
+        (orig-buffer (current-buffer))
         (current-point (point))
         (config-exec-flag wl-draft-config-exec-flag)
         (parent-folder wl-draft-parent-folder)
@@ -167,10 +168,9 @@ It calls following-method selected from variable
                     (wl-draft-parent-folder parent-folder))
                 (goto-char current-point)
                 (run-hooks 'wl-draft-send-hook)
-                (setq recipients-message
+                (setq wl-recipients
                       (condition-case err
-                          (concat "Recipients: "
-                                  (mapconcat
+                          (concat (mapconcat
                                    'identity
                                    (wl-draft-deduce-address-list
                                     (current-buffer)
@@ -194,7 +194,51 @@ It calls following-method selected from variable
       (when wl-highlight-body-too
        (wl-highlight-body))
       (run-hooks 'wl-draft-preview-message-hook))
-    (message "%s" recipients-message)))
+    (make-local-variable 'kill-buffer-hook)
+    (add-hook 'kill-buffer-hook
+             (lambda ()
+               (when (get-buffer-window
+                      wl-draft-preview-attributes-buffer-name)
+                 (select-window (get-buffer-window
+                                 wl-draft-preview-attributes-buffer-name))
+                 (delete-window))
+               (when (get-buffer wl-draft-preview-attributes-buffer-name)
+                 (kill-buffer (get-buffer
+                               wl-draft-preview-attributes-buffer-name)))))
+    (if (not wl-draft-preview-attributes)
+       (message (concat "Recipients: " wl-recipients))
+;      (ignore-errors ; in case when the window is too small
+       (let* ((cur-win (selected-window))
+              (size (min
+                     (- (window-height cur-win)
+                        window-min-height 1)
+                     (- (window-height cur-win)
+                        (max
+                         window-min-height
+                         (1+ wl-draft-preview-attributes-buffer-lines))))))
+         (split-window cur-win (if (> size 0) size window-min-height))
+         (select-window (next-window))
+         (let ((pop-up-windows nil))
+           (switch-to-buffer (get-buffer-create
+                              wl-draft-preview-attributes-buffer-name)))
+         (with-current-buffer
+             (get-buffer wl-draft-preview-attributes-buffer-name)
+           (setq buffer-read-only t)
+           (let (buffer-read-only)
+             (erase-buffer)
+             (dolist (attr wl-draft-preview-attributes-list)
+               (insert (capitalize (symbol-name attr)) ": "
+                       (or
+                        (with-current-buffer orig-buffer
+                          (format "%s"
+                                  (symbol-value
+                                   (intern
+                                    (concat "wl-" (symbol-name attr))))))
+                        "")
+                       "\n"))
+             (goto-char (point-min))
+             (wl-highlight-headers)))
+         (select-window cur-win)))));)
 
 (defalias 'wl-draft-caesar-region  'mule-caesar-region)
 

diff --git a/wl/wl-vars.el b/wl/wl-vars.el
index 2c8dc18..fe8b8a5 100644 (file)
--- a/wl/wl-vars.el
+++ b/wl/wl-vars.el
@@ -1810,6 +1810,39 @@ This wrapper is generated by the mail system when rejecting a letter."
   :type 'regexp
   :group 'wl-draft)
 
+(defcustom wl-draft-preview-attributes t
+  "Non-nil forces to preview the attributes in the `wl-draft-preview-message'.
+Attributes specified in the `wl-draft-preview-attributes-list' are displayed."
+  :type 'boolean
+  :group 'wl-draft)
+
+(defcustom wl-draft-preview-attributes-list '(recipients
+                                             envelope-from
+                                             smtp-posting-server
+                                             smtp-posting-port)
+  "*Attribute symbols to display in the draft preview.
+Candidates are following:
+`recipients'
+`envelope-from'
+`smtp-posting-server'
+`smtp-posting-port'
+`nntp-posting-server'
+`nntp-posting-port'
+Also variables which begin with `wl-' can be specified
+\(`wl-' have to be removed\)"
+  :type '(repeat symbol)
+  :group 'wl-draft)
+
+(defcustom wl-draft-preview-attributes-buffer-lines 5
+  "*Buffer height for the draft attribute preview."
+  :type 'integer
+  :group 'wl-draft)
+
+(defcustom wl-draft-preview-attributes-buffer-name "*Preview Attributes*"
+  "*Buffer name for the draft attribute preview."
+  :type 'string
+  :group 'wl-draft)
+
 (defcustom wl-refile-default-from-folder "+from"
   "*Folder name to refile by `wl-refile-guess-by-from'."
   :type '(string :tag "Folder")