Synch to No Gnus 200501120840.
[elisp/gnus.git-] / lisp / message.el
index e3d2f18..55d5f2d 100644 (file)
@@ -170,7 +170,7 @@ If the string contains the format spec \"%s\", the Newsgroups
 the article has been posted to will be inserted there.
 If this variable is nil, no such courtesy message will be added."
   :group 'message-sending
-  :type '(radio (string :format "%t: %v\n" :size 0) (const nil)))
+  :type '(radio string (const nil)))
 
 (defcustom message-ignored-bounced-headers
   "^\\(Received\\|Return-Path\\|Delivered-To\\):"
@@ -266,8 +266,7 @@ Archives \(such as groups.google.com\) respect this header."
   "Note to insert why you wouldn't want this posting archived.
 If nil, don't insert any text in the body."
   :version "21.4"
-  :type '(radio (string :format "%t: %v\n" :size 0)
-               (const nil))
+  :type '(radio string (const nil))
   :link '(custom-manual "(message)Header Commands")
   :group 'message-various)
 
@@ -773,6 +772,12 @@ and respond with new To and Cc headers."
   :link '(custom-manual "(message)Followup")
   :type '(choice function (const nil)))
 
+(defcustom message-extra-wide-headers nil
+  "If non-nil, a list of additional address headers.
+These are used when composing a wide reply."
+  :group 'message-sending
+  :type '(repeat string))
+
 (defcustom message-use-followup-to 'ask
   "*Specifies what to do with Followup-To header.
 If nil, always ignore the header.  If it is t, use its value, but
@@ -844,8 +849,7 @@ non-nil, each line of this file should be a mailing list address."
   :version "21.4"
   :group 'message-interface
   :link '(custom-manual "(message)Mailing Lists")
-  :type '(radio (file :format "%t: %v\n" :size 0)
-               (const nil)))
+  :type '(radio file (const nil)))
 
 (defcustom message-subscribed-addresses nil
   "*Specifies a list of addresses the user is subscribed to.
@@ -1306,14 +1310,22 @@ candidates:
   (or (not (listp message-shoot-gnksa-feet))
       (memq feature message-shoot-gnksa-feet)))
 
