(message-frames): New custom group.
authorkeiichi <keiichi>
Thu, 20 Aug 1998 01:18:11 +0000 (01:18 +0000)
committerkeiichi <keiichi>
Thu, 20 Aug 1998 01:18:11 +0000 (01:18 +0000)
(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.

lisp/message.el

index 8eca692..ab9ef0a 100644 (file)
@@ -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.
   :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."