Apply patch by Keiichi Suzuki to message.el to treat message on other frame.
authorichikawa <ichikawa>
Thu, 13 Aug 1998 02:48:34 +0000 (02:48 +0000)
committerichikawa <ichikawa>
Thu, 13 Aug 1998 02:48:34 +0000 (02:48 +0000)
lisp/message.el

index 06d0ffb..730c7f9 100644 (file)
@@ -4,6 +4,7 @@
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;         MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;;         Shuhei KOBAYASHI <shuhei-k@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
@@ -626,6 +631,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."
@@ -917,6 +923,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)
@@ -1949,7 +1967,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
@@ -1957,7 +1977,26 @@ 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-delete-frame (frame org-frame)
+  "Delete frame for editing message."
+  (when (and (or (and (featurep 'xemacs)
+                     (not (eq 'tty (device-type))))
+                window-system)
+            (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-dont-send ()
   "Don't send the message you have been editing."
@@ -1973,10 +2012,13 @@ 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-bury (buffer)
   "Bury this mail buffer."
@@ -3251,8 +3293,23 @@ 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)
+       (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
@@ -3263,7 +3320,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."