2010-02-24 Glenn Morris <rgm@gnu.org>

[gnus] / lisp / message.el

diff --git a/lisp/message.el b/lisp/message.el
index 6e15b4f..21fb83a 100644 (file)
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -1,7 +1,7 @@
 ;;; message.el --- composing mail and news messages
 
 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+;;   2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: mail, news
@@ -1106,6 +1106,8 @@ If stringp, use this; if non-nil, use no host name (user name only)."
                 (string :tag "name")
                 (sexp :tag "none" :format "%t" t)))
 
+;; This can be the name of a buffer, or a cons cell (FUNCTION . ARGS)
+;; for yanking the original buffer.
 (defvar message-reply-buffer nil)
 (defvar message-reply-headers nil
   "The headers of the current replied article.
@@ -1138,8 +1140,22 @@ these lines."
   :link '(custom-manual "(message)Message Headers")
   :type 'message-header-lines)
 
-(defcustom message-default-mail-headers ""
+(defcustom message-default-mail-headers
+  ;; Ease the transition from mail-mode to message-mode.  See bugs#4431, 5555.
+  (concat (if (and (boundp 'mail-default-reply-to)
+                  (stringp mail-default-reply-to))
+             (format "Reply-to: %s\n" mail-default-reply-to)
+           "")
+         (if (and (boundp 'mail-self-blind)
+                  mail-self-blind)
+             (format "BCC: %s\n" user-mail-address)
+           "")
+         (if (and (boundp 'mail-archive-file-name)
+                  (stringp mail-archive-file-name))
+             (format "FCC: %s\n" mail-archive-file-name)
+           ""))
   "*A string of header lines to be inserted in outgoing mails."
+  :version "23.2"
   :group 'message-headers
   :group 'message-mail
   :link '(custom-manual "(message)Mail Headers")
@@ -1959,7 +1975,7 @@ see `message-narrow-to-headers-or-head'."
 
 (defmacro message-with-reply-buffer (&rest forms)
   "Evaluate FORMS in the reply buffer, if it exists."
-  `(when (and message-reply-buffer
+  `(when (and (bufferp message-reply-buffer)
              (buffer-name message-reply-buffer))
      (with-current-buffer message-reply-buffer
        ,@forms)))
@@ -2728,7 +2744,7 @@ PGG manual, depending on the value of `mml2015-use'."
 ;;; Forbidden properties
 ;;
 ;; We use `after-change-functions' to keep special text properties
-;; that interfer with the normal function of message mode out of the
+;; that interfere with the normal function of message mode out of the
 ;; buffer.
 
 (defcustom message-strip-special-text-properties t
@@ -3141,7 +3157,7 @@ or in the synonym headers, defined by `message-header-synonyms'."
   "Widen the reply to include maximum recipients."
   (interactive)
   (let ((follow-to
-        (and message-reply-buffer
+        (and (bufferp message-reply-buffer)
              (buffer-name message-reply-buffer)
              (with-current-buffer message-reply-buffer
                (message-get-reply-headers t)))))
@@ -3636,9 +3652,16 @@ Really top post? ")))
                                      (point-max)))
              (delete-region (message-goto-body) (point-max)))
          (set (make-local-variable 'message-cite-reply-above) nil)))
-      (delete-windows-on message-reply-buffer t)
+      (if (bufferp message-reply-buffer)
+         (delete-windows-on message-reply-buffer t))
       (push-mark (save-excursion
-                  (insert-buffer-substring message-reply-buffer)
+                  (cond
+                   ((bufferp message-reply-buffer)
+                    (insert-buffer-substring message-reply-buffer))
+                   ((and (consp message-reply-buffer)
+                         (functionp (car message-reply-buffer)))
+                    (apply (car message-reply-buffer)
+                           (cdr message-reply-buffer))))
                   (unless (bolp)
                     (insert ?\n))
                   (point)))
@@ -4623,17 +4646,17 @@ to find out how to use this."
 
 (defun message-smtpmail-send-it ()
   "Send the prepared message buffer with `smtpmail-send-it'.
-This only differs from `smtpmail-send-it' that this command evaluates
-`message-send-mail-hook' just before sending a message.  It is useful
-if your ISP requires the POP-before-SMTP authentication.  See the Gnus
-manual for details."
+The only difference from `smtpmail-send-it' is that this command
+evaluates `message-send-mail-hook' just before sending a message.
+It is useful if your ISP requires the POP-before-SMTP
+authentication.  See the Gnus manual for details."
   (run-hooks 'message-send-mail-hook)
   (smtpmail-send-it))
 
 (defun message-send-mail-with-mailclient ()
   "Send the prepared message buffer with `mailclient-send-it'.
-This only differs from `smtpmail-send-it' that this command evaluates
-`message-send-mail-hook' just before sending a message."
+The only difference from `mailclient-send-it' is that this
+command evaluates `message-send-mail-hook' just before sending a message."
   (run-hooks 'message-send-mail-hook)
   (mailclient-send-it))
 
@@ -5039,7 +5062,8 @@ Otherwise, generate and save a value for `canlock-password' first."
          "Denied posting -- the From looks strange: \"%s\"." from)
         nil)
        ((let ((addresses (rfc822-addresses from)))
-          (while (and addresses
+          ;; `rfc822-addresses' returns a string if parsing fails.
+          (while (and (consp addresses)
                       (not (eq (string-to-char (car addresses)) ?\()))
             (setq addresses (cdr addresses)))
           addresses)
@@ -6212,14 +6236,14 @@ between beginning of field and beginning of line."
        nil
       mua)))
 
-(defun message-setup (headers &optional replybuffer actions
+;; YANK-ACTION, if non-nil, can be a buffer or a yank action of the
+;; form (FUNCTION . ARGS).
+(defun message-setup (headers &optional yank-action actions
                              continue switch-function)
   (let ((mua (message-mail-user-agent))
-       subject to field yank-action)
+       subject to field)
     (if (not (and message-this-is-mail mua))
-       (message-setup-1 headers replybuffer actions)
-      (if replybuffer
-         (setq yank-action (list 'insert-buffer replybuffer)))
+       (message-setup-1 headers yank-action actions)
       (setq headers (copy-sequence headers))
       (setq field (assq 'Subject headers))
       (when field
@@ -6236,7 +6260,11 @@ between beginning of field and beginning of line."
                                 (format "%s" (car item))
                                 (cdr item)))
                              headers)
-                     continue switch-function yank-action actions)))))
+                     continue switch-function
+                     (if (bufferp yank-action)
+                         (list 'insert-buffer yank-action)
+                       yank-action)
+                     actions)))))
 
 (defun message-headers-to-generate (headers included-headers excluded-headers)
   "Return a list that includes all headers from HEADERS.
@@ -6263,12 +6291,16 @@ are not included."
        (push header result)))
     (nreverse result)))
 
-(defun message-setup-1 (headers &optional replybuffer actions)
+(defun message-setup-1 (headers &optional yank-action actions)
   (dolist (action actions)
     (condition-case nil
        (add-to-list 'message-send-actions
                     `(apply ',(car action) ',(cdr action)))))
-  (setq message-reply-buffer replybuffer)
+  (setq message-reply-buffer
+       (if (and (consp yank-action)
+                (eq (car yank-action) 'insert-buffer))
+           (nth 1 yank-action)
+         yank-action))
   (goto-char (point-min))
   ;; Insert all the headers.
   (mail-header-format
@@ -6399,7 +6431,7 @@ 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)
+  (let ((message-this-is-mail t))
     (unless (message-mail-user-agent)
       (message-pop-to-buffer
        ;; Search for the existing message buffer if `continue' is non-nil.
@@ -6410,15 +6442,11 @@ is a function used to switch to and display the mail buffer."
                message-generate-new-buffers)))
         (message-buffer-name "mail" to))
        switch-function))
-    ;; FIXME: message-mail should do something if YANK-ACTION is not
-    ;; insert-buffer.
-    (and (consp yank-action) (eq (car yank-action) 'insert-buffer)
-        (setq replybuffer (nth 1 yank-action)))
     (message-setup
      (nconc
       `((To . ,(or to "")) (Subject . ,(or subject "")))
       (when other-headers other-headers))
-     replybuffer send-actions continue switch-function)
+     yank-action send-actions continue switch-function)
     ;; FIXME: Should return nil if failure.
     t))
 
@@ -7467,10 +7495,8 @@ which specify the range to operate on."
 
 (defun message-exchange-point-and-mark ()
   "Exchange point and mark, but don't activate region if it was inactive."
-  (unless (prog1
-             (message-mark-active-p)
-           (exchange-point-and-mark))
-    (setq mark-active nil)))
+  (goto-char (prog1 (mark t)
+              (set-marker (mark-marker) (point)))))
 
 (defalias 'message-make-overlay 'make-overlay)
 (defalias 'message-delete-overlay 'delete-overlay)