From: keiichi <keiichi>
Date: Thu, 20 Aug 1998 01:18:11 +0000 (+0000)
Subject: (message-frames): New custom group.
X-Git-Tag: gnus-6_8_14~2
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=3a09cff313eb909bebd9ba449e1c1c8bec2bb6c6;p=elisp%2Fgnus.git-

(message-frames): New custom group.
(message-original-frame): New variable.
(message-use-multi-frames): New variable.
(message-delete-frame-on-exit): New variable.
(message-send-and-exit): Delete frame which made for editing message.
(message-kill-buffer): Ditto.
(message-delete-frame): New function.
(message-pop-to-buffer): Make new frame when edit message.
---

diff --git a/lisp/message.el b/lisp/message.el
index 8eca692..ab9ef0a 100644
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -3,6 +3,7 @@
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;         MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;;         Keiichi Suzuki <kei-suzu@mail.wbs.ne.jp>
 ;; Keywords: mail, news, MIME
 
 ;; This file is part of GNU Emacs.
@@ -103,6 +104,10 @@
   :group 'message
   :group 'faces)
 
+(defgroup message-frames nil
+  "Message frames"
+  :group 'message)
+
 (defcustom message-directory "~/Mail/"
   "*Directory from which all other mail file variables are derived."
   :group 'message-various
@@ -571,6 +576,7 @@ If stringp, use this; if non-nil, use no host name (user name only)."
   "A list of actions to be performed before killing a message buffer.")
 (defvar message-postpone-actions nil
   "A list of actions to be performed after postponing a message.")
+(defvar message-original-frame nil)
 
 (define-widget 'message-header-lines 'text
   "All header lines must be LFD terminated."
@@ -855,6 +861,18 @@ The cdr of ech entry is a function for applying the face to a region.")
   :group 'message-various
   :type 'hook)
 
+(defcustom message-use-multi-frames nil
+  "Make new frame when sending messages."
+  :group 'message-frames
+  :type 'boolean)
+
+(defcustom message-delete-frame-on-exit nil
+  "Delete frame after sending messages."
+  :group 'message-frames
+  :type '(choice (const :tag "off" nil)
+		 (const :tag "always" t)
+		 (const :tag "ask" ask)))
+
 ;;; Internal variables.
 
 (defvar message-buffer-list nil)
@@ -1873,7 +1891,9 @@ The text will also be indented the normal way."
   "Send message like `message-send', then, if no errors, exit from mail buffer."
   (interactive "P")
   (let ((buf (current-buffer))
-	(actions message-exit-actions))
+	(actions message-exit-actions)
+	(frame (selected-frame))
+	(org-frame message-original-frame))
     (when (and (message-send arg)
 	       (buffer-name buf))
       (if message-kill-buffer-on-exit
@@ -1881,7 +1901,8 @@ The text will also be indented the normal way."
 	(bury-buffer buf)
 	(when (eq buf (current-buffer))
 	  (message-bury buf)))
-      (message-do-actions actions))))
+      (message-do-actions actions)
+      (message-delete-frame frame org-frame))))
 
 (defun message-dont-send ()
   "Don't send the message you have been editing."
@@ -1897,10 +1918,32 @@ The text will also be indented the normal way."
   (interactive)
   (when (or (not (buffer-modified-p))
 	    (yes-or-no-p "Message modified; kill anyway? "))
-    (let ((actions message-kill-actions))
+    (let ((actions message-kill-actions)
+	  (frame (selected-frame))
+	  (org-frame message-original-frame))
       (setq buffer-file-name nil)
       (kill-buffer (current-buffer))
-      (message-do-actions actions))))
+      (message-do-actions actions)
+      (message-delete-frame frame org-frame))))
+
+(defun message-delete-frame (frame org-frame)
+  "Delete frame for editing message."
+  (when (and (or (and (featurep 'xemacs)
+		      (not (eq 'tty (device-type))))
+		 window-system
+		 (>= emacs-major-version 20))
+	     (or (and (eq message-delete-frame-on-exit t)
+		      (select-frame frame)
+		      (or (eq frame org-frame)
+			  (prog1
+			      (y-or-n-p "Delete this frame?")
+			    (message ""))))
+		 (and (eq message-delete-frame-on-exit 'ask)
+		      (select-frame frame)
+		      (prog1
+			  (y-or-n-p "Delete this frame?")
+			(message "")))))
+    (delete-frame frame)))
 
 (defun message-bury (buffer)
   "Bury this mail buffer."
@@ -3293,8 +3336,24 @@ Headers already prepared in the buffer are not modified."
 
 (defun message-pop-to-buffer (name)
   "Pop to buffer NAME, and warn if it already exists and is modified."
-  (let ((buffer (get-buffer name))
+  (let ((pop-up-frames pop-up-frames)
+	(special-display-buffer-names special-display-buffer-names)
+	(special-display-regexps special-display-regexps)
+	(same-window-buffer-names same-window-buffer-names)
+	(same-window-regexps same-window-regexps)
+	(buffer (get-buffer name))
 	(cur (current-buffer)))
+    (if (or (and (featurep 'xemacs)
+		 (not (eq 'tty (device-type))))
+	    window-system
+	    (>= emacs-major-version 20))
+	(when message-use-multi-frames
+	  (setq pop-up-frames t
+		special-display-buffer-names nil
+		special-display-regexps nil
+		same-window-buffer-names nil
+		same-window-regexps nil))
+      (setq pop-up-frames nil))
     (if (and buffer
 	     (buffer-name buffer))
 	(progn
@@ -3305,7 +3364,10 @@ Headers already prepared in the buffer are not modified."
 	    (error "Message being composed")))
       (set-buffer (pop-to-buffer name)))
     (erase-buffer)
-    (message-mode)))
+    (message-mode)
+    (when pop-up-frames
+      (make-local-variable 'message-original-frame)
+      (setq message-original-frame (selected-frame)))))
 
 (defun message-do-send-housekeeping ()
   "Kill old message buffers."