Synch to No Gnus 200501120840.
[elisp/gnus.git-] / lisp / message.el
index 771f300..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)
@@ -2678,10 +2691,9 @@ See also `message-forbidden-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))))
+    (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"
@@ -4007,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
@@ -4250,10 +4262,11 @@ This sub function is for exclusive use of `message-send-mail'."
         (headers message-required-mail-headers)
         failure)
     (when message-generate-hashcash
-      (save-restriction
-       (message-narrow-to-headers)
-       (message-remove-header "X-Hashcash"))
       (message "Generating hashcash...")
+      ;; Wait for calculations already started to finish...
+      (hashcash-wait-async)
+      ;; ...and do calculations not already done.  mail-add-payment
+      ;; will leave existing X-Hashcash headers alone.
       (mail-add-payment)
       (message "Generating hashcash...done"))
     (save-restriction
@@ -6199,6 +6212,9 @@ are not included."
     (run-hooks 'message-header-setup-hook))
   (set-buffer-modified-p nil)
   (setq buffer-undo-list nil)
+  (when message-generate-hashcash
+    ;; Generate hashcash headers for recipients already known
+    (mail-add-payment-async))
   (run-hooks 'message-setup-hook)
   (message-position-point)
   (undo-boundary))
@@ -6285,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)
@@ -6296,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
@@ -6386,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 ", ".
@@ -6943,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)
@@ -6990,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)
@@ -7393,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.
@@ -7634,7 +7655,7 @@ regexp VARSTR."
 
 (defun message-use-alternative-email-as-from ()
   (require 'mail-utils)
-  (let* ((fields '("To" "Cc"))
+  (let* ((fields '("To" "Cc" "From"))
         (emails
          (split-string
           (mail-strip-quoted-names
@@ -7648,7 +7669,8 @@ regexp VARSTR."
       (pop emails))
     (unless (or (not email) (equal email user-mail-address))
       (goto-char (point-max))
-      (insert "From: " email "\n"))))
+      (insert "From: " (let ((user-mail-address email)) (message-make-from))
+             "\n"))))
 
 (defun message-options-get (symbol)
   (cdr (assq symbol message-options)))
@@ -7687,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
@@ -7696,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)