-(defcustom message-hidden-headers nil
+(defcustom message-hidden-headers "^References:"
   "Regexp of headers to be hidden when composing new messages.
 This can also be a list of regexps to match headers.  Or a list
 starting with `not' and followed by regexps."
   :version "21.4"
   :group 'message
   :link '(custom-manual "(message)Message Headers")
-  :type '(repeat regexp))
+  :type '(choice
+         :format "%{%t%}: %[Value Type%] %v"
+         (regexp :menu-tag "regexp" :format "regexp\n%t: %v")
+         (repeat :menu-tag "(regexp ...)" :format "(regexp ...)\n%v%i"
+                 (regexp :format "%t: %v"))
+         (cons :menu-tag "(not regexp ...)" :format "(not regexp ...)\n%v"
+               (const not)
+               (repeat :format "%v%i"
+                       (regexp :format "%t: %v")))))
 
 (defcustom message-cite-articles-with-x-no-archive t
   "If non-nil, cite text from articles that has X-No-Archive set."
@@ -1645,7 +1657,7 @@ no, only reply back to the author."
   :group 'message-headers
   :link '(custom-manual "(message)News Headers")
   :type '(radio (const :format "%v  " nil)
-               (string :format "FQDN: %v\n" :size 0)))
+               (string :format "FQDN: %v")))
 
 (defcustom message-use-idna (and (condition-case nil (require 'idna)
                                   (file-error))
@@ -1756,7 +1768,8 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'."
   "Alist of header names/filler functions.")
 
 (defvar message-header-format-alist
-  `((Newsgroups)
+  `((From)
+    (Newsgroups)
     (To)
     (Cc)
     (Subject)
@@ -2653,7 +2666,7 @@ message composition doesn't break too bad."
   ;; fontified: is used by font-lock.
   ;; syntax-table, local-map: I dunno.
   ;; We need to add XEmacs names to the list.
-  "Property list of with properties.forbidden in message buffers.
+  "Property list of with properties forbidden in message buffers.
 The values of the properties are ignored, only the property names are used.")
 
 (defun message-tamago-not-in-use-p (pos)
@@ -2674,16 +2687,13 @@ These properties are essential to work, so we should never strip them."
   "Strip forbidden properties between BEGIN and END, ignoring the third arg.
 This function is intended to be called from `after-change-functions'.
 See also `message-forbidden-properties'."
-  (let ((buffer-read-only nil)
-       (inhibit-read-only t))
-    (when (and message-strip-special-text-properties
-              (message-tamago-not-in-use-p begin)
-              ;; Check whether the invisible MIME part is not inserted.
-              (not (text-property-any begin end 'mime-edit-invisible t)))
-      (dolist (from-to (message-text-with-property 'message-hidden
-                                                  begin end t))
-       (remove-text-properties (car from-to) (cdr from-to)
-                               message-forbidden-properties)))))
+  (when (and message-strip-special-text-properties
+            (message-tamago-not-in-use-p begin)
+            ;; Check whether the invisible MIME part is not inserted.
+            (not (text-property-any begin end 'mime-edit-invisible t)))
+    (let ((buffer-read-only nil)
+         (inhibit-read-only t))
+      (remove-text-properties begin end message-forbidden-properties))))
 
 ;;;###autoload
 (define-derived-mode message-mode text-mode "Message"
@@ -4009,9 +4019,9 @@ not have PROP."
   (unless (bolp)
     (insert "\n"))
   ;; Make the hidden headers visible.
-  (dolist (from-to (message-text-with-property 'message-hidden))
-    (add-text-properties (car from-to) (cdr from-to)
-                        '(invisible nil intangible nil)))
+  (widen)
+  ;; Sort headers before sending the message.
+  (message-sort-headers)
   ;; Make invisible text visible except for mime parts which may be
   ;; inserted by the MIME-Edit.
   ;; It doesn't seem as if this is useful, since the invisible property
@@ -6291,7 +6301,7 @@ OTHER-HEADERS is an alist of header/value pairs."
                     (Subject . ,(or subject ""))))))
 
 (defun message-get-reply-headers (wide &optional to-address address-headers)
-  (let (follow-to mct never-mct to cc author mft recipients)
+  (let (follow-to mct never-mct to cc author mft recipients extra)
     ;; Find all relevant headers we need.
     (save-restriction
       (message-narrow-to-headers-or-head)
@@ -6302,10 +6312,15 @@ OTHER-HEADERS is an alist of header/value pairs."
        ;; message-header-synonyms.
        (setq to (or (message-fetch-field "to")
                     (and (loop for synonym in message-header-synonyms
-                           when (memq 'Original-To synonym)
-                           return t)
+                               when (memq 'Original-To synonym)
+                               return t)
                          (message-fetch-field "original-to")))
              cc (message-fetch-field "cc")
+             extra (when message-extra-wide-headers
+                     (mapconcat 'identity
+                                (mapcar 'message-fetch-field
+                                        message-extra-wide-headers)
+                                ", "))
              mct (when message-use-mail-copies-to
                    (message-fetch-field "mail-copies-to"))
              author (or mrt
@@ -6392,8 +6407,9 @@ responses here are directed to other addresses.")))
        (if mct (setq recipients (concat recipients ", " mct))))
        (t
        (setq recipients (if never-mct "" (concat ", " author)))
-       (if to  (setq recipients (concat recipients ", " to)))
-       (if cc  (setq recipients (concat recipients ", " cc)))
+       (if to (setq recipients (concat recipients ", " to)))
+       (if cc (setq recipients (concat recipients ", " cc)))
+       (if extra (setq recipients (concat recipients ", " extra)))
        (if mct (setq recipients (concat recipients ", " mct)))))
       (if (>= (length recipients) 2)
          ;; Strip the leading ", ".
@@ -6949,8 +6965,7 @@ Optional NEWS will use news to forward instead of mail."
     (setq e (point))
     (insert
      "\n-------------------- End of forwarded message --------------------\n")
-    (when (and (not current-prefix-arg)
-              message-forward-ignored-headers)
+    (when message-forward-ignored-headers
       (save-restriction
        (narrow-to-region b e)
        (goto-char b)
@@ -6996,7 +7011,7 @@ Optional NEWS will use news to forward instead of mail."
        (goto-char (point-max))))
     (setq e (point))
     (insert "<#/mml>\n")
-    (when (and (not current-prefix-arg)
+    (when (and (not message-forward-decoded-p)
               message-forward-ignored-headers)
       (save-restriction
        (narrow-to-region b e)
@@ -7399,7 +7414,7 @@ This variable is semi-obsolete, set it as nil and use
                (function-item :format "eudc: %v\n" eudc-expand-inline)
                (function-item :format "bbdb: %v\n" bbdb-complete-name)
                (function-item :format "lsdb: %v\n" lsdb-complete-name)
-               (function :size 0 :value expand-abbrev)))
+               (function :value expand-abbrev)))
 
 (defcustom message-tab-body-function nil
   "*Function to execute when `message-tab' (TAB) is executed in the body.
@@ -7694,7 +7709,8 @@ regexp VARSTR."
                     (list message-hidden-headers)
                   message-hidden-headers))
        (inhibit-point-motion-hooks t)
-       (after-change-functions nil))
+       (after-change-functions nil)
+       (end-of-headers 0))
     (when regexps
       (save-excursion
        (save-restriction
@@ -7703,11 +7719,17 @@ regexp VARSTR."
          (while (not (eobp))
            (if (not (message-hide-header-p regexps))
                (message-next-header)
-             (let ((begin (point)))
+             (let ((begin (point))
+                   header header-len)
                (message-next-header)
-               (add-text-properties
-                begin (point)
-                '(invisible t message-hidden t))))))))))
+               (setq header (buffer-substring begin (point))
+                     header-len (- (point) begin))
+               (delete-region begin (point))
+               (goto-char (1+ end-of-headers))
+               (insert header)
+               (setq end-of-headers
+                     (+ end-of-headers header-len))))))))
+    (narrow-to-region (1+ end-of-headers) (point-max))))
 
 (defun message-hide-header-p (regexps)
   (let ((result nil)