Fix translations.
[elisp/gnus.git-] / lisp / message.el
index aa37162..bf8dd17 100644 (file)
@@ -1,6 +1,7 @@
 ;;; message.el --- composing mail and news messages
 ;;; message.el --- composing mail and news messages
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
-;;        Free Software Foundation, Inc.
+
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;;   2005 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;     MORIOKA Tomohiko <morioka@jaist.ac.jp>
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;     MORIOKA Tomohiko <morioka@jaist.ac.jp>
@@ -25,8 +26,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
 
 ;;; Commentary:
 
 (put 'user-full-name 'custom-type 'string)
 
 (defgroup message-various nil
 (put 'user-full-name 'custom-type 'string)
 
 (defgroup message-various nil
-  "Various Message Variables"
+  "Various Message Variables."
   :link '(custom-manual "(message)Various Message Variables")
   :group 'message)
 
 (defgroup message-buffers nil
   :link '(custom-manual "(message)Various Message Variables")
   :group 'message)
 
 (defgroup message-buffers nil
-  "Message Buffers"
+  "Message Buffers."
   :link '(custom-manual "(message)Message Buffers")
   :group 'message)
 
 (defgroup message-sending nil
   :link '(custom-manual "(message)Message Buffers")
   :group 'message)
 
 (defgroup message-sending nil
-  "Message Sending"
+  "Message Sending."
   :link '(custom-manual "(message)Sending Variables")
   :group 'message)
 
 (defgroup message-interface nil
   :link '(custom-manual "(message)Sending Variables")
   :group 'message)
 
 (defgroup message-interface nil
-  "Message Interface"
+  "Message Interface."
   :link '(custom-manual "(message)Interface")
   :group 'message)
 
 (defgroup message-forwarding nil
   :link '(custom-manual "(message)Interface")
   :group 'message)
 
 (defgroup message-forwarding nil
-  "Message Forwarding"
+  "Message Forwarding."
   :link '(custom-manual "(message)Forwarding")
   :group 'message-interface)
 
 (defgroup message-insertion nil
   :link '(custom-manual "(message)Forwarding")
   :group 'message-interface)
 
 (defgroup message-insertion nil
-  "Message Insertion"
+  "Message Insertion."
   :link '(custom-manual "(message)Insertion")
   :group 'message)
 
 (defgroup message-headers nil
   :link '(custom-manual "(message)Insertion")
   :group 'message)
 
 (defgroup message-headers nil
-  "Message Headers"
+  "Message Headers."
   :link '(custom-manual "(message)Message Headers")
   :group 'message)
 
 (defgroup message-news nil
   :link '(custom-manual "(message)Message Headers")
   :group 'message)
 
 (defgroup message-news nil
-  "Composing News Messages"
+  "Composing News Messages."
   :group 'message)
 
 (defgroup message-mail nil
   :group 'message)
 
 (defgroup message-mail nil
-  "Composing Mail Messages"
+  "Composing Mail Messages."
   :group 'message)
 
 (defgroup message-faces nil
   :group 'message)
 
 (defgroup message-faces nil
@@ -549,9 +550,10 @@ command `message-mimic-kill-buffer' is used."
   :group 'message-buffers
   :type 'boolean)
 
   :group 'message-buffers
   :type 'boolean)
 
-(defcustom message-kill-buffer-query-if-modified t
+(defcustom message-kill-buffer-query t
   "*Non-nil means that killing a modified message buffer has to be confirmed.
 This is used by `message-kill-buffer'."
   "*Non-nil means that killing a modified message buffer has to be confirmed.
 This is used by `message-kill-buffer'."
+  :version "23.0" ;; No Gnus
   :group 'message-buffers
   :type 'boolean)
 
   :group 'message-buffers
   :type 'boolean)
 
@@ -1020,7 +1022,8 @@ The function `message-supersede' runs this hook."
     (set-keymap-parent map minibuffer-local-map)
     map)
   "Keymap for `message-read-from-minibuffer'."
     (set-keymap-parent map minibuffer-local-map)
     map)
   "Keymap for `message-read-from-minibuffer'."
-  :version "22.1")
+  :version "22.1"
+  :group 'message-various)
 
 ;;;###autoload
 (defcustom message-citation-line-function 'message-insert-citation-line
 
 ;;;###autoload
 (defcustom message-citation-line-function 'message-insert-citation-line
@@ -1038,33 +1041,23 @@ configuration.  See the variable `gnus-cite-attribution-suffix'."
 (defcustom message-yank-prefix "> "
   "*Prefix inserted on the lines of yanked messages.
 Fix `message-cite-prefix-regexp' if it is set to an abnormal value.
 (defcustom message-yank-prefix "> "
   "*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'."
+See also `message-yank-cited-prefix' and `message-yank-empty-prefix'."
   :type 'string
   :link '(custom-manual "(message)Insertion Variables")
   :group 'message-insertion)
 
   :type 'string
   :link '(custom-manual "(message)Insertion Variables")
   :group 'message-insertion)
 
-(defcustom message-yank-add-new-references t
-  "Non-nil means new IDs will be added to \"References\" field when an
-article is yanked by the command `message-yank-original' interactively.
-If it is a symbol `message-id-only', only an ID from \"Message-ID\" field
-is used, otherwise IDs extracted from \"References\", \"In-Reply-To\" and
-\"Message-ID\" fields are used."
-  :type '(radio (const :tag "Do not add anything" nil)
-               (const :tag "From Message-Id, References and In-Reply-To fields" t)
-               (const :tag "From only Message-Id field." message-id-only))
-  :group 'message-insertion)
-
-(defcustom message-list-references-add-position nil
-  "Integer value means position for adding to \"References\" field when
-an article is yanked by the command `message-yank-original' interactively."
-  :type '(radio (const :tag "Add to last" nil)
-               (integer :tag "Position from last ID"))
-  :group 'message-insertion)
-
 (defcustom message-yank-cited-prefix ">"
 (defcustom message-yank-cited-prefix ">"
-  "*Prefix inserted on cited or empty lines of yanked messages.
+  "*Prefix inserted on cited lines of yanked messages.
 Fix `message-cite-prefix-regexp' if it is set to an abnormal value.
 Fix `message-cite-prefix-regexp' if it is set to an abnormal value.
-See also `message-yank-prefix'."
+See also `message-yank-prefix' and `message-yank-empty-prefix'."
+  :version "22.1"
+  :type 'string
+  :link '(custom-manual "(message)Insertion Variables")
+  :group 'message-insertion)
+
+(defcustom message-yank-empty-prefix ">"
+  "*Prefix inserted on empty lines of yanked messages.
+See also `message-yank-prefix' and `message-yank-cited-prefix'."
   :version "22.1"
   :type 'string
   :link '(custom-manual "(message)Insertion Variables")
   :version "22.1"
   :type 'string
   :link '(custom-manual "(message)Insertion Variables")
@@ -1082,7 +1075,7 @@ Used by `message-yank-original' via `message-yank-cite'."
   "*Function for citing an original message.
 Predefined functions include `message-cite-original' and
 `message-cite-original-without-signature'.
   "*Function for citing an original message.
 Predefined functions include `message-cite-original' and
 `message-cite-original-without-signature'.
-Note that `message-cite-original' uses `mail-citation-hook' if that is non-nil."
+Note that these functions use `mail-citation-hook' if that is non-nil."
   :type '(radio (function-item message-cite-original)
                (function-item message-cite-original-without-signature)
                (function-item mu-cite-original)
   :type '(radio (function-item message-cite-original)
                (function-item message-cite-original-without-signature)
                (function-item mu-cite-original)
@@ -1092,6 +1085,16 @@ Note that `message-cite-original' uses `mail-citation-hook' if that is non-nil."
   :group 'message-insertion)
 
 ;;;###autoload
   :group 'message-insertion)
 
 ;;;###autoload
+(defcustom message-indent-citation-function 'message-indent-citation
+  "*Function for modifying a citation just inserted in the mail buffer.
+This can also be a list of functions.  Each function can find the
+citation between (point) and (mark t).  And each function should leave
+point and mark around the citation text as modified."
+  :type 'function
+  :link '(custom-manual "(message)Insertion Variables")
+  :group 'message-insertion)
+
+;;;###autoload
 (defcustom message-suspend-font-lock-when-citing nil
   "Non-nil means suspend font-lock'ing while citing an original message.
 Some lazy demand-driven fontification tools (or Emacs itself) have a
 (defcustom message-suspend-font-lock-when-citing nil
   "Non-nil means suspend font-lock'ing while citing an original message.
 Some lazy demand-driven fontification tools (or Emacs itself) have a
@@ -1102,14 +1105,23 @@ even if it is an add-hoc expedient."
   :type 'boolean
   :group 'message-insertion)
 
   :type 'boolean
   :group 'message-insertion)
 
-;;;###autoload
-(defcustom message-indent-citation-function 'message-indent-citation
-  "*Function for modifying a citation just inserted in the mail buffer.
-This can also be a list of functions.  Each function can find the
-citation between (point) and (mark t).  And each function should leave
-point and mark around the citation text as modified."
-  :type 'function
-  :link '(custom-manual "(message)Insertion Variables")
+(defcustom message-yank-add-new-references t
+  "Non-nil means new IDs will be added to \"References\" field when an
+article is yanked by the command `message-yank-original' interactively.
+If it is a symbol `message-id-only', only an ID from \"Message-ID\" field
+is used, otherwise IDs extracted from \"References\", \"In-Reply-To\" and
+\"Message-ID\" fields are used."
+  :type '(radio
+         (const :tag "Do not add anything" nil)
+         (const :tag "From Message-Id, References and In-Reply-To fields" t)
+         (const :tag "From only Message-Id field." message-id-only))
+  :group 'message-insertion)
+
+(defcustom message-list-references-add-position nil
+  "Integer value means position for adding to \"References\" field when
+an article is yanked by the command `message-yank-original' interactively."
+  :type '(radio (const :tag "Add to last" nil)
+               (integer :tag "Position from last ID"))
   :group 'message-insertion)
 
 ;;;###autoload
   :group 'message-insertion)
 
 ;;;###autoload
@@ -1348,7 +1360,7 @@ starting with `not' and followed by regexps."
     table)
   "Syntax table used while in Message mode.")
 
     table)
   "Syntax table used while in Message mode.")
 
-(defface message-header-to-face
+(defface message-header-to
   '((((class color)
       (background dark))
      (:foreground "green2" :bold t))
   '((((class color)
       (background dark))
      (:foreground "green2" :bold t))
@@ -1359,8 +1371,10 @@ starting with `not' and followed by regexps."
      (:bold t :italic t)))
   "Face used for displaying From headers."
   :group 'message-faces)
      (:bold t :italic t)))
   "Face used for displaying From headers."
   :group 'message-faces)
+;; backward-compatibility alias
+(put 'message-header-to-face 'face-alias 'message-header-to)
 
 
-(defface message-header-cc-face
+(defface message-header-cc
   '((((class color)
       (background dark))
      (:foreground "green4" :bold t))
   '((((class color)
       (background dark))
      (:foreground "green4" :bold t))
@@ -1371,8 +1385,10 @@ starting with `not' and followed by regexps."
      (:bold t)))
   "Face used for displaying Cc headers."
   :group 'message-faces)
      (:bold t)))
   "Face used for displaying Cc headers."
   :group 'message-faces)
+;; backward-compatibility alias
+(put 'message-header-cc-face 'face-alias 'message-header-cc)
 
 
-(defface message-header-subject-face
+(defface message-header-subject
   '((((class color)
       (background dark))
      (:foreground "green3"))
   '((((class color)
       (background dark))
      (:foreground "green3"))
@@ -1383,8 +1399,10 @@ starting with `not' and followed by regexps."
      (:bold t)))
   "Face used for displaying subject headers."
   :group 'message-faces)
      (:bold t)))
   "Face used for displaying subject headers."
   :group 'message-faces)
+;; backward-compatibility alias
+(put 'message-header-subject-face 'face-alias 'message-header-subject)
 
 
-(defface message-header-newsgroups-face
+(defface message-header-newsgroups
   '((((class color)
       (background dark))
      (:foreground "yellow" :bold t :italic t))
   '((((class color)
       (background dark))
      (:foreground "yellow" :bold t :italic t))
@@ -1395,8 +1413,10 @@ starting with `not' and followed by regexps."
      (:bold t :italic t)))
   "Face used for displaying newsgroups headers."
   :group 'message-faces)
      (:bold t :italic t)))
   "Face used for displaying newsgroups headers."
   :group 'message-faces)
+;; backward-compatibility alias
+(put 'message-header-newsgroups-face 'face-alias 'message-header-newsgroups)
 
 
-(defface message-header-other-face
+(defface message-header-other
   '((((class color)
       (background dark))
      (:foreground "#b00000"))
   '((((class color)
       (background dark))
      (:foreground "#b00000"))
@@ -1407,8 +1427,10 @@ starting with `not' and followed by regexps."
      (:bold t :italic t)))
   "Face used for displaying newsgroups headers."
   :group 'message-faces)
      (:bold t :italic t)))
   "Face used for displaying newsgroups headers."
   :group 'message-faces)
+;; backward-compatibility alias
+(put 'message-header-other-face 'face-alias 'message-header-other)
 
 
-(defface message-header-name-face
+(defface message-header-name
   '((((class color)
       (background dark))
      (:foreground "DarkGreen"))
   '((((class color)
       (background dark))
      (:foreground "DarkGreen"))
@@ -1419,8 +1441,10 @@ starting with `not' and followed by regexps."
      (:bold t)))
   "Face used for displaying header names."
   :group 'message-faces)
      (:bold t)))
   "Face used for displaying header names."
   :group 'message-faces)
+;; backward-compatibility alias
+(put 'message-header-name-face 'face-alias 'message-header-name)
 
 
-(defface message-header-xheader-face
+(defface message-header-xheader
   '((((class color)
       (background dark))
      (:foreground "blue"))
   '((((class color)
       (background dark))
      (:foreground "blue"))
@@ -1431,8 +1455,10 @@ starting with `not' and followed by regexps."
      (:bold t)))
   "Face used for displaying X-Header headers."
   :group 'message-faces)
      (:bold t)))
   "Face used for displaying X-Header headers."
   :group 'message-faces)
+;; backward-compatibility alias
+(put 'message-header-xheader-face 'face-alias 'message-header-xheader)
 
 
-(defface message-separator-face
+(defface message-separator
   '((((class color)
       (background dark))
      (:foreground "blue3"))
   '((((class color)
       (background dark))
      (:foreground "blue3"))
@@ -1443,8 +1469,10 @@ starting with `not' and followed by regexps."
      (:bold t)))
   "Face used for displaying the separator."
   :group 'message-faces)
      (:bold t)))
   "Face used for displaying the separator."
   :group 'message-faces)
+;; backward-compatibility alias
+(put 'message-separator-face 'face-alias 'message-separator)
 
 
-(defface message-cited-text-face
+(defface message-cited-text
   '((((class color)
       (background dark))
      (:foreground "red"))
   '((((class color)
       (background dark))
      (:foreground "red"))
@@ -1455,8 +1483,10 @@ starting with `not' and followed by regexps."
      (:bold t)))
   "Face used for displaying cited text names."
   :group 'message-faces)
      (:bold t)))
   "Face used for displaying cited text names."
   :group 'message-faces)
+;; backward-compatibility alias
+(put 'message-cited-text-face 'face-alias 'message-cited-text)
 
 
-(defface message-mml-face
+(defface message-mml
   '((((class color)
       (background dark))
      (:foreground "ForestGreen"))
   '((((class color)
       (background dark))
      (:foreground "ForestGreen"))
@@ -1467,6 +1497,8 @@ starting with `not' and followed by regexps."
      (:bold t)))
   "Face used for displaying MML."
   :group 'message-faces)
      (:bold t)))
   "Face used for displaying MML."
   :group 'message-faces)
