(message-generate-new-buffers): Change the meaning of the nil value;

 add `standard' to the choices; treat t as `unique'; improve doc string.
(gnus-select-frame-set-input-focus): Autoload.
(message-buffer-name): Search for the existing message buffer if
 message-generate-new-buffers is nil or `standard';
 treat the value t of message-generate-new-buffers as `unique'.
(message-pop-to-buffer): Raise the frame already displaying the message buffer;
 clear the echo area after querying.
(message-setup): Pass the `continue' argument to compose-mail.
(message-mail): Prefer `switch-function' if it is given;
 search for the existing message buffer if the `continue' argument is non-nil;
 pass continue and switch-function arguments to compose-mail by way of
 message-setup.
(message-mail-other-window): Adjust argument of message-setup.
(message-mail-other-frame): Ditto.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 7fe8cee..f7fc2b8 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,22 @@
+2007-03-15  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+       * message.el (message-generate-new-buffers): Change the meaning of the
+       nil value; add `standard' to the choices; treat t as `unique'; improve
+       doc string.
+       (gnus-select-frame-set-input-focus): Autoload.
+       (message-buffer-name): Search for the existing message buffer if
+       message-generate-new-buffers is nil or `standard'; treat the value t of
+       message-generate-new-buffers as `unique'.
+       (message-pop-to-buffer): Raise the frame already displaying the message
+       buffer; clear the echo area after querying.
+       (message-setup): Pass the `continue' argument to compose-mail.
+       (message-mail): Prefer `switch-function' if it is given; search for the
+       existing message buffer if the `continue' argument is non-nil; pass
+       continue and switch-function arguments to compose-mail by way of
+       message-setup.
+       (message-mail-other-window): Adjust argument of message-setup.
+       (message-mail-other-frame): Ditto.
+
 2007-03-13  Katsumi Yamaoka  <yamaoka@jpl.org>
 
        * gnus-cite.el (font-lock-set-defaults): Autoload it for Emacs.

diff --git a/lisp/message.el b/lisp/message.el
index 5e085f8..16cb386 100644 (file)
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -429,16 +429,36 @@ nil means let mailer mail back a message to report errors."
   :type 'boolean)
 
 (defcustom message-generate-new-buffers 'unique
-  "*Non-nil means create a new message buffer whenever `message-setup' is called.
-If this is a function, call that function with three parameters:  The type,
-the to address and the group name.  (Any of these may be nil.)  The function
-should return the new buffer name."
+  "*Say whether to create a new message buffer to compose a message.
+Valid values include:
+
+nil
+  Generate the buffer name in the Message way (e.g., *mail*, *news*,
+  *mail to whom*, *news on group*, etc.) and continue editing in the
+  existing buffer of that name.  If there is no such buffer, it will
+  be newly created.
+
+`unique' or t
+  Create the new buffer with the name generated in the Message way.
+
+`unsent'
+  Similar to `unique' but the buffer name begins with \"*unsent \".
+
+`standard'
+  Similar to nil but the buffer name is simpler like *mail message*.
+
+function
+  If this is a function, call that function with three parameters:
+  The type, the To address and the group name (any of these may be nil).
+  The function should return the new buffer name."
   :group 'message-buffers
   :link '(custom-manual "(message)Message Buffers")
