From: teranisi <teranisi>
Date: Tue, 26 Aug 2003 14:46:16 +0000 (+0000)
Subject: * wl-vars.el (wl-draft-preview-attributes): New user option.
X-Git-Tag: merged-trunk-to-elmo-mark-20~2
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=c5c8a0a2356b1cfa23095087218170f17f6f7690;p=elisp%2Fwanderlust.git

* 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
--- 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
--- 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
--- 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")