+;; backward-compatibility alias
+(put 'message-mml-face 'face-alias 'message-mml)
 
 (defun message-font-lock-make-header-matcher (regexp)
   (let ((form
 
 (defun message-font-lock-make-header-matcher (regexp)
   (let ((form
@@ -1490,44 +1522,44 @@ starting with `not' and followed by regexps."
   (let ((content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)\n?"))
     `((,(message-font-lock-make-header-matcher
         (concat "^\\([Tt]o:\\)" content))
   (let ((content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)\n?"))
     `((,(message-font-lock-make-header-matcher
         (concat "^\\([Tt]o:\\)" content))
-       (1 'message-header-name-face)
-       (2 'message-header-to-face nil t))
+       (1 'message-header-name)
+       (2 'message-header-to nil t))
       (,(message-font-lock-make-header-matcher
         (concat "^\\([GBF]?[Cc][Cc]:\\|[Rr]eply-[Tt]o:\\|"
                 "[Mm]ail-[Cc]opies-[Tt]o:\\|"
                 "[Mm]ail-[Rr]eply-[Tt]o:\\|"
                 "[Mm]ail-[Ff]ollowup-[Tt]o:\\)" content))
       (,(message-font-lock-make-header-matcher
         (concat "^\\([GBF]?[Cc][Cc]:\\|[Rr]eply-[Tt]o:\\|"
                 "[Mm]ail-[Cc]opies-[Tt]o:\\|"
                 "[Mm]ail-[Rr]eply-[Tt]o:\\|"
                 "[Mm]ail-[Ff]ollowup-[Tt]o:\\)" content))
-       (1 'message-header-name-face)
-       (2 'message-header-cc-face nil t))
+       (1 'message-header-name)
+       (2 'message-header-cc nil t))
       (,(message-font-lock-make-header-matcher
         (concat "^\\([Ss]ubject:\\)" content))
       (,(message-font-lock-make-header-matcher
         (concat "^\\([Ss]ubject:\\)" content))
-       (1 'message-header-name-face)
-       (2 'message-header-subject-face nil t))
+       (1 'message-header-name)
+       (2 'message-header-subject nil t))
       (,(message-font-lock-make-header-matcher
         (concat "^\\([Nn]ewsgroups:\\|Followup-[Tt]o:\\)" content))
       (,(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))
+       (1 'message-header-name)
+       (2 'message-header-newsgroups nil t))
       (,(message-font-lock-make-header-matcher
         (concat "^\\([A-Z][^: \n\t]+:\\)" content))
       (,(message-font-lock-make-header-matcher
         (concat "^\\([A-Z][^: \n\t]+:\\)" content))
-       (1 'message-header-name-face)
-       (2 'message-header-other-face nil t))
+       (1 'message-header-name)
+       (2 'message-header-other nil t))
       (,(message-font-lock-make-header-matcher
         (concat "^\\(X-[A-Za-z0-9-]+:\\|In-Reply-To:\\)" content))
       (,(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))
+       (1 'message-header-name)
+       (2 'message-header-name))
       ,@(if (and mail-header-separator
                 (not (equal mail-header-separator "")))
            `((,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$")
       ,@(if (and mail-header-separator
                 (not (equal mail-header-separator "")))
            `((,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$")
-              1 'message-separator-face))
+              1 'message-separator))
          nil)
       ((lambda (limit)
         (re-search-forward (concat "^\\("
                                    message-cite-prefix-regexp
                                    "\\).*")
                            limit t))
          nil)
       ((lambda (limit)
         (re-search-forward (concat "^\\("
                                    message-cite-prefix-regexp
                                    "\\).*")
                            limit t))
-       (0 'message-cited-text-face))
+       (0 'message-cited-text))
       (,mime-edit-tag-regexp
       (,mime-edit-tag-regexp
-       (0 'message-mml-face))))
+       (0 'message-mml))))
   "Additional expressions to highlight in Message mode.")
 
 ;; XEmacs does it like this.  For Emacs, we have to set the
   "Additional expressions to highlight in Message mode.")
 
 ;; XEmacs does it like this.  For Emacs, we have to set the
@@ -1535,10 +1567,10 @@ starting with `not' and followed by regexps."
 (put 'message-mode 'font-lock-defaults '(message-font-lock-keywords t))
 
 (defvar message-face-alist
 (put 'message-mode 'font-lock-defaults '(message-font-lock-keywords t))
 
 (defvar message-face-alist
-  '((bold . bold-region)
+  '((bold . message-bold-region)
     (underline . underline-region)
     (default . (lambda (b e)
     (underline . underline-region)
     (default . (lambda (b e)
-                (unbold-region b e)
+                (message-unbold-region b e)
                 (ununderline-region b e))))
   "Alist of mail and news faces for facemenu.
 The cdr of each entry is a function for applying the face to a region.")
                 (ununderline-region b e))))
   "Alist of mail and news faces for facemenu.
 The cdr of each entry is a function for applying the face to a region.")
@@ -1602,8 +1634,13 @@ should be sent in several parts.  If it is nil, the size is unlimited."
                 (integer 1000000)))
 
 (defcustom message-alternative-emails nil
                 (integer 1000000)))
 
 (defcustom message-alternative-emails nil
-  "A regexp to match the alternative email addresses.
-The first matched address (not primary one) is used in the From field."
+  "*Regexp matching alternative email addresses.
+The first address in the To, Cc or From headers of the original
+article matching this variable is used as the From field of
+outgoing messages.
+
+This variable has precedence over posting styles and anything that runs
+off `message-setup-hook'."
   :group 'message-headers
   :link '(custom-manual "(message)Message Headers")
   :type '(choice (const :tag "Always use primary" nil)
   :group 'message-headers
   :link '(custom-manual "(message)Message Headers")
   :type '(choice (const :tag "Always use primary" nil)
@@ -1657,7 +1694,7 @@ no, only reply back to the author."
   :type 'boolean)
 
 (defcustom message-user-fqdn nil
   :type 'boolean)
 
 (defcustom message-user-fqdn nil
-  "*Domain part of Messsage-Ids."
+  "*Domain part of Message-Ids."
   :version "22.1"
   :group 'message-headers
   :link '(custom-manual "(message)News Headers")
   :version "22.1"
   :group 'message-headers
   :link '(custom-manual "(message)News Headers")
@@ -1668,8 +1705,13 @@ no, only reply back to the author."
                                   (file-error))
                                 (mm-coding-system-p 'utf-8)
                                 (executable-find idna-program)
                                   (file-error))
                                 (mm-coding-system-p 'utf-8)
                                 (executable-find idna-program)
-                                'ask)
-  "Whether to encode non-ASCII in domain names into ASCII according to IDNA."
+                                (string= (idna-to-ascii "räksmörgÃ¥s")
+                                         "xn--rksmrgs-5wao1o")
+                                t)
+  "Whether to encode non-ASCII in domain names into ASCII according to IDNA.
+GNU Libidn, and in particular the elisp package \"idna.el\" and
+the external program \"idn\", must be installed for this
+functionality to work."
   :version "22.1"
   :group 'message-headers
   :link '(custom-manual "(message)IDNA")
   :version "22.1"
   :group 'message-headers
   :link '(custom-manual "(message)IDNA")
@@ -2055,7 +2097,6 @@ Leading \"Re: \" is not stripped by this function.  Use the function
 
 ;;; Suggested by Jonas Steverud  @  www.dtek.chalmers.se/~d4jonas/
 
 
 ;;; 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>)."
   ;; <URL:http://www.landfield.com/usefor/drafts/draft-ietf-usefor-useage--1.02.unpaged>
 (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>
@@ -2087,32 +2128,31 @@ Leading \"Re: \" is not stripped by this function.  Use the function
                                    " (was: "
                                    old-subject ")\n")))))))))
 
                                    " (was: "
                                    old-subject ")\n")))))))))
 
-;;;###autoload
-(defun message-mark-inserted-region (beg end)
+(defun message-mark-inserted-region (beg end &optional verbatim)
   "Mark some region in the current article with enclosing tags.
   "Mark some region in the current article with enclosing tags.
-See `message-mark-insert-begin' and `message-mark-insert-end'."
-  (interactive "r")
+See `message-mark-insert-begin' and `message-mark-insert-end'.
+If VERBATIM, use slrn style verbatim marks (\"#v+\" and \"#v-\")."
+  (interactive "r\nP")
   (save-excursion
     ;; add to the end of the region first, otherwise end would be invalid
     (goto-char end)
   (save-excursion
     ;; add to the end of the region first, otherwise end would be invalid
     (goto-char end)
-    (insert message-mark-insert-end)
+    (insert (if verbatim "#v-\n" message-mark-insert-end))
     (goto-char beg)
     (goto-char beg)
-    (insert message-mark-insert-begin)))
+    (insert (if verbatim "#v+\n" message-mark-insert-begin))))
 
 
-;;;###autoload
-(defun message-mark-insert-file (file)
+(defun message-mark-insert-file (file &optional verbatim)
   "Insert FILE at point, marking it with enclosing tags.
   "Insert FILE at point, marking it with enclosing tags.
-See `message-mark-insert-begin' and `message-mark-insert-end'."
-  (interactive "fFile to insert: ")
+See `message-mark-insert-begin' and `message-mark-insert-end'.
+If VERBATIM, use slrn style verbatim marks (\"#v+\" and \"#v-\")."
+  (interactive "fFile to insert: \nP")
     ;; reverse insertion to get correct result.
   (let ((p (point)))
     ;; reverse insertion to get correct result.
   (let ((p (point)))
-    (insert message-mark-insert-end)
+    (insert (if verbatim "#v-\n" message-mark-insert-end))
     (goto-char p)
     (insert-file-contents file)
     (goto-char p)
     (goto-char p)
     (insert-file-contents file)
     (goto-char p)
-    (insert message-mark-insert-begin)))
+    (insert (if verbatim "#v+\n" 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
 (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
@@ -2132,7 +2172,6 @@ body, set  `message-archive-note' to nil."
       (message-add-header message-archive-header)
       (message-sort-headers)))
 
       (message-add-header message-archive-header)
       (message-sort-headers)))
 
-;;;###autoload
 (defun message-cross-post-followup-to-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."
 (defun message-cross-post-followup-to-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."
@@ -2176,7 +2215,6 @@ With prefix-argument just set Follow-Up, don't cross-post."
       (insert (concat "\nFollowup-To: " target-group)))
   (setq message-cross-post-old-target target-group))
 
       (insert (concat "\nFollowup-To: " target-group)))
   (setq message-cross-post-old-target target-group))
 
-;;;###autoload
 (defun message-cross-post-insert-note (target-group cross-post in-old
                                                    old-groups)
   "Insert a in message body note about a set Followup or Crosspost.
 (defun message-cross-post-insert-note (target-group cross-post in-old
                                                    old-groups)
   "Insert a in message body note about a set Followup or Crosspost.
@@ -2209,7 +2247,6 @@ been made to before the user asked for a Crosspost."
        (insert (concat message-followup-to-note target-group "\n"))
       (insert (concat message-cross-post-note target-group "\n")))))
 
        (insert (concat message-followup-to-note target-group "\n"))
       (insert (concat message-cross-post-note target-group "\n")))))
 
-;;;###autoload
 (defun message-cross-post-followup-to (target-group)
   "Crossposts message and set Followup-To to TARGET-GROUP.
 With prefix-argument just set Follow-Up, don't cross-post."
 (defun message-cross-post-followup-to (target-group)
   "Crossposts message and set Followup-To to TARGET-GROUP.
 With prefix-argument just set Follow-Up, don't cross-post."
@@ -2251,7 +2288,6 @@ With prefix-argument just set Follow-Up, don't cross-post."
 
 ;;; Reduce To: to Cc: or Bcc: header
 
 
 ;;; 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)
 (defun message-reduce-to-to-cc ()
  "Replace contents of To: header with contents of Cc: or Bcc: header."
  (interactive)
@@ -2497,6 +2533,7 @@ Point is left at the beginning of the narrowed-to region."
   (define-key message-mode-map "\C-c\C-fw" 'message-insert-wide-reply)
   (define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups)
   (define-key message-mode-map "\C-c\C-l" 'message-to-list-only)
   (define-key message-mode-map "\C-c\C-fw" 'message-insert-wide-reply)
   (define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups)
   (define-key message-mode-map "\C-c\C-l" 'message-to-list-only)
+  (define-key message-mode-map "\C-c\C-f\C-e" 'message-insert-expires)
 
   (define-key message-mode-map "\C-c\C-u" 'message-insert-or-toggle-importance)
   (define-key message-mode-map "\C-c\M-n"
 
   (define-key message-mode-map "\C-c\C-u" 'message-insert-or-toggle-importance)
   (define-key message-mode-map "\C-c\M-n"
@@ -2608,7 +2645,8 @@ Point is left at the beginning of the narrowed-to region."
     ;; ["Followup-To (with note in body)" message-cross-post-followup-to t]
     ["Crosspost / Followup-To..." message-cross-post-followup-to t]
     ["Distribution" message-goto-distribution t]
     ;; ["Followup-To (with note in body)" message-cross-post-followup-to t]
     ["Crosspost / Followup-To..." message-cross-post-followup-to t]
     ["Distribution" message-goto-distribution t]
-    ["X-No-Archive:" message-add-archive-header t ]
+    ["Expires" message-insert-expires t ]
+    ["X-No-Archive" message-add-archive-header t ]
     "----"
     ;; (typical) mailing-lists stuff
     ["Fetch To" message-insert-to
     "----"
     ;; (typical) mailing-lists stuff
     ["Fetch To" message-insert-to
@@ -2716,6 +2754,7 @@ 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    move to Mail-Copies-To
         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    move to Mail-Copies-To
+        C-c C-f C-e  move to Expires
         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 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
@@ -3123,13 +3162,14 @@ of lines before the signature intact."
            (end-of-line -1)))
        (unless (= point (point))
          (kill-region point (point))
            (end-of-line -1)))
        (unless (= point (point))
          (kill-region point (point))
-         (insert "\n"))))))
+         (unless (bolp)
+           (insert "\n")))))))
 
 (defun message-newline-and-reformat (&optional arg not-break)
   "Insert four newlines, and then reformat if inside quoted text.
 Prefix arg means justify as well."
   (interactive (list (if current-prefix-arg 'full)))
 
 (defun message-newline-and-reformat (&optional arg not-break)
   "Insert four newlines, and then reformat if inside quoted text.
 Prefix arg means justify as well."
   (interactive (list (if current-prefix-arg 'full)))
-  (let (quoted point beg end leading-space bolp)
+  (let (quoted point beg end leading-space bolp fill-paragraph-function)
     (setq point (point))
     (beginning-of-line)
     (setq beg (point))
     (setq point (point))
     (beginning-of-line)
     (setq beg (point))
@@ -3214,7 +3254,9 @@ Prefix arg means justify as well."
       (if point (goto-char point)))))
 
 (defun message-fill-paragraph (&optional arg)
       (if point (goto-char point)))))
 
 (defun message-fill-paragraph (&optional arg)
-  "Like `fill-paragraph'."
+  "Message specific function to fill a paragraph.
+This function is used as the value of `fill-paragraph-function' in
+Message buffers and is not meant to be called directly."
   (interactive (list (if current-prefix-arg 'full)))
   (if (if (boundp 'filladapt-mode) filladapt-mode)
       nil
   (interactive (list (if current-prefix-arg 'full)))
   (if (if (boundp 'filladapt-mode) filladapt-mode)
       nil
@@ -3478,9 +3520,12 @@ However, if `message-yank-prefix' is non-nil, insert that prefix on each line."
       (save-excursion
        (goto-char start)
        (while (< (point) (mark t))
       (save-excursion
        (goto-char start)
        (while (< (point) (mark t))
-         (if (or (looking-at ">") (looking-at "^$"))
-             (insert message-yank-cited-prefix)
-           (insert message-yank-prefix))
+         (cond ((looking-at ">")
+                (insert message-yank-cited-prefix))
+               ((looking-at "^$")
+                (insert message-yank-empty-prefix))
+               (t
+                (insert message-yank-prefix)))
          (forward-line 1))))
     (goto-char start)))
 
          (forward-line 1))))
     (goto-char start)))
 
@@ -3530,8 +3575,10 @@ be added to the \"References\" field."
                 (prog1
                     t
                   (delete-windows-on buffer t)
                 (prog1
                     t
                   (delete-windows-on buffer t)
-                  ; The mark will be set at the end of the article.
-                  (insert-buffer buffer))))
+                  ; Set the mark at the end of the yanked message.
+                  (push-mark (save-excursion
+                               (insert-buffer-substring buffer)
+                               (point))))))
       ;; Add new IDs to the References field.
       (when (and message-yank-add-new-references
                 (interactive-p))
       ;; Add new IDs to the References field.
       (when (and message-yank-add-new-references
                 (interactive-p))
@@ -3612,49 +3659,14 @@ be added to the \"References\" field."
          (push (buffer-name buffer) buffers))))
     (nreverse buffers)))
 
          (push (buffer-name buffer) buffers))))
     (nreverse buffers)))
 
-(defun message-cite-original-without-signature ()
-  "Cite function in the standard Message manner."
-  (let ((start (point))
-       (end (mark t))
-       (functions
-        (when message-indent-citation-function
-          (if (listp message-indent-citation-function)
-              message-indent-citation-function
-            (list message-indent-citation-function))))
-       (message-reply-headers (or message-reply-headers
-                                  (make-mail-header))))
-    (mail-header-set-from message-reply-headers
-                         (save-restriction
-                           (narrow-to-region
-                            (point)
-                            (if (search-forward "\n\n" nil t)
-                                (1- (point))
-                              (point-max)))
-                           (or (message-fetch-field "from")
-                               "unknown sender")))
-    ;; Allow undoing.
-    (undo-boundary)
-    (goto-char end)
-    (when (re-search-backward message-signature-separator start t)
-      ;; Also peel off any blank lines before the signature.
-      (forward-line -1)
-      (while (looking-at "^[ \t]*$")
-       (forward-line -1))
-      (forward-line 1)
-      (delete-region (point) end)
-      (unless (search-backward "\n\n" start t)
-       ;; Insert a blank line if it is peeled off.
-       (insert "\n")))
-    (goto-char start)
-    (mapc 'funcall functions)
-    (when message-citation-line-function
-      (unless (bolp)
-       (insert "\n"))
-      (funcall message-citation-line-function))))
+(eval-when-compile (defvar mail-citation-hook))        ; Compiler directive
 
 
-(eval-when-compile (defvar mail-citation-hook))                ;Compiler directive
-(defun message-cite-original ()
-  "Cite function in the standard Message manner."
+(defun message-cite-original-1 (strip-signature)
+  "Cite an original message.
+If STRIP-SIGNATURE is non-nil, strips off the signature from the
+original message.
+
+This function uses `mail-citation-hook' if that is non-nil."
   (if (and (boundp 'mail-citation-hook)
           mail-citation-hook)
       (run-hooks 'mail-citation-hook)
   (if (and (boundp 'mail-citation-hook)
           mail-citation-hook)
       (run-hooks 'mail-citation-hook)
@@ -3678,6 +3690,20 @@ be added to the \"References\" field."
        (setq x-no-archive (message-fetch-field "x-no-archive")))
       (goto-char start)
       (mapc 'funcall functions)
        (setq x-no-archive (message-fetch-field "x-no-archive")))
       (goto-char start)
       (mapc 'funcall functions)
+      (when strip-signature
+       ;; Allow undoing.
+       (undo-boundary)
+       (goto-char end)
+       (when (re-search-backward message-signature-separator start t)
+         ;; Also peel off any blank lines before the signature.
+         (forward-line -1)
+         (while (looking-at "^[ \t]*$")
+           (forward-line -1))
+         (forward-line 1)
+         (delete-region (point) end)
+         (unless (search-backward "\n\n" start t)
+           ;; Insert a blank line if it is peeled off.
+           (insert "\n"))))
       (when message-citation-line-function
        (unless (bolp)
          (insert "\n"))
       (when message-citation-line-function
        (unless (bolp)
          (insert "\n"))
@@ -3690,6 +3716,15 @@ be added to the \"References\" field."
        (insert "> [Quoted text removed due to X-No-Archive]\n")
        (forward-line -1)))))
 
        (insert "> [Quoted text removed due to X-No-Archive]\n")
        (forward-line -1)))))
 
+(defun message-cite-original ()
+  "Cite function in the standard Message manner."
+  (message-cite-original-1 nil))
+
+(defun message-cite-original-without-signature ()
+  "Cite function in the standard Message manner.
+This function strips off the signature from the original message."
+  (message-cite-original-1 t))
+
 (defun message-insert-citation-line ()
   "Insert a simple citation line."
   (when message-reply-headers
 (defun message-insert-citation-line ()
   "Insert a simple citation line."
   (when message-reply-headers
@@ -3791,7 +3826,7 @@ Instead, just auto-save the buffer and then bury it."
   "Kill the current buffer."
   (interactive)
   (when (or (not (buffer-modified-p))
   "Kill the current buffer."
   (interactive)
   (when (or (not (buffer-modified-p))
-           (not message-kill-buffer-query-if-modified)
+           (not message-kill-buffer-query)
            (eq t message-kill-buffer-query-function)
            (funcall message-kill-buffer-query-function
                     "The buffer modified; kill anyway? "))
            (eq t message-kill-buffer-query-function)
            (funcall message-kill-buffer-query-function
                     "The buffer modified; kill anyway? "))
@@ -4778,7 +4813,7 @@ Otherwise, generate and save a value for `canlock-password' first."
                   (zerop
                    (length
                     (setq to (completing-read
                   (zerop
                    (length
                     (setq to (completing-read
-                              "Followups to (default: no Followup-To header) "
+                              "Followups to (default no Followup-To header): "
                               (mapcar #'list
                                       (cons "poster"
                                             (message-tokenize-header
                               (mapcar #'list
                                       (cons "poster"
                                             (message-tokenize-header
@@ -5236,6 +5271,22 @@ If NOW, use that time instead."
     (concat "Re: " (message-strip-subject-re subject)))
    (t subject)))
 
     (concat "Re: " (message-strip-subject-re subject)))
    (t subject)))
 
+(defun message-insert-expires (days)
+  "Insert the Expires header.  Expiry in DAYS days."
+  (interactive "NExpire article in how many days? ")
+  (save-excursion
+    (message-position-on-field "Expires" "X-Draft-From")
+    (insert (message-make-expires-date days))))
+
+(defun message-make-expires-date (days)
+  "Make date string for the Expires header.  Expiry in DAYS days.
+
+In posting styles use `(\"Expires\" (make-expires-date 30))'."
+  (let* ((cur (decode-time (current-time)))
+        (nday (+ days (nth 3 cur))))
+    (setf (nth 3 cur) nday)
+    (message-make-date (apply 'encode-time cur))))
+
 (defun message-make-message-id ()
   "Make a unique Message-ID."
   (concat "<" (message-unique-id)
 (defun message-make-message-id ()
   "Make a unique Message-ID."
   (concat "<" (message-unique-id)
@@ -5592,13 +5643,17 @@ subscribed address (and not the additional To and Cc header contents)."
   (let ((field (message-fetch-field header))
        rhs ace  address)
     (when field
   (let ((field (message-fetch-field header))
        rhs ace  address)
     (when field
-      (dolist (address (mail-header-parse-addresses field))
-       (setq address (car address)
-             rhs (downcase (or (cadr (split-string address "@")) ""))
-             ace (downcase (idna-to-ascii rhs)))
+      (dolist (rhs
+              (mm-delete-duplicates
+               (mapcar (lambda (rhs) (or (cadr (split-string rhs "@")) ""))
+                       (mapcar 'downcase
+                               (mapcar
+                                'car (mail-header-parse-addresses field))))))
+       (setq ace (downcase (idna-to-ascii rhs)))
        (when (and (not (equal rhs ace))
                   (or (not (eq message-use-idna 'ask))
        (when (and (not (equal rhs ace))
                   (or (not (eq message-use-idna 'ask))
-                      (y-or-n-p (format "Replace %s with %s? " rhs ace))))
+                      (y-or-n-p (format "Replace %s with %s in %s:? "
+                                        rhs ace header))))
          (goto-char (point-min))
          (while (re-search-forward (concat "^" header ":") nil t)
            (message-narrow-to-field)
          (goto-char (point-min))
          (while (re-search-forward (concat "^" header ":") nil t)
            (message-narrow-to-field)
@@ -5618,6 +5673,8 @@ See `message-idna-encode'."
        (message-idna-to-ascii-rhs-1 "From")
        (message-idna-to-ascii-rhs-1 "To")
        (message-idna-to-ascii-rhs-1 "Reply-To")
        (message-idna-to-ascii-rhs-1 "From")
        (message-idna-to-ascii-rhs-1 "To")
        (message-idna-to-ascii-rhs-1 "Reply-To")
+       (message-idna-to-ascii-rhs-1 "Mail-Reply-To")
+       (message-idna-to-ascii-rhs-1 "Mail-Followup-To")
        (message-idna-to-ascii-rhs-1 "Cc")))))
 
 (defun message-generate-headers (headers)
        (message-idna-to-ascii-rhs-1 "Cc")))))
 
 (defun message-generate-headers (headers)
@@ -6200,11 +6257,6 @@ are not included."
     (when message-default-mail-headers
       (insert message-default-mail-headers)
       (or (bolp) (insert ?\n)))
     (when message-default-mail-headers
       (insert message-default-mail-headers)
       (or (bolp) (insert ?\n)))
-    (save-restriction
-      (message-narrow-to-headers)
-      (if (and replybuffer
-              message-alternative-emails)
-         (message-use-alternative-email-as-from)))
     (when message-generate-headers-first
       (message-generate-headers
        (message-headers-to-generate
     (when message-generate-headers-first
       (message-generate-headers
        (message-headers-to-generate
@@ -6223,6 +6275,12 @@ are not included."
     ;; Generate hashcash headers for recipients already known
     (mail-add-payment-async))
   (run-hooks 'message-setup-hook)
     ;; Generate hashcash headers for recipients already known
     (mail-add-payment-async))
   (run-hooks 'message-setup-hook)
+  ;; Do this last to give it precedence over posting styles, etc.
+  (when (message-mail-p)
+    (save-restriction
+      (message-narrow-to-headers)
+      (if message-alternative-emails
+         (message-use-alternative-email-as-from))))
   (message-position-point)
   (undo-boundary))
 
   (message-position-point)
   (undo-boundary))
 
@@ -6707,9 +6765,9 @@ that further discussion should take place only in "
 
 (defun message-is-yours-p ()
   "Non-nil means current article is yours.
 
 (defun message-is-yours-p ()
   "Non-nil means current article is yours.
-If you have added 'cancel-messages to 'message-shoot-gnksa-feet', all articles
+If you have added 'cancel-messages to `message-shoot-gnksa-feet', all articles
 are yours except those that have Cancel-Lock header not belonging to you.
 are yours except those that have Cancel-Lock header not belonging to you.
-Instead of shooting GNKSA feet, you should modify 'message-alternative-emails'
+Instead of shooting GNKSA feet, you should modify `message-alternative-emails'
 regexp to match all of yours addresses."
   ;; Canlock-logic as suggested by Per Abrahamsen
   ;; <abraham@dina.kvl.dk>
 regexp to match all of yours addresses."
   ;; Canlock-logic as suggested by Per Abrahamsen
   ;; <abraham@dina.kvl.dk>
@@ -7290,7 +7348,7 @@ you."
 ;; This code should be moved to underline.el (from which it is stolen).
 
 ;;;###autoload
 ;; This code should be moved to underline.el (from which it is stolen).
 
 ;;;###autoload
-(defun bold-region (start end)
+(defun message-bold-region (start end)
   "Bold all nonblank characters in the region.
 Works by overstriking characters.
 Called from program, takes two arguments START and END
   "Bold all nonblank characters in the region.
 Works by overstriking characters.
 Called from program, takes two arguments START and END
@@ -7306,7 +7364,7 @@ which specify the range to operate on."
        (forward-char 1)))))
 
 ;;;###autoload
        (forward-char 1)))))
 
 ;;;###autoload
-(defun unbold-region (start end)
+(defun message-unbold-region (start end)
   "Remove all boldness (overstruck characters) in the region.
 Called from program, takes two arguments START and END
 which specify the range to operate on."
   "Remove all boldness (overstruck characters) in the region.
 Called from program, takes two arguments START and END
 which specify the range to operate on."
@@ -7438,7 +7496,8 @@ If nil, the function bound in `text-mode-map' or `global-map' is executed."
   :version "22.1"
   :group 'message
   :link '(custom-manual "(message)Various Commands")
   :version "22.1"
   :group 'message
   :link '(custom-manual "(message)Various Commands")
-  :type 'function)
+  :type '(choice (const nil)
+                function))
 
 (defun message-tab ()
   "Complete names according to `message-completion-alist'.
 
 (defun message-tab ()
   "Complete names according to `message-completion-alist'.
@@ -7670,6 +7729,9 @@ regexp VARSTR."
       (read-string prompt initial-contents))))
 
 (defun message-use-alternative-email-as-from ()
       (read-string prompt initial-contents))))
 
 (defun message-use-alternative-email-as-from ()
+  "Set From field of the outgoing message to the first matching
+address in `message-alternative-emails', looking at To, Cc and
+From headers in the original article."
   (require 'mail-utils)
   (let* ((fields '("To" "Cc" "From"))
         (emails
   (require 'mail-utils)
   (let* ((fields '("To" "Cc" "From"))
         (emails
@@ -7684,6 +7746,7 @@ regexp VARSTR."
                emails nil))
       (pop emails))
     (unless (or (not email) (equal email user-mail-address))
                emails nil))
       (pop emails))
     (unless (or (not email) (equal email user-mail-address))
+      (message-remove-header "From")
       (goto-char (point-max))
       (insert "From: " (let ((user-mail-address email)) (message-make-from))
              "\n"))))
       (goto-char (point-max))
       (insert "From: " (let ((user-mail-address email)) (message-make-from))
              "\n"))))