2002-11-29 ShengHuo ZHU <zsh@cs.rochester.edu>
[gnus] / lisp / message.el
index c0dbf43..bae2734 100644 (file)
@@ -206,11 +206,11 @@ header, remove it from this list."
   :type '(repeat sexp))
 
 (defcustom message-required-mail-headers
-  '(From Subject Date (optional . In-Reply-To) Message-ID Lines
+  '(From Subject Date (optional . In-Reply-To) Message-ID
         (optional . User-Agent))
   "*Headers to be generated or prompted for when mailing a message.
 It is recommended that From, Date, To, Subject and Message-ID be
-included.  Organization, Lines and User-Agent are optional."
+included.  Organization and User-Agent are optional."
   :group 'message-mail
   :group 'message-headers
   :type '(repeat sexp))
@@ -234,7 +234,7 @@ included.  Organization, Lines and User-Agent are optional."
   :group 'message-headers
   :type 'regexp)
 
-(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:"
+(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:"
   "*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."
@@ -247,6 +247,121 @@ any confusion."
   :group 'message-various
   :type 'regexp)
 
+;;; Start of variables adopted from `message-utils.el'.
+
+(defcustom message-subject-trailing-was-query 'ask
+  ;; should it default to nil or ask?
+  "*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
+`message-subject-trailing-was-ask-regexp'.  If
+`message-subject-trailing-was-query' is t, always strip the trailing
+old subject.  In this case, `message-subject-trailing-was-regexp' is
+used."
+  :type '(choice (const :tag "never" nil)
+                (const :tag "always strip" t)
+                 (const ask))
+  :group 'message-various)
+
+(defcustom message-subject-trailing-was-ask-regexp
+  "[ \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
+`message-subject-trailing-was-query' is set to the symbol `ask'.  If
+the variable is t instead of `ask', use
+`message-subject-trailing-was-regexp' instead.
+
+It is okay to create some false positives here, as the user is asked."
+  :group 'message-various
+  :type 'regexp)
+
+(defcustom message-subject-trailing-was-regexp
+  "[ \t]*\\((*[Ww][Aa][Ss]:[ \t]*.*)\\)"
+  "*Regexp matching \"(was: <old subject>)\" in the subject line.
+
+If `message-subject-trailing-was-query' is set to t, the subject is
+matched against `message-subject-trailing-was-regexp' in
+`message-strip-subject-trailing-was'.  You should use a regexp creating very
+few false positives here."
+  :group 'message-various
+  :type 'regexp)
+
+;;; marking inserted text
+
+;;;###autoload
+(defcustom message-mark-insert-begin
+  "--8<---------------cut here---------------start------------->8---\n"
+  "How to mark the beginning of some inserted text."
+  :type 'string
+  :group 'message-various)
+
+;;;###autoload
+(defcustom message-mark-insert-end
+  "--8<---------------cut here---------------end--------------->8---\n"
+  "How to mark the end of some inserted text."
+  :type 'string
+  :group 'message-various)
+
+;;;###autoload
+(defcustom message-archive-header
+  "X-No-Archive: Yes\n"
+  "Header to insert when you don't want your article to be archived.
+Archives \(such as groups.googgle.com\) respect this header."
+  :type 'string
+  :group 'message-various)
+
+;;;###autoload
+(defcustom message-archive-note
+  "X-No-Archive: Yes - save http://groups.google.com/"
+  "Note to insert why you wouldn't want this posting archived. 
+If nil, don't insert any text in the body."
+  :type 'string
+  :group 'message-various)
+
+;;; Crossposts and Followups
+;; inspired by JoH-followup-to by Jochem Huhman <joh  at gmx.de>
+;; new suggestions by R. Weikusat <rw at another.de>
+
+(defvar message-xpost-old-target nil
+  "Old target for cross-posts or follow-ups.")
+(make-variable-buffer-local 'message-xpost-old-target)
+
+;;;###autoload
+(defcustom message-xpost-default t
+  "When non-nil `message-xpost-fup2' will normally perform a crosspost.
+If nil, `message-xpost-fup2' will only do a followup.  Note that you
+can explicitly override this setting by calling `message-xpost-fup2'
+with a prefix."
+  :type 'boolean
+  :group 'message-various)
+
+;;;###autoload
+(defcustom message-xpost-note
+  "Crosspost & Followup-To: "
+  "Note to insert before signature to notify of xpost and follow-up."
+  :type 'string
+  :group 'message-various)
+
+;;;###autoload
+(defcustom message-fup2-note
+  "Followup-To: "
+  "Note to insert before signature to notify of follow-up only."
+  :type 'string
+  :group 'message-various)
+
+;;;###autoload
+(defcustom message-xpost-note-function
+  'message-xpost-insert-note
+  "Function to use to insert note about Crosspost or Followup-To.  
+The function will be called with four arguments.  The function should not only
+insert a note, but also ensure old notes are deleted.  See the documentation
+for `message-xpost-insert-note'. "
+  :type 'function
+  :group 'message-various)
+
+;;; End of variables adopted from `message-utils.el'.
+
 ;;;###autoload
 (defcustom message-signature-separator "^-- *$"
   "Regexp matching the signature separator."
@@ -340,7 +455,7 @@ The provided functions are:
   :group 'message-forwarding
   :type 'boolean)
 
-(defcustom message-ignored-resent-headers "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:"
+(defcustom message-ignored-resent-headers "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:\\|^>?From "
   "*All headers that match this regexp will be deleted when resending a message."
   :group 'message-interface
   :type 'regexp)
@@ -359,7 +474,7 @@ The provided functions are:
 
 (defcustom message-cite-prefix-regexp
   (if (string-match "[[:digit:]]" "1") ;; support POSIX?
-      "\\([ \t]*[-_.[:word:]]+>+\\|[ \t]*[]>»|:}+]\\)+"
+      "\\([ \t]*[-_.[:word:]]+>+\\|[ \t]*[]>|}+]\\)+"
     ;; ?-, ?_ or ?. MUST NOT be in syntax entry w.
     (let ((old-table (syntax-table))
          non-word-constituents)
@@ -371,10 +486,10 @@ The provided functions are:
             (if (string-match "\\w" ".")  "" ".")))
       (set-syntax-table old-table)
       (if (equal non-word-constituents "")
-         "\\([ \t]*\\(\\w\\)+>+\\|[ \t]*[]>»|:}+]\\)+"
+         "\\([ \t]*\\(\\w\\)+>+\\|[ \t]*[]>|}+]\\)+"
        (concat "\\([ \t]*\\(\\w\\|["
                non-word-constituents
-               "]\\)+>+\\|[ \t]*[]>»|:}+]\\)+"))))
+               "]\\)+>+\\|[ \t]*[]>|}+]\\)+"))))
   "*Regexp matching the longest possible citation prefix on a line."
   :group 'message-insertion
   :type 'regexp)
@@ -393,12 +508,13 @@ variable `mail-header-separator'.
 
 Valid values include `message-send-mail-with-sendmail' (the default),
 `message-send-mail-with-mh', `message-send-mail-with-qmail',
-`smtpmail-send-it' and `feedmail-send-it'.
+`message-smtpmail-send-it', `smtpmail-send-it' and `feedmail-send-it'.
 
 See also `send-mail-function'."
   :type '(radio (function-item message-send-mail-with-sendmail)
                (function-item message-send-mail-with-mh)
                (function-item message-send-mail-with-qmail)
+               (function-item message-smtpmail-send-it)
                (function-item smtpmail-send-it)
                (function-item feedmail-send-it)
                (function :tag "Other"))
@@ -963,37 +1079,66 @@ candidates:
   "Face used for displaying MML."
   :group 'message-faces)
 
+(defun message-font-lock-make-header-matcher (regexp)
+  (let ((form
+        `(lambda (limit)
+           (let ((start (point)))
+             (save-restriction
+               (widen)
+               (goto-char (point-min))
+               (if (re-search-forward
+                    (concat "^" (regexp-quote mail-header-separator) "$")
+                    nil t)
+                   (setq limit (min limit (match-beginning 0))))
+               (goto-char start))
+             (and (< start limit)
+                  (re-search-forward ,regexp limit t))))))
+    (if (featurep 'bytecomp)
+       (byte-compile form)
+      form)))
+
 (defvar message-font-lock-keywords
   (let ((content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)\n?"))
-    `((,(concat "^\\([Tt]o:\\)" content)
-       (1 (when (message-point-in-header-p) 'message-header-name-face))
-       (2 (when (message-point-in-header-p) 'message-header-to-face) nil t))
-      (,(concat "^\\(^[GBF]?[Cc][Cc]:\\|^[Rr]eply-[Tt]o:\\)" content)
-       (1 (when (message-point-in-header-p) 'message-header-name-face))
-       (2 (when (message-point-in-header-p) 'message-header-cc-face) nil t))
-      (,(concat "^\\([Ss]ubject:\\)" content)
-       (1 (when (message-point-in-header-p) 'message-header-name-face))
-       (2 (when (message-point-in-header-p) 'message-header-subject-face) nil t))
-      (,(concat "^\\([Nn]ewsgroups:\\|Followup-[Tt]o:\\)" content)
-       (1 (when (message-point-in-header-p) 'message-header-name-face))
-       (2 (when (message-point-in-header-p) 'message-header-newsgroups-face) nil t))
-      (,(concat "^\\([A-Z][^: \n\t]+:\\)" content)
-       (1 (when (message-point-in-header-p) 'message-header-name-face))
-       (2 (when (message-point-in-header-p) 'message-header-other-face) nil t))
-      (,(concat "^\\(X-[A-Za-z0-9-]+\\|In-Reply-To\\):" content)
-       (1 (when (message-point-in-header-p) 'message-header-name-face))
-       (2 (when (message-point-in-header-p) 'message-header-name-face)))
+    `((,(message-font-lock-make-header-matcher
+        (concat "^\\([Tt]o:\\)" content))
+       (1 'message-header-name-face)
+       (2 'message-header-to-face nil t))
+      (,(message-font-lock-make-header-matcher
+        (concat "^\\(^[GBF]?[Cc][Cc]:\\|^[Rr]eply-[Tt]o:\\)" content))
+       (1 'message-header-name-face)
+       (2 'message-header-cc-face nil t))
+      (,(message-font-lock-make-header-matcher
+        (concat "^\\([Ss]ubject:\\)" content))
+       (1 'message-header-name-face)
+       (2 'message-header-subject-face nil t))
+      (,(message-font-lock-make-header-matcher
+        (concat "^\\([Nn]ewsgroups:\\|Followup-[Tt]o:\\)" content))
+       (1 'message-header-name-face)
+       (2 'message-header-newsgroups-face nil t))
+      (,(message-font-lock-make-header-matcher
+        (concat "^\\([A-Z][^: \n\t]+:\\)" content))
+       (1 'message-header-name-face)
+       (2 'message-header-other-face nil t))
+      (,(message-font-lock-make-header-matcher
+        (concat "^\\(X-[A-Za-z0-9-]+:\\|In-Reply-To:\\)" content))
+       (1 'message-header-name-face)
+       (2 'message-header-name-face))
       ,@(if (and mail-header-separator
                 (not (equal mail-header-separator "")))
            `((,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$")
               1 'message-separator-face))
          nil)
-      (,(concat "^\\(" message-cite-prefix-regexp "\\).*")
+      ((lambda (limit)
+        (re-search-forward (concat "^\\("
+                                   message-cite-prefix-regexp
+                                   "\\).*")
+                           limit t))
        (0 'message-cited-text-face))
       ("<#/?\\(multipart\\|part\\|external\\|mml\\|secure\\)[^>]*>"
        (0 'message-mml-face))))
   "Additional expressions to highlight in Message mode.")
 
+
 ;; XEmacs does it like this.  For Emacs, we have to set the
 ;; `font-lock-defaults' buffer-local variable.
 (put 'message-mode 'font-lock-defaults '(message-font-lock-keywords t))
@@ -1005,7 +1150,7 @@ candidates:
                 (unbold-region b e)
                 (ununderline-region b e))))
   "Alist of mail and news faces for facemenu.
-The cdr of ech entry is a function for applying the face to a region.")
+The cdr of each entry is a function for applying the face to a region.")
 
 (defcustom message-send-hook nil
   "Hook run before sending messages."
@@ -1033,7 +1178,10 @@ The cdr of ech entry is a function for applying the face to a region.")
 
 (defvar message-draft-coding-system
   mm-auto-save-coding-system
-  "Coding system to compose mail.")
+  "*Coding system to compose mail.
+If you'd like to make it possible to share draft files between XEmacs
+and Emacs, you may use `iso-2022-7bit' for this value at your own risk.
+Note that the coding-system `iso-2022-7bit' isn't suitable to all data.")
 
 (defcustom message-send-mail-partially-limit 1000000
   "The limitation of messages sent as message/partial.
@@ -1220,7 +1368,8 @@ no, only reply back to the author."
   (autoload 'gnus-group-name-charset "gnus-group")
   (autoload 'gnus-group-name-decode "gnus-group")
   (autoload 'gnus-groups-from-server "gnus")
-  (autoload 'rmail-output "rmailout"))
+  (autoload 'rmail-output "rmailout")
+  (autoload 'gnus-delay-article "gnus-delay"))
 
 \f
 
@@ -1377,6 +1526,253 @@ is used by default."
       (substring subject (match-end 0))
     subject))
 
+;;; Start of functions adopted from `message-utils.el'.
+
+(defun message-strip-subject-trailing-was (subject)
+  "Remove trailing \"(Was: <old subject>)\" from subject lines.   
+Leading \"Re: \" is not stripped by this function.  Use the function
+`message-strip-subject-re' for this."
+  (let* ((query message-subject-trailing-was-query)
+        (new) (found))
+    (setq found
+         (string-match 
+          (if (eq query 'ask)
+              message-subject-trailing-was-ask-regexp
+            message-subject-trailing-was-regexp)
+          subject))
+    (if found
+       (setq new (substring subject 0 (match-beginning 0))))
+    (if (or (not found) (eq query nil))
+       subject
+      (if (eq query 'ask)
+         (if (message-y-or-n-p
+              "Strip `(was: <old subject>)' in subject? " t
+              (concat 
+               "Strip `(was: <old subject>)' in subject "
+               "and use the new one instead?\n\n"
+               "Current subject is:   \""
+               subject "\"\n\n"
+               "New subject would be: \""
+               new "\"\n\n"
+               "See the variable `message-subject-trailing-was-query' "
+               "to get rid of this query."
+               ))
+             new subject)
+       new))))
+
+;;; Suggested by Jonas Steverud  @  www.dtek.chalmers.se/~d4jonas/
+
+;;;###autoload
+(defun message-change-subject (new-subject)
+  "Ask for new Subject: header, append (was: <Old Subject>)."
+  (interactive
+   (list
+    (read-from-minibuffer "New subject: ")))
+  (cond ((and (not (or (null new-subject) ; new subject not empty
+                      (zerop (string-width new-subject))
+                      (string-match "^[ \t]*$" new-subject))))
+        (save-excursion
+          (let ((old-subject (message-fetch-field "Subject")))
+            (cond ((not old-subject)
+                   (error "No current subject."))
+                  ((not (string-match
+                         (concat "^[ \t]*"
+                                 (regexp-quote new-subject)
+                                 " \t]*$")
+                         old-subject))  ; yes, it really is a new subject
+                   ;; delete eventual Re: prefix
+                   (setq old-subject
+                         (message-strip-subject-re old-subject))
+                   (message-goto-subject)
+                   (message-delete-line)
+                   (insert (concat "Subject: "
+                                   new-subject
+                                   " (was: "
+                                   old-subject ")\n")))))))))
+
+;;;###autoload
+(defun message-mark-inserted-region (beg end)
+  "Mark some region in the current article with enclosing tags.
+See `message-mark-insert-begin' and `message-mark-insert-end'."
+  (interactive "r")
+  (save-excursion
+    ; add to the end of the region first, otherwise end would be invalid
+    (goto-char end)
+    (insert message-mark-insert-end)
+    (goto-char beg)
+    (insert message-mark-insert-begin)))
+
+;;;###autoload
+(defun message-mark-insert-file (file)
+  "Inserts FILE at point, marking it with enclosing tags.
+See `message-mark-insert-begin' and `message-mark-insert-end'."
+  (interactive "fFile to insert: ")
+    ;; reverse insertion to get correct result.
+  (let ((p (point)))
+    (insert message-mark-insert-end)
+    (goto-char p)
+    (insert-file-contents file)
+    (goto-char p)
+    (insert message-mark-insert-begin)))
+
+;;;###autoload
+(defun message-add-archive-header ()
+  "Insert \"X-No-Archive: Yes\" in the header and a note in the body.
+The note can be customized using `message-archive-note'.  When called with a
+prefix argument, ask for a text to insert.  If you don't want the note in the
+body, set  `message-archive-note' to nil."
+  (interactive)
+  (if current-prefix-arg
+      (setq message-archive-note
+           (read-from-minibuffer "Reason for No-Archive: "
+                                 (cons message-archive-note 0))))
+    (save-excursion
+      (if (message-goto-signature)
+         (re-search-backward message-signature-separator))
+      (when message-archive-note
+       (insert message-archive-note)
+       (newline))
+      (message-add-header message-archive-header)
+      (message-sort-headers)))
+
+;;;###autoload
+(defun message-xpost-fup2-header (target-group)
+  "Mangles FollowUp-To and Newsgroups header to point to TARGET-GROUP.
+With prefix-argument just set Follow-Up, don't cross-post."
+  (interactive
+   (list ; Completion based on Gnus
+    (completing-read "Followup To: "
+                    (if (boundp 'gnus-newsrc-alist)
+                        gnus-newsrc-alist)
+                    nil nil '("poster" . 0)
+                    (if (boundp 'gnus-group-history)
+                        'gnus-group-history))))
+  (message-remove-header "Follow[Uu]p-[Tt]o" t)
+  (message-goto-newsgroups)
+  (beginning-of-line)
+  ;; if we already did a crosspost before, kill old target
+  (if (and message-xpost-old-target
+          (re-search-forward
+           (regexp-quote (concat "," message-xpost-old-target))
+           nil t))
+      (replace-match ""))
+  ;; unless (followup is to poster or user explicitly asked not
+  ;; to cross-post, or target-group is already in Newsgroups)
+  ;; add target-group to Newsgroups line.
+  (cond ((and (or
+              ;; def: xpost, req:no
+              (and message-xpost-default (not current-prefix-arg))  
+              ;; def: no-xpost, req:yes
+              (and (not message-xpost-default) current-prefix-arg))
+             (not (string-match "poster" target-group))
+             (not (string-match (regexp-quote target-group)
+                                (message-fetch-field "Newsgroups"))))
+        (end-of-line)
+        (insert-string (concat "," target-group))))
+  (end-of-line) ; ensure Followup: comes after Newsgroups:
+  ;; unless new followup would be identical to Newsgroups line
+  ;; make a new Followup-To line
+  (if (not (string-match (concat "^[ \t]*"
+                                target-group
+                                "[ \t]*$")
+                        (message-fetch-field "Newsgroups")))
+      (insert (concat "\nFollowup-To: " target-group)))
+  (setq message-xpost-old-target target-group))
+
+;;;###autoload
+(defun message-xpost-insert-note (target-group xpost in-old old-groups)
+  "Insert a in message body note about a set Followup or Crosspost.
+If there have been previous notes, delete them.  TARGET-GROUP specifies the
+group to Followup-To.  When XPOST is t, insert note about
+crossposting.  IN-OLD specifies whether TARGET-GROUP is a member of
+OLD-GROUPS.  OLD-GROUPS lists the old-groups the posting would have
+been made to before the user asked for a Crosspost."
+  ;; start scanning body for previous uses
+  (message-goto-signature)
+  (let ((head (re-search-backward
+              (concat "^" mail-header-separator)
+              nil t))) ; just search in body
+    (message-goto-signature)
+    (while (re-search-backward
+           (concat "^" (regexp-quote message-xpost-note) ".*")
+           head t)
+      (message-delete-line))
+    (message-goto-signature)
+    (while (re-search-backward
+           (concat "^" (regexp-quote message-fup2-note) ".*")
+           head t)
+      (message-delete-line))
+    ;; insert new note
+    (if (message-goto-signature)
+       (re-search-backward message-signature-separator))
+    (if (or in-old
+           (not xpost)
+           (string-match "^[ \t]*poster[ \t]*$" target-group))
+       (insert (concat message-fup2-note target-group "\n"))
+      (insert (concat message-xpost-note target-group "\n")))))
+
+;;;###autoload
+(defun message-xpost-fup2 (target-group)
+  "Crossposts message and sets Followup-To to TARGET-GROUP.
+With prefix-argument just set Follow-Up, don't cross-post."
+  (interactive
+   (list ; Completion based on Gnus
+    (completing-read "Followup To: "
+                    (if (boundp 'gnus-newsrc-alist)
+                        gnus-newsrc-alist)
+                    nil nil '("poster" . 0)
+                    (if (boundp 'gnus-group-history)
+                        'gnus-group-history))))
+  (cond ((not (or (null target-group) ; new subject not empty
+                 (zerop (string-width target-group))
+                 (string-match "^[ \t]*$" target-group)))
+        (save-excursion
+          (let* ((old-groups (message-fetch-field "Newsgroups"))
+                 (in-old (string-match
+                          (regexp-quote target-group) 
+                          (or old-groups ""))))
+            ;; check whether target exactly matches old Newsgroups
+            (cond ((not old-groups)
+                   (error "No current newsgroup."))
+                  ((or (not in-old)
+                       (not (string-match
+                             (concat "^[ \t]*"
+                                     (regexp-quote target-group)
+                                     "[ \t]*$")
+                             old-groups)))
+                   ;; yes, Newsgroups line must change
+                   (message-xpost-fup2-header target-group)
+                   ;; insert note whether we do xpost or fup2
+                   (funcall message-xpost-note-function
+                            target-group
+                            (if (or (and message-xpost-default
+                                         (not current-prefix-arg))
+                                    (and (not message-xpost-default)
+                                         current-prefix-arg)) t)
+                            in-old old-groups))))))))
+
+;;; Reduce To: to Cc: or Bcc: header
+
+;;;###autoload
+(defun message-reduce-to-to-cc ()
+ "Replace contents of To: header with contents of Cc: or Bcc: header."
+ (interactive)
+ (let ((cc-content (message-fetch-field "cc"))
+       (bcc nil))
+   (if (and (not cc-content)
+           (setq cc-content (message-fetch-field "bcc")))
+       (setq bcc t))
+   (cond (cc-content
+         (save-excursion
+           (message-goto-to)
+           (message-delete-line)
+           (insert (concat "To: " cc-content "\n"))
+           (message-remove-header (if bcc
+                                      "bcc"
+                                    "cc")))))))
+
+;;; End of functions adopted from `message-utils.el'.
+
 (defun message-remove-header (header &optional is-regexp first reverse)
   "Remove HEADER in the narrowed buffer.
 If IS-REGEXP, HEADER is a regular expression.
@@ -1528,6 +1924,7 @@ Point is left at the beginning of the narrowed-to region."
             (1+ max)))))
       (message-sort-headers-1))))
 
+
 \f
 
 ;;;
@@ -1558,6 +1955,18 @@ Point is left at the beginning of the narrowed-to region."
   (define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary)
   (define-key message-mode-map "\C-c\C-f\C-i" 'message-insert-or-toggle-importance)
   (define-key message-mode-map "\C-c\C-f\C-a" 'message-gen-unsubscribed-mft)
+
+  ;; modify headers (and insert notes in body)
+  (define-key message-mode-map "\C-c\C-fs"    'message-change-subject)
+  ;;
+  (define-key message-mode-map "\C-c\C-fx"    'message-xpost-fup2)
+  ;; prefix+message-xpost-fup2 = same w/o xpost
+  (define-key message-mode-map "\C-c\C-ft"    'message-reduce-to-to-cc)
+  (define-key message-mode-map "\C-c\C-fa"    'message-add-archive-header)
+  ;; mark inserted text
+  (define-key message-mode-map "\C-c\M-m" 'message-mark-inserted-region)
+  (define-key message-mode-map "\C-c\M-f" 'message-mark-insert-file)
+  
   (define-key message-mode-map "\C-c\C-b" 'message-goto-body)
   (define-key message-mode-map "\C-c\C-i" 'message-goto-signature)
 
@@ -1623,6 +2032,13 @@ Point is left at the beginning of the narrowed-to region."
      ,@(if (featurep 'xemacs) '(t)
         '(:help "Spellcheck this message"))]
     "----"
+    ["Insert Region Marked" message-mark-inserted-region 
+     ,@(if (featurep 'xemacs) '(t)
+        '(:help "Mark region with enclosing tags"))]
+    ["Insert File Marked" message-mark-insert-file 
+     ,@(if (featurep 'xemacs) '(t)
+        '(:help "Insert file at point marked with enclosing tags"))]
+    "----"
     ["Send Message" message-send-and-exit
      ,@(if (featurep 'xemacs) '(t)
         '(:help "Send this message"))]
@@ -1645,14 +2061,27 @@ Point is left at the beginning of the narrowed-to region."
     ["To" message-goto-to t]
     ["From" message-goto-from t]
     ["Subject" message-goto-subject t]
+    ["Change subject" message-change-subject t]
     ["Cc" message-goto-cc t]
+    ["Bcc" message-goto-bcc t]
+    ["Fcc" message-goto-fcc t]
     ["Reply-To" message-goto-reply-to t]
+    "----"
+    ;; (typical) news stuff
     ["Summary" message-goto-summary t]
     ["Keywords" message-goto-keywords t]
     ["Newsgroups" message-goto-newsgroups t]
     ["Followup-To" message-goto-followup-to t]
-    ["Mail-Followup-To" message-goto-mail-followup-to t]
+    ;; ["Followup-To (with note in body)" message-xpost-fup2 t]
+    ["Crosspost / Followup-To" message-xpost-fup2 t]
     ["Distribution" message-goto-distribution t]
+    ["X-No-Archive:" message-add-archive-header t ]
+    "----"
+    ;; (typical) mailing-lists stuff
+    ["Send to list only" message-to-list-only t]
+    ["Mail-Followup-To" message-goto-mail-followup-to t]
+    ["Reduce To: to Cc:" message-reduce-to-to-cc t]
+    "----"
     ["Body" message-goto-body t]
     ["Signature" message-goto-signature t]))
 
@@ -1733,6 +2162,10 @@ C-c C-f  move to a header field (and create it if there isn't):
         C-c C-f C-f  move to Followup-To
         C-c C-f C-m  move to Mail-Followup-To
         C-c C-f C-i  cycle through Importance values
+        C-c C-f s    change subject and append \"(was: <Old Subject>)\"
+        C-c C-f x    crossposting with FollowUp-To header and note in body
+        C-c C-f t    replace To: header with contents of Cc: or Bcc:
+        C-c C-f a    Insert X-No-Archive: header and a note in the body
 C-c C-t  `message-insert-to' (add a To header to a news followup)
 C-c C-l  `message-to-list-only' (removes all but list address in to/cc)
 C-c C-n  `message-insert-newsgroups' (add a Newsgroup header to a news reply)
@@ -1748,6 +2181,8 @@ C-c C-r  `message-caesar-buffer-body' (rot13 the message body).
 C-c C-a  `mml-attach-file' (attach a file as MIME).
 C-c C-u  `message-insert-or-toggle-importance'  (insert or cycle importance).
 C-c M-n  `message-insert-disposition-notification-to'  (request receipt).
+C-c M-m  `message-mark-inserted-region' (mark region with enclosing tags).
+C-c M-f  `message-mark-insert-file' (insert file marked with enclosing tags).
 M-RET    `message-newline-and-reformat' (break the line and reformat)."
   (setq local-abbrev-table text-mode-abbrev-table)
   (set (make-local-variable 'message-reply-buffer) nil)
@@ -2937,13 +3372,14 @@ It should typically alter the sending method in some way or other."
                        "The message size is too large, split? "
                        t
                        "\
-The message size, " (/ (point-max) 1000) "KB, is too large.
+The message size, "
+                       (/ (point-max) 1000) "KB, is too large.
 
 Some mail gateways (MTA's) bounce large messages.  To avoid the
 problem, answer `y', and the message will be split into several
 smaller pieces, the size of each is about "
-(/ message-send-mail-partially-limit 1000)
-"KB except the last
+                       (/ message-send-mail-partially-limit 1000)
+                       "KB except the last
 one.
 
 However, some mail readers (MUA's) can't read split messages, i.e.,
@@ -3096,20 +3532,31 @@ to find out how to use this."
     ;; Pass it on to mh.
     (mh-send-letter)))
 
+(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
+documentation for the function `mail-source-touch-pop'."
+  (run-hooks 'message-send-mail-hook)
+  (smtpmail-send-it))
+
 (defun message-canlock-generate ()
   "Return a string that is non-trival to guess.
 Do not use this for anything important, it is cryptographically weak."
-  (sha1 (concat (message-unique-id)
-               (format "%x%x%x" (random) (random t) (random))
-               (prin1-to-string (recent-keys))
-               (prin1-to-string (garbage-collect)))))
+  (let (sha1-maximum-internal-length)
+    (sha1 (concat (message-unique-id)
+                 (format "%x%x%x" (random) (random t) (random))
+                 (prin1-to-string (recent-keys))
+                 (prin1-to-string (garbage-collect))))))
 
 (defun message-canlock-password ()
   "The password used by message for cancel locks.
 This is the value of `canlock-password', if that option is non-nil.
 Otherwise, generate and save a value for `canlock-password' first."
   (unless canlock-password
-    (customize-save-variable 'canlock-password (message-canlock-generate)))
+    (customize-save-variable 'canlock-password (message-canlock-generate))
+    (setq canlock-password-for-verify canlock-password))
   canlock-password)
 
 (defun message-insert-canlock ()
@@ -3946,6 +4393,8 @@ give as trustworthy answer as possible."
       (message-make-fqdn)))
 
 (defun message-to-list-only ()
+  "Send a message to the list only.
+Remove all addresses but the list address from To and Cc headers."
   (interactive)
   (let ((listaddr (message-make-mft t)))
     (when listaddr
@@ -4283,13 +4732,19 @@ than 988 characters long, and if they are not, trim them until they are."
       (forward-line 2)))
    (sit-for 0)))
 
+(defcustom message-beginning-of-line t
+  "Whether C-a goes to beginning of header values."
+  :group 'message-buffers
+  :type 'boolean)
+
 (defun message-beginning-of-line (&optional n)
   "Move point to beginning of header value or to beginning of line."
   (interactive "p")
   (let ((zrs 'zmacs-region-stays))
     (when (and (interactive-p) (boundp zrs))
       (set zrs t)))
-  (if (message-point-in-header-p)
+  (if (and message-beginning-of-line
+          (message-point-in-header-p))
       (let* ((here (point))
             (bol (progn (beginning-of-line n) (point)))
             (eol (gnus-point-at-eol))
@@ -4489,14 +4944,14 @@ than 988 characters long, and if they are not, trim them until they are."
   (when message-auto-save-directory
     (unless (file-directory-p
             (directory-file-name message-auto-save-directory))
-      (gnus-make-directory message-auto-save-directory))
+      (make-directory message-auto-save-directory t))
     (if (gnus-alive-p)
        (setq message-draft-article
              (nndraft-request-associate-buffer "drafts"))
       (setq buffer-file-name (expand-file-name
                              (if (memq system-type
                                        '(ms-dos ms-windows windows-nt
-                                                cygwin32 win32 w32
+                                                cygwin cygwin32 win32 w32
                                                 mswindows))
                                  "message"
                                "*message*")
@@ -4712,6 +5167,8 @@ responses here are directed to other addresses.")))
       (when gnus-list-identifiers
        (setq subject (message-strip-list-identifiers subject)))
       (setq subject (concat "Re: " (message-strip-subject-re subject)))
+      (when message-subject-trailing-was-query
+       (setq subject (message-strip-subject-trailing-was subject)))
 
       (when (and (setq gnus-warning (message-fetch-field "gnus-warning"))
                 (string-match "<[^>]+>" gnus-warning))
@@ -4788,6 +5245,8 @@ If TO-NEWSGROUPS, use that as the new Newsgroups line."
       (if gnus-list-identifiers
          (setq subject (message-strip-list-identifiers subject)))
       (setq subject (concat "Re: " (message-strip-subject-re subject)))
+      (when message-subject-trailing-was-query
+       (setq subject (message-strip-subject-trailing-was subject)))
       (widen))
 
     (message-pop-to-buffer (message-buffer-name "followup" from newsgroups))
@@ -5128,14 +5587,11 @@ Optional DIGEST will use digest to forward."
               (not message-forward-decoded-p))
          (insert
           (with-temp-buffer
-            (if (with-current-buffer forward-buffer
-                  (mm-multibyte-p))
-                (insert-buffer-substring forward-buffer)
-              (mm-disable-multibyte-mule4)
-              (insert
-               (with-current-buffer forward-buffer
-                 (mm-string-as-unibyte (buffer-string))))
-              (mm-enable-multibyte-mule4))
+            (mm-disable-multibyte-mule4)
+            (insert
+             (with-current-buffer forward-buffer
+               (mm-string-as-unibyte (buffer-string))))
+            (mm-enable-multibyte-mule4)
             (mime-to-mml)
             (goto-char (point-min))
             (when (looking-at "From ")
@@ -5164,7 +5620,9 @@ Optional DIGEST will use digest to forward."
                            (or (search-forward "\n\n" nil t) (point)))
          (delete-region (point-min) (point-max)))
       (when (and (not current-prefix-arg)
-                message-forward-ignored-headers)
+                message-forward-ignored-headers
+                ;; don't remove CTE, X-Gnus etc when doing "raw" forward:
+                message-forward-show-mml)
        (save-restriction
          (narrow-to-region b e)
          (goto-char b)
@@ -5429,7 +5887,9 @@ which specify the range to operate on."
 
 (defcustom message-completion-alist
   (list (cons message-newgroups-header-regexp 'message-expand-group)
-       '("^\\(Resent-\\)?\\(To\\|B?Cc\\):" . message-expand-name))
+       '("^\\(Resent-\\)?\\(To\\|B?Cc\\):" . message-expand-name)
+       '("^\\(Reply-To\\|From\\|Disposition-Notification-To\\|Return-Receipt-To\\):" 
+         . message-expand-name))
   "Alist of (RE . FUN).  Use FUN for completion on header lines matching RE."
   :group 'message
   :type '(alist :key-type regexp :value-type function))