-  :type '(choice (const :tag "off" nil)
-                (const :tag "unique" unique)
-                (const :tag "unsent" unsent)
-                (function fun)))
+  :type '(choice (const nil)
+                (sexp :tag "unique" :format "unique\n" :value unique
+                      :match (lambda (widget value) (memq value '(unique t))))
+                (const unsent)
+                (const standard)
+                (function :format "\n    %{%t%}: %v")))
 
 (defcustom message-kill-buffer-on-exit nil
   "*Non-nil means that the message buffer will be killed after sending a message."
@@ -1745,6 +1765,7 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'."
   (autoload 'gnus-output-to-mail "gnus-util")
   (autoload 'gnus-output-to-rmail "gnus-util")
   (autoload 'gnus-request-post "gnus-int")
+  (autoload 'gnus-select-frame-set-input-focus "gnus-util")
   (autoload 'gnus-server-string "gnus")
   (autoload 'idna-to-ascii "idna")
   (autoload 'message-setup-toolbar "messagexmas")
@@ -5824,7 +5845,7 @@ between beginning of field and beginning of line."
   "Return a new (unique) buffer name based on TYPE and TO."
   (cond
    ;; Generate a new buffer name The Message Way.
-   ((eq message-generate-new-buffers 'unique)
+   ((memq message-generate-new-buffers '(unique t))
     (generate-new-buffer-name
      (concat "*" type
             (if to
@@ -5848,20 +5869,51 @@ between beginning of field and beginning of line."
               "")
             (if (and group (not (string= group ""))) (concat " on " group) "")
             "*")))
-   ;; Use standard name.
+   ;; Search for the existing message buffer with the specified name.
    (t
-    (format "*%s message*" type))))
+    (let* ((new (if (eq message-generate-new-buffers 'standard)
+                   (generate-new-buffer-name (concat "*" type " message*"))
+                 (let ((message-generate-new-buffers 'unique))
+                   (message-buffer-name type to group))))
+          (regexp (concat "\\`"
+                          (regexp-quote
+                           (if (string-match "<[0-9]+>\\'" new)
+                               (substring new 0 (match-beginning 0))
+                             new))
+                          "\\(?:<\\([0-9]+\\)>\\)?\\'"))
+          (case-fold-search nil))
+      (or (cdar
+          (last
+           (sort
+            (delq nil
+                  (mapcar
+                   (lambda (b)
+                     (when (and (string-match regexp (setq b (buffer-name b)))
+                                (eq (with-current-buffer b major-mode)
+                                    'message-mode))
+                       (cons (string-to-number (or (match-string 1 b) "1"))
+                             b)))
+                   (buffer-list)))
+            'car-less-than-car)))
+         new)))))
 
 (defun message-pop-to-buffer (name)
   "Pop to buffer NAME, and warn if it already exists and is modified."
   (let ((buffer (get-buffer name)))
     (if (and buffer
             (buffer-name buffer))
-       (progn
-         (set-buffer (pop-to-buffer buffer))
+       (let ((window (get-buffer-window buffer 0)))
+         (if window
+             ;; Raise the frame already displaying the message buffer.
+             (progn
+               (gnus-select-frame-set-input-focus (window-frame window))
+               (select-window window))
+           (set-buffer (pop-to-buffer buffer)))
          (when (and (buffer-modified-p)
-                    (not (y-or-n-p
-                          "Message already being composed; erase? ")))
+                    (not (prog1
+                             (y-or-n-p
+                              "Message already being composed; erase? ")
+                           (message nil))))
            (error "Message being composed")))
       (set-buffer (pop-to-buffer name)))
     (erase-buffer)
@@ -5921,7 +5973,8 @@ between beginning of field and beginning of line."
        nil
       mua)))
 
-(defun message-setup (headers &optional replybuffer actions switch-function)
+(defun message-setup (headers &optional replybuffer actions
+                             continue switch-function)
   (let ((mua (message-mail-user-agent))
        subject to field yank-action)
     (if (not (and message-this-is-mail mua))
@@ -5944,7 +5997,7 @@ between beginning of field and beginning of line."
                                 (format "%s" (car item))
                                 (cdr item)))
                              headers)
-                     nil switch-function yank-action actions)))))
+                     continue switch-function yank-action actions)))))
 
 (defun message-headers-to-generate (headers included-headers excluded-headers)
   "Return a list that includes all headers from HEADERS.
@@ -6091,11 +6144,21 @@ are not included."
                               other-headers continue switch-function
                               yank-action send-actions)
   "Start editing a mail message to be sent.
-OTHER-HEADERS is an alist of header/value pairs."
+OTHER-HEADERS is an alist of header/value pairs.  CONTINUE says whether
+to continue editing a message already being composed.  SWITCH-FUNCTION
+is a function used to switch to and display the mail buffer."
   (interactive)
   (let ((message-this-is-mail t) replybuffer)
     (unless (message-mail-user-agent)
-      (message-pop-to-buffer (message-buffer-name "mail" to)))
+      (funcall
+       (or switch-function 'message-pop-to-buffer)
+       ;; Search for the existing message buffer if `continue' is non-nil.
+       (let ((message-generate-new-buffers
+             (when (or (not continue)
+                       (eq message-generate-new-buffers 'standard)
+                       (functionp message-generate-new-buffers))
+               message-generate-new-buffers)))
+        (message-buffer-name "mail" to))))
     ;; FIXME: message-mail should do something if YANK-ACTION is not
     ;; insert-buffer.
     (and (consp yank-action) (eq (car yank-action) 'insert-buffer)
@@ -6104,7 +6167,7 @@ OTHER-HEADERS is an alist of header/value pairs."
      (nconc
       `((To . ,(or to "")) (Subject . ,(or subject "")))
       (when other-headers other-headers))
-     replybuffer send-actions)
+     replybuffer send-actions continue switch-function)
     ;; FIXME: Should return nil if failure.
     t))
 
@@ -7043,7 +7106,7 @@ you."
       (message-pop-to-buffer (message-buffer-name "mail" to))))
   (let ((message-this-is-mail t))
     (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))
-                  nil nil 'switch-to-buffer-other-window)))
+                  nil nil nil 'switch-to-buffer-other-window)))
 
 ;;;###autoload
 (defun message-mail-other-frame (&optional to subject)
@@ -7058,7 +7121,7 @@ you."
       (message-pop-to-buffer (message-buffer-name "mail" to))))
   (let ((message-this-is-mail t))
     (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))
-                  nil nil 'switch-to-buffer-other-frame)))
+                  nil nil nil 'switch-to-buffer-other-frame)))
 
 ;;;###autoload
 (defun message-news-other-window (&optional newsgroups subject)