(nnmaildir-request-set-mark): Add article to add-mark funcall.
[gnus] / lisp / message.el
index 40c4577..8a729f6 100644 (file)
@@ -29,6 +29,7 @@
 
 ;;; Code:
 
+;; For Emacs <22.2 and XEmacs.
 (eval-and-compile
   (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
 (eval-when-compile
@@ -160,6 +161,10 @@ If this variable is nil, no such courtesy message will be added."
   :type 'regexp)
 
 (defcustom message-from-style 'default
+  ;; In Emacs 24.1 this defaults to the value of `mail-from-style'
+  ;; that defaults to:
+  ;; `angles' in Emacs 22.1~23.1, XEmacs 21.4, 21.5, and SXEmacs 22.1;
+  ;; `default' in Emacs 23.2, and 24.1
   "*Specifies how \"From\" headers look.
 
 If nil, they contain just the return address like:
@@ -283,7 +288,7 @@ This is a list of regexps and regexp matches."
   :link '(custom-manual "(message)Mail Headers")
   :type 'regexp)
 
-(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-ID:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:\\|^X-Payment:\\|^Approved:"
+(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-ID:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:\\|^X-Payment:\\|^Approved:\\|^Injection-Date:\\|^Injection-Info:"
   "*Header lines matching this regexp will be deleted before posting.
 It's best to delete old Path and Date headers before posting to avoid
 any confusion."
@@ -305,7 +310,7 @@ any confusion."
 
 ;;; Start of variables adopted from `message-utils.el'.
 
-(defcustom message-subject-trailing-was-query 'ask
+(defcustom message-subject-trailing-was-query t
   "*What to do with trailing \"(was: <old subject>)\" in subject lines.
 If nil, leave the subject unchanged.  If it is the symbol `ask', query
 the user what do do.  In this case, the subject is matched against
@@ -313,7 +318,7 @@ the user what do do.  In this case, the subject is matched against
 `message-subject-trailing-was-query' is t, always strip the trailing
 old subject.  In this case, `message-subject-trailing-was-regexp' is
 used."
-  :version "22.1"
+  :version "24.1"
   :type '(choice (const :tag "never" nil)
                 (const :tag "always strip" t)
                 (const ask))
@@ -321,7 +326,7 @@ used."
   :group 'message-various)
 
 (defcustom message-subject-trailing-was-ask-regexp
-  "[ \t]*\\([[(]+[Ww][Aa][Ss][ \t]*.*[\])]+\\)"
+  "[ \t]*\\([[(]+[Ww][Aa][Ss]:?[ \t]*.*[])]+\\)"
   "*Regexp matching \"(was: <old subject>)\" in the subject line.
 
 The function `message-strip-subject-trailing-was' uses this regexp if
@@ -444,6 +449,10 @@ whitespace)."
   :group 'message-various)
 
 (defcustom message-interactive t
+  ;; In Emacs 24.1 this defaults to the value of `mail-interactive'
+  ;; that defaults to:
+  ;; `nil' in Emacs 22.1~22.3, XEmacs 21.4, 21.5, and SXEmacs 22.1;
+  ;; `t' in Emacs 23.1~24.1
   "Non-nil means when sending a message wait for and display errors.
 A value of nil means let mailer mail back a message to report errors."
   :version "23.2"
@@ -622,27 +631,25 @@ Done before generating the new subject of a forward."
   :type 'regexp)
 
 (defcustom message-cite-prefix-regexp
-  ;; Default to the value of `mail-citation-prefix-regexp' if available.
-  ;; Note: as for XEmacs 21.4 and 21.5, it is unavailable unless sendmail.el
-  ;; is loaded.
-  (cond ((boundp 'mail-citation-prefix-regexp)
-        mail-citation-prefix-regexp)
-       ((string-match "[[:digit:]]" "1")
-        ;; Support POSIX?  XEmacs 21.5.27 doesn't.
-        "\\([ \t]*[_.[:word:]]+>+\\|[ \t]*[]>|}]\\)+")
-       (t
-        ;; ?-, ?_ or ?. MUST NOT be in syntax entry w.
-        (let (non-word-constituents)
-          (with-syntax-table text-mode-syntax-table
-            (setq non-word-constituents
-                  (concat
-                   (if (string-match "\\w" "_")  "" "_")
-                   (if (string-match "\\w" ".")  "" "."))))
-          (if (equal non-word-constituents "")
-              "\\([ \t]*\\(\\w\\)+>+\\|[ \t]*[]>|}]\\)+"
-            (concat "\\([ \t]*\\(\\w\\|["
-                    non-word-constituents
-                    "]\\)+>+\\|[ \t]*[]>|}]\\)+")))))
+  ;; In Emacs 24.1 this defaults to the value of
+  ;; `mail-citation-prefix-regexp'; the default value varies according
+  ;; to the Emacs version.  In XEmacs 21.4 and 21.5, sendmail.el
+  ;; provides it.
+  (if (string-match "[[:digit:]]" "1")
+      ;; Support POSIX?  XEmacs 21.5.27 doesn't.
+      "\\([ \t]*[_.[:word:]]+>+\\|[ \t]*[]>|]\\)+"
+    ;; ?-, ?_ or ?. MUST NOT be in syntax entry w.
+    (let (non-word-constituents)
+      (with-syntax-table text-mode-syntax-table
+       (setq non-word-constituents
+             (concat
+              (if (string-match "\\w" "_")  "" "_")
+              (if (string-match "\\w" ".")  "" "."))))
+      (if (equal non-word-constituents "")
+         "\\([ \t]*\\(\\w\\)+>+\\|[ \t]*[]>|]\\)+"
+       (concat "\\([ \t]*\\(\\w\\|["
+               non-word-constituents
+               "]\\)+>+\\|[ \t]*[]>|]\\)+"))))
   "*Regexp matching the longest possible citation prefix on a line."
   :version "24.1"
   :group 'message-insertion
@@ -836,6 +843,9 @@ Doing so would be even more evil than leaving it out."
   :type 'boolean)
 
 (defcustom message-sendmail-envelope-from nil
+  ;; In Emacs 24.1 this defaults to the value of `mail-envelope-from'
+  ;; if it is available, or defaults to nil.  sendmail.el provides it;
+  ;; the default value is nil in all (X)Emacsen that Gnus supports.
   "*Envelope-from when sending mail with sendmail.
 If this is nil, use `user-mail-address'.  If it is the symbol
 `header', use the From: header of the message."
@@ -1013,6 +1023,10 @@ Please also read the note in the documentation of
   :group 'message-insertion)
 
 (defcustom message-yank-prefix "> "
+  ;; In Emacs 24.1 this defaults to the value of `mail-yank-prefix'
+  ;; that defaults to:
+  ;; `nil' in Emacs 22.1~23.1;
+  ;; "> " in Emacs 23.2, 24.1, XEmacs 21.4, 21.5, and SXEmacs 22.1
   "*Prefix inserted on the lines of yanked messages.
 Fix `message-cite-prefix-regexp' if it is set to an abnormal value.
 See also `message-yank-cited-prefix' and `message-yank-empty-prefix'."
@@ -1039,6 +1053,10 @@ See also `message-yank-prefix' and `message-yank-cited-prefix'."
   :group 'message-insertion)
 
 (defcustom message-indentation-spaces 3
+  ;; In Emacs 24.1 this defaults to the value of
+  ;; `mail-indentation-spaces' that defaults to `3' in Emacs 22.1~24.1,
+  ;; and SXEmacs 22.1.  In XEmacs 21.4 and 21.5, sendmail.el provides
+  ;; it; the defalut value is `3'.
   "*Number of spaces to insert at the beginning of each cited line.
 Used by `message-yank-original' via `message-yank-cite'."
   :version "23.2"
@@ -1069,6 +1087,10 @@ point and mark around the citation text as modified."
   :group 'message-insertion)
 
 (defcustom message-signature t
+  ;; In Emacs 24.1 this defaults to the value of `mail-signature' that
+  ;; defaults to:
+  ;; `nil' in Emacs 22.1~23.1, XEmacs 21.4, 21.5, and SXEmacs 22.1;
+  ;; `t' in Emacs 23.2, and 24.1
   "*String to be inserted at the end of the message buffer.
 If t, the `message-signature-file' file will be inserted instead.
 If a function, the result from the function will be used instead.
@@ -1079,6 +1101,10 @@ If a form, the result from the form will be used instead."
   :group 'message-insertion)
 
 (defcustom message-signature-file "~/.signature"
+  ;; In Emacs 24.1 this defaults to the value of `mail-signature-file'
+  ;; that defaults to "~/.signature" in Emacs 22.1~24.1, and SXEmacs
+  ;; 22.1.  In XEmacs 21.4 and 21.5, sendmail.el provides it;
+  ;; the defalut value is "~/.signature".
   "*Name of file containing the text inserted at end of message buffer.
 Ignored if the named file doesn't exist.
 If nil, don't insert a signature.
@@ -1157,13 +1183,17 @@ It is a vector of the following headers:
   :error "All header lines must be newline terminated")
 
 (defcustom message-default-headers ""
-  "*A string containing header lines to be inserted in outgoing messages.
-It is inserted before you edit the message, so you can edit or delete
-these lines."
+  "Header lines to be inserted in outgoing messages.
+This can be set to a string containing or a function returning
+header lines to be inserted before you edit the message, so you
+can edit or delete these lines.  If set to a function, it is
+called and its result is inserted."
   :version "23.2"
   :group 'message-headers
   :link '(custom-manual "(message)Message Headers")
-  :type 'message-header-lines)
+  :type '(choice
+          (message-header-lines :tag "String")
+          (function :tag "Function")))
 
 (defcustom message-default-mail-headers
   ;; Ease the transition from mail-mode to message-mode.  See bugs#4431, 5555.
@@ -1177,8 +1207,8 @@ these lines."
                   (stringp mail-archive-file-name))
              (format "FCC: %s\n" mail-archive-file-name))
          ;; Use the value of `mail-default-headers' if available.
-         ;; Note: as for Emacs 21, XEmacs 21.4 and 21.5, it is
-         ;; unavailable unless sendmail.el is loaded.
+         ;; Note: as for XEmacs 21.4 and 21.5, it is unavailable
+         ;; unless sendmail.el is loaded.
          (if (boundp 'mail-default-headers)
              mail-default-headers))
   "*A string of header lines to be inserted in outgoing mails."
@@ -2170,7 +2200,6 @@ Leading \"Re: \" is not stripped by this function.  Use the function
 
 (defun message-change-subject (new-subject)
   "Ask for NEW-SUBJECT header, append (was: <Old Subject>)."
-  ;; <URL:http://www.landfield.com/usefor/drafts/draft-ietf-usefor-useage--1.02.unpaged>
   (interactive
    (list
     (read-from-minibuffer "New subject: ")))
@@ -2658,7 +2687,6 @@ PGG manual, depending on the value of `mml2015-use'."
 
   (define-key message-mode-map "\C-a" 'message-beginning-of-line)
   (define-key message-mode-map "\t" 'message-tab)
-  (define-key message-mode-map "\M-;" 'comment-region)
 
   (define-key message-mode-map "\M-n" 'message-display-abbrev))
 
@@ -3063,10 +3091,22 @@ M-RET    `message-newline-and-reformat' (break the line and reformat)."
   (interactive)
   (message-position-on-field "Summary" "Subject"))
 
-(defun message-goto-body (&optional interactivep)
+(eval-when-compile
+  (defmacro message-called-interactively-p (kind)
+    (condition-case nil
+       (progn
+         (eval '(called-interactively-p 'any))
+         ;; Emacs >=23.2
+         `(called-interactively-p ,kind))
+      ;; Emacs <23.2
+      (wrong-number-of-arguments '(called-interactively-p))
+      ;; XEmacs
+      (void-function '(interactive-p)))))
+
+(defun message-goto-body ()
   "Move point to the beginning of the message body."
-  (interactive (list t))
-  (when (and interactivep
+  (interactive)
+  (when (and (message-called-interactively-p 'any)
             (looking-at "[ \t]*\n"))
     (expand-abbrev))
   (goto-char (point-min))
@@ -3075,7 +3115,7 @@ M-RET    `message-newline-and-reformat' (break the line and reformat)."
 
 (defun message-in-body-p ()
   "Return t if point is in the message body."
-  (let ((body (save-excursion (message-goto-body) (point))))
+  (let ((body (save-excursion (message-goto-body))))
     (>= (point) body)))
 
 (defun message-goto-eoh ()
@@ -4225,7 +4265,7 @@ conformance."
                 (?r ,(format
                       "Replace non-printable characters with \"%s\" and send"
                       message-replacement-char))
-                (?i "Ignore non-printable characters and send")
+                (?s "Send as is without removing anything")
                 (?e "Continue editing"))))
        (if (eq choice ?e)
          (error "Non-printable characters"))
@@ -4498,6 +4538,8 @@ This function could be useful in `message-setup-hook'."
              (save-restriction
                (message-narrow-to-headers)
                (and news
+                    (not (message-fetch-field "List-Post"))
+                    (not (message-fetch-field "List-ID"))
                     (or (message-fetch-field "cc")
                         (message-fetch-field "bcc")
                         (message-fetch-field "to"))
@@ -4514,7 +4556,9 @@ This function could be useful in `message-setup-hook'."
                         (string= "base64"
                                  (message-fetch-field
                                   "content-transfer-encoding")))))))
-           (message-insert-courtesy-copy))
+           (message-insert-courtesy-copy
+            (with-current-buffer mailbuf
+              message-courtesy-message)))
           ;; Let's make sure we encoded all the body.
           (assert (save-excursion
                     (goto-char (point-min))
@@ -5755,7 +5799,9 @@ subscribed address (and not the additional To and Cc header contents)."
                (mapcar (lambda (rhs) (or (cadr (split-string rhs "@")) ""))
                        (mapcar 'downcase
                                (mapcar
-                                'cadr
+                                (lambda (elem)
+                                  (or (cadr elem)
+                                      ""))
                                 (mail-extract-address-components field t))))))
        ;; Note that `rhs' will be "" if the address does not have
        ;; the domain part, i.e., if it is a local user's address.
@@ -5953,7 +5999,7 @@ Headers already prepared in the buffer are not modified."
       ;; Check for IDNA
       (message-idna-to-ascii-rhs))))
 
-(defun message-insert-courtesy-copy ()
+(defun message-insert-courtesy-copy (message)
   "Insert a courtesy message in mail copies of combined messages."
   (let (newsgroups)
     (save-excursion
@@ -5963,12 +6009,12 @@ Headers already prepared in the buffer are not modified."
          (goto-char (point-max))
          (insert "Posted-To: " newsgroups "\n")))
       (forward-line 1)
-      (when message-courtesy-message
+      (when message
        (cond
-        ((string-match "%s" message-courtesy-message)
-         (insert (format message-courtesy-message newsgroups)))
+        ((string-match "%s" message)
+         (insert (format message newsgroups)))
         (t
-         (insert message-courtesy-message)))))))
+         (insert message)))))))
 
 ;;;
 ;;; Setting up a message buffer
@@ -6068,6 +6114,7 @@ If the current line has `message-yank-prefix', insert it on the new line."
 When sending via news, also check that the REFERENCES are less
 than 988 characters long, and if they are not, trim them until
 they are."
+  ;; 21 is the number suggested by USEAGE.
   (let ((maxcount 21)
        (count 0)
        (cut 2)
@@ -6379,7 +6426,10 @@ are not included."
    headers)
   (delete-region (point) (progn (forward-line -1) (point)))
   (when message-default-headers
-    (insert message-default-headers)
+    (insert
+     (if (functionp message-default-headers)
+         (funcall message-default-headers)
+       message-default-headers))
     (or (bolp) (insert ?\n)))
   (insert mail-header-separator "\n")
   (forward-line -1)
@@ -6584,6 +6634,10 @@ The function is called with one parameter, a cons cell ..."
     (save-match-data
       ;; Build (textual) list of new recipient addresses.
       (cond
+       (to-address
+       (setq recipients (concat ", " to-address))
+       ;; If the author explicitly asked for a copy, we don't deny it to them.
+       (if mct (setq recipients (concat recipients ", " mct))))
        ((not wide)
        (setq recipients (concat ", " author)))
        (address-headers
@@ -6619,10 +6673,6 @@ responses here are directed to other addresses.
 You may customize the variable `message-use-mail-followup-to', if you
 want to get rid of this query permanently.")))
        (setq recipients (concat ", " mft)))
-       (to-address
-       (setq recipients (concat ", " to-address))
-       ;; If the author explicitly asked for a copy, we don't deny it to them.
-       (if mct (setq recipients (concat recipients ", " mct))))
        (t
        (setq recipients (if never-mct "" (concat ", " author)))
        (if to (setq recipients (concat recipients ", " to)))
@@ -7438,7 +7488,11 @@ is for the internal use."
       (when (looking-at "From ")
        (replace-match "X-From-Line: "))
       ;; Send it.
-      (let ((message-inhibit-body-encoding t)
+      (let ((message-inhibit-body-encoding
+            ;; Don't do any further encoding if it looks like the
+            ;; message has already been encoded.
+            (let ((case-fold-search t))
+              (re-search-forward "^mime-version:" nil t)))
            (message-inhibit-ecomplete t)
            message-required-mail-headers
            message-generate-hashcash