(gmm): Add :version.

[gnus] / lisp / message.el

diff --git a/lisp/message.el b/lisp/message.el
index 4acc4c5..bdb57da 100644 (file)
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -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, 2006 Free Software Foundation, Inc.

 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: mail, news
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: mail, news


@@ -911,7 +912,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 sc-cite-original)
   :type '(radio (function-item message-cite-original)
                (function-item message-cite-original-without-signature)
                (function-item sc-cite-original)


@@ -1366,10 +1367,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.")


@@ -1424,8 +1425,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)


@@ -1490,8 +1496,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")


@@ -1652,6 +1663,7 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'."
   (autoload 'gnus-request-post "gnus-int")
   (autoload 'gnus-server-string "gnus")
   (autoload 'idna-to-ascii "idna")
   (autoload 'gnus-request-post "gnus-int")
   (autoload 'gnus-server-string "gnus")
   (autoload 'idna-to-ascii "idna")

+  (autoload 'gmm-tool-bar-from-list "gmm-utils")

   (autoload 'message-setup-toolbar "messagexmas")
   (autoload 'mh-new-draft-name "mh-comp")
   (autoload 'mh-send-letter "mh-comp")
   (autoload 'message-setup-toolbar "messagexmas")
   (autoload 'mh-new-draft-name "mh-comp")
   (autoload 'mh-send-letter "mh-comp")


@@ -1859,7 +1871,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>


@@ -1891,32 +1902,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


@@ -1936,7 +1946,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."


@@ -1980,7 +1989,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.


@@ -2013,7 +2021,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."


@@ -2055,7 +2062,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)


@@ -2247,6 +2253,17 @@ Point is left at the beginning of the narrowed-to region."
     (message-skip-to-next-address)
     (kill-region start (point))))
 
     (message-skip-to-next-address)
     (kill-region start (point))))
 

+
+(defun message-info (&optional arg)
+  "Display the Message manual.
+
+Prefixed with one \\[universal-argument], display the Emacs MIME manual.
+Prefixed with two \\[universal-argument]'s, display the PGG manual."
+  (interactive "p")
+  (cond ((eq arg 16) (Info-goto-node "(pgg)Top"))
+       ((eq arg  4) (Info-goto-node "(emacs-mime)Top"))
+       (t           (Info-goto-node "(message)Top"))))
+

 \f
 
 ;;;
 \f
 
 ;;;


@@ -2298,6 +2315,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"


@@ -2373,7 +2391,11 @@ Point is left at the beginning of the narrowed-to region."
         '(:help "Ask, then arrange to send message at that time"))]
     ["Kill Message" message-kill-buffer
      ,@(if (featurep 'xemacs) '(t)
         '(:help "Ask, then arrange to send message at that time"))]
     ["Kill Message" message-kill-buffer
      ,@(if (featurep 'xemacs) '(t)

-        '(:help "Delete this message without sending"))]))
+        '(:help "Delete this message without sending"))]
+    "----"
+    ["Message manual" message-info
+     ,@(if (featurep 'xemacs) '(t)
+        '(:help "Display the Message manual"))]))

 
 (easy-menu-define
   message-mode-field-menu message-mode-map ""
 
 (easy-menu-define
   message-mode-field-menu message-mode-map ""


@@ -2406,7 +2428,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


@@ -2426,6 +2449,8 @@ Point is left at the beginning of the narrowed-to region."
     "----"
     ["Sort Headers" message-sort-headers t]
     ["Encode non-ASCII domain names" message-idna-to-ascii-rhs t]
     "----"
     ["Sort Headers" message-sort-headers t]
     ["Encode non-ASCII domain names" message-idna-to-ascii-rhs t]

+    ;; We hide `message-hidden-headers' by narrowing the buffer.
+    ["Show Hidden Headers" widen t]

     ["Goto Body" message-goto-body t]
     ["Goto Signature" message-goto-signature t]))
 
     ["Goto Body" message-goto-body t]
     ["Goto Signature" message-goto-signature t]))
 


@@ -2509,6 +2534,7 @@ C-c C-f  move to a header field (and create it if there isn't):
          C-c C-f C-o  move to From (\"Originator\")
         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-o  move to From (\"Originator\")
         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-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


@@ -2568,7 +2594,7 @@ M-RET    `message-newline-and-reformat' (break the line and reformat)."
     (set (make-local-variable 'font-lock-defaults)
         '(message-font-lock-keywords t))
     (if (boundp 'tool-bar-map)
     (set (make-local-variable 'font-lock-defaults)
         '(message-font-lock-keywords t))
     (if (boundp 'tool-bar-map)

-       (set (make-local-variable 'tool-bar-map) (message-tool-bar-map))))
+       (set (make-local-variable 'tool-bar-map) (message-make-tool-bar))))

   (easy-menu-add message-mode-menu message-mode-map)
   (easy-menu-add message-mode-field-menu message-mode-map)
   (gnus-make-local-hook 'after-change-functions)
   (easy-menu-add message-mode-menu message-mode-map)
   (easy-menu-add message-mode-field-menu message-mode-map)
   (gnus-make-local-hook 'after-change-functions)


@@ -2723,6 +2749,11 @@ M-RET    `message-newline-and-reformat' (break the line and reformat)."
   (message-goto-body)
   (forward-line -1))
 
   (message-goto-body)
   (forward-line -1))
 

+(defun message-in-body-p ()
+  "Return t if point is in the message body."
+  (let ((body (save-excursion (message-goto-body) (point))))
+    (>= (point) body)))
+

 (defun message-goto-signature ()
   "Move point to the beginning of the message signature.
 If there is no signature in the article, go to the end and
 (defun message-goto-signature ()
   "Move point to the beginning of the message signature.
 If there is no signature in the article, go to the end and


@@ -2884,7 +2915,7 @@ or in the synonym headers, defined by `message-header-synonyms'."
   "Kill all text up to the signature.
 If a numberic argument or prefix arg is given, leave that number
 of lines before the signature intact."
   "Kill all text up to the signature.
 If a numberic argument or prefix arg is given, leave that number
 of lines before the signature intact."

-  (interactive "p")
+  (interactive "P")

   (save-excursion
     (save-restriction
       (let ((point (point)))
   (save-excursion
     (save-restriction
       (let ((point (point)))


@@ -2988,7 +3019,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


@@ -3303,65 +3336,14 @@ prefix, and don't delete any headers."
          (push (buffer-name buffer) buffers))))
     (nreverse buffers)))
 
          (push (buffer-name buffer) buffers))))
     (nreverse buffers)))
 

-;; FIXME: the following function duplicates `message-cite-original'
-;; almost in entirety, merging the two would be nice.
-(defun message-cite-original-without-signature ()
-  "Cite function in the standard Message manner, excluding the
-signature."
-  (let* ((start (point))
-        (end (mark t))
-        (x-no-archive nil)
-        (functions
-         (when message-indent-citation-function
-           (if (listp message-indent-citation-function)
-               message-indent-citation-function
-             (list message-indent-citation-function))))
-        ;; This function may be called by `gnus-summary-yank-message' and
-        ;; may insert a different article from the original.  So, we will
-        ;; modify the value of `message-reply-headers' with that article.
-        (message-reply-headers
-         (save-restriction
-           (narrow-to-region start end)
-           (message-narrow-to-head-1)
-           (setq x-no-archive (message-fetch-field "x-no-archive"))
-           (vector 0
-                   (or (message-fetch-field "subject") "none")
-                   (message-fetch-field "from")
-                   (message-fetch-field "date")
-                   (message-fetch-field "message-id" t)
-                   (message-fetch-field "references")
-                   0 0 ""))))
-    (mml-quote-region start end)
-    ;; 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))
-    (when (and x-no-archive
-              (not message-cite-articles-with-x-no-archive)
-              (string-match "yes" x-no-archive))
-      (undo-boundary)
-      (delete-region (point) (mark t))
-      (insert "> [Quoted text removed due to X-No-Archive]\n")
-      (forward-line -1))))
+(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)


@@ -3389,6 +3371,20 @@ signature."
                      (message-fetch-field "references")
                      0 0 ""))))
       (mml-quote-region start end)
                      (message-fetch-field "references")
                      0 0 ""))))
       (mml-quote-region start end)

+      (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"))))

       (goto-char start)
       (mapc 'funcall functions)
       (when message-citation-line-function
       (goto-char start)
       (mapc 'funcall functions)
       (when message-citation-line-function


@@ -3403,10 +3399,21 @@ signature."
        (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

-    (insert (mail-header-from message-reply-headers) " writes:\n\n")))
+    (insert (mail-header-from message-reply-headers) " writes:")
+    (newline)
+    (newline)))

 
 (defun message-position-on-field (header &rest afters)
   (let ((case-fold-search t))
 
 (defun message-position-on-field (header &rest afters)
   (let ((case-fold-search t))


@@ -3700,7 +3707,7 @@ not have PROP."
          (when (let ((char (char-after)))
                  (or (< (mm-char-int char) 128)
                      (and (mm-multibyte-p)
          (when (let ((char (char-after)))
                  (or (< (mm-char-int char) 128)
                      (and (mm-multibyte-p)

-                          ;; Fixme: Wrong for Emacs 22 and for things
+                          ;; Fixme: Wrong for Emacs 23 and for things

                           ;; like undecable utf-8.  Should at least
                           ;; use find-coding-systems-region.
                           (memq (char-charset char)
                           ;; like undecable utf-8.  Should at least
                           ;; use find-coding-systems-region.
                           (memq (char-charset char)


@@ -4305,7 +4312,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


@@ -4708,6 +4715,22 @@ If NOW, use that time instead."
   (let ((system-time-locale "C"))
     (format-time-string "%a, %d %b %Y %T %z" now)))
 
   (let ((system-time-locale "C"))
     (format-time-string "%a, %d %b %Y %T %z" now)))
 

+(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)


@@ -5047,13 +5070,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)


@@ -5073,6 +5100,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)


@@ -5164,7 +5193,8 @@ Headers already prepared in the buffer are not modified."
                  ;; The element is a symbol.  We insert the value
                  ;; of this symbol, if any.
                  (symbol-value header))
                  ;; The element is a symbol.  We insert the value
                  ;; of this symbol, if any.
                  (symbol-value header))

-                ((not (message-check-element header))
+                ((not (message-check-element
+                       (intern (downcase (symbol-name header)))))

                  ;; We couldn't generate a value for this header,
                  ;; so we just ask the user.
                  (read-from-minibuffer
                  ;; We couldn't generate a value for this header,
                  ;; so we just ask the user.
                  (read-from-minibuffer


@@ -5192,7 +5222,7 @@ Headers already prepared in the buffer are not modified."
                ;; totally and insert the new value.
                (delete-region (point) (point-at-eol))
                ;; If the header is optional, and the header was
                ;; totally and insert the new value.
                (delete-region (point) (point-at-eol))
                ;; If the header is optional, and the header was

-               ;; empty, we con't insert it anyway.
+               ;; empty, we can't insert it anyway.

                (unless optionalp
                  (push header-string message-inserted-headers)
                  (insert value)
                (unless optionalp
                  (push header-string message-inserted-headers)
                  (insert value)


@@ -5632,10 +5662,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 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


@@ -5654,6 +5680,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))
 


@@ -6235,7 +6267,9 @@ news, Source is the list of newsgroups is was posted to."
         (prefix
          (if group
              (gnus-group-decoded-name group)
         (prefix
          (if group
              (gnus-group-decoded-name group)

-           (or (and from (car (gnus-extract-address-components from)))
+           (or (and from (or
+                          (car (gnus-extract-address-components from))
+                          (cadr (gnus-extract-address-components from))))

                "(nowhere)"))))
     (concat "["
            (if message-forward-decoded-p
                "(nowhere)"))))
     (concat "["
            (if message-forward-decoded-p


@@ -6622,7 +6656,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


@@ -6638,7 +6672,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."


@@ -6671,51 +6705,110 @@ which specify the range to operate on."
   (defvar tool-bar-map)
   (defvar tool-bar-mode))
 
   (defvar tool-bar-map)
   (defvar tool-bar-mode))
 

-(defun message-tool-bar-local-item-from-menu (command icon in-map &optional from-map &rest props)
-  ;; We need to make tool bar entries in local keymaps with
-  ;; `tool-bar-local-item-from-menu' in Emacs > 21.3
-  (if (fboundp 'tool-bar-local-item-from-menu)
-      ;; This is for Emacs 21.3
-      (tool-bar-local-item-from-menu command icon in-map from-map props)
-    (tool-bar-add-item-from-menu command icon from-map props)))
-
-(defun message-tool-bar-map ()
-  (or message-tool-bar-map
-      (setq message-tool-bar-map
-           (and
-            (condition-case nil (require 'tool-bar) (error nil))
-            (fboundp 'tool-bar-add-item-from-menu)
-            tool-bar-mode
-            (let ((tool-bar-map (copy-keymap tool-bar-map))
-                  (load-path (mm-image-load-path)))
-              ;; Zap some items which aren't so relevant and take
-              ;; up space.
-              (dolist (key '(print-buffer kill-buffer save-buffer
-                                          write-file dired open-file))
-                (define-key tool-bar-map (vector key) nil))
-              (message-tool-bar-local-item-from-menu
-               'message-send-and-exit "mail_send" tool-bar-map message-mode-map)
-              (message-tool-bar-local-item-from-menu
-               'message-kill-buffer "close" tool-bar-map message-mode-map)
-              (message-tool-bar-local-item-from-menu
-                   'message-dont-send "cancel" tool-bar-map message-mode-map)
-              (message-tool-bar-local-item-from-menu
-               'mml-attach-file "attach" tool-bar-map mml-mode-map)
-              (message-tool-bar-local-item-from-menu
-               'ispell-message "spell" tool-bar-map message-mode-map)
-              (message-tool-bar-local-item-from-menu
-               'mml-preview "preview"
-               tool-bar-map mml-mode-map)
-              (message-tool-bar-local-item-from-menu
-               'message-insert-importance-high "important"
-               tool-bar-map message-mode-map)
-              (message-tool-bar-local-item-from-menu
-               'message-insert-importance-low "unimportant"
-               tool-bar-map message-mode-map)
-              (message-tool-bar-local-item-from-menu
-               'message-insert-disposition-notification-to "receipt"
-               tool-bar-map message-mode-map)
-              tool-bar-map)))))
+;; Note: The :set function in the `message-tool-bar*' variables will only
+;; affect _new_ message buffers.  We might add a function that walks thru all
+;; message-mode buffers and force the update.
+(defun message-tool-bar-update (&optional symbol value)
+  "Update message mode toolbar.
+Setter function for custom variables."
+  (if symbol
+      ;; When used as ":set" function:
+      (progn
+       (set-default symbol value)
+       (setq-default message-tool-bar-map nil))
+    (message-make-tool-bar t)))
+
+;; The default will be changed when the new icons have been checked in:
+(defcustom message-tool-bar 'message-tool-bar-retro
+  "Specifies the message mode tool bar.
+
+It can be either a list or a symbol refering to a list.  See
+`gmm-tool-bar-from-list' for the format of the list.  The
+default key map is `message-mode-map'.
+
+Pre-defined symbols include `message-tool-bar-gnome' and
+`message-tool-bar-retro'."
+  :type '(repeat gmm-tool-bar-list-item)
+  :type '(choice (const :tag "GNOME style" message-tool-bar-gnome)
+                (const :tag "Retro look"  message-tool-bar-retro)
+                (repeat :tag "User defined list" gmm-tool-bar-item)
+                (symbol))
+  :version "23.0" ;; No Gnus
+  :initialize 'custom-initialize-default
+  :set 'message-tool-bar-update
+  :group 'message)
+
+;; The new icons are not yet committed, see
+;; http://thread.gmane.org/gmane.emacs.gnus.general/61719
+(defcustom message-tool-bar-gnome
+  '((gmm-ignore "separator")
+    (message-send-and-exit "send")
+    (message-dont-send "save-draft")
+    (message-kill-buffer "close") ;; stock_cancel
+    (mml-attach-file "attach" mml-mode-map)
+    (ispell-message "spell" nil :visible (not flyspell-mode))
+    (flyspell-buffer "spell" t :visible flyspell-mode
+                    :help "Flyspell whole buffer")
+    ;; We should have a mail-preview icon with an envelope like the one in
+    ;; stock_mail-reply.
+    (mml-preview "mail-preview" mml-mode-map)
+    (mml-secure-message-sign-encrypt "lock" mml-mode-map :visible nil)
+    (message-insert-importance-high "important" nil :visible nil)
+    (message-insert-importance-low "unimportant" nil :visible nil)
+    (message-insert-disposition-notification-to "receipt" nil :visible nil)
+    (message-info "help" t :help "Message manual"))
+  "List of items for the message tool bar (GNOME style).
+
+See `gmm-tool-bar-from-list' for details on the format of the list."
+  :type '(repeat gmm-tool-bar-item)
+  :version "23.0" ;; No Gnus
+  :initialize 'custom-initialize-default
+  :set 'message-tool-bar-update
+  :group 'message)
+
+(defcustom message-tool-bar-retro
+  '((message-send-and-exit "mail/send")
+    (message-kill-buffer "close")
+    (message-dont-send "cancel")
+    (mml-attach-file "attach" mml-mode-map)
+    (ispell-message "spell")
+    (mml-preview "preview" mml-mode-map)
+    (message-insert-importance-high "important")
+    (message-insert-importance-low "unimportant")
+    (message-insert-disposition-notification-to "receipt"))
+  "List of items for the message tool bar (retro style).
+
+See `gmm-tool-bar-from-list' for details on the format of the list."
+  :type '(repeat gmm-tool-bar-item)
+  :version "23.0" ;; No Gnus
+  :initialize 'custom-initialize-default
+  :set 'message-tool-bar-update
+  :group 'message)
+
+(defcustom message-tool-bar-zap-list
+  '(new-file open-file dired kill-buffer write-file
+            print-buffer customize help)
+  "List of icon items from the global tool bar.
+These items are not displayed on the message mode tool bar.
+
+See `gmm-tool-bar-from-list' for the format of the list."
+  :type 'gmm-tool-bar-zap-list
+  :version "23.0" ;; No Gnus
+  :initialize 'custom-initialize-default
+  :set 'message-tool-bar-update
+  :group 'message)
+
+(defun message-make-tool-bar (&optional force)
+  "Make a message mode tool bar from `message-tool-bar-list'.
+When FORCE, rebuild the tool bar."
+  (when (or (not message-tool-bar-map) force)
+    (setq message-tool-bar-map
+         (when (default-value 'tool-bar-mode)
+           (let ((load-path (mm-image-load-path)))
+             (gmm-tool-bar-from-list message-tool-bar
+                                         message-tool-bar-zap-list
+                                         'message-mode-map)))))
+  message-tool-bar-map)

 
 ;;; Group name completion.
 
 
 ;;; Group name completion.
 


@@ -6750,7 +6843,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'.


@@ -6767,6 +6861,17 @@ those headers."
                 (lookup-key global-map "\t")
                 'indent-relative))))
 
                 (lookup-key global-map "\t")
                 'indent-relative))))
 

+(eval-and-compile
+  (condition-case nil
+      (with-temp-buffer
+       (let ((standard-output (current-buffer)))
+         (eval '(display-completion-list nil "")))
+       (defalias 'message-display-completion-list 'display-completion-list))
+    (error ;; Don't use `wrong-number-of-arguments' here because of XEmacs.
+     (defun message-display-completion-list (completions &optional ignore)
+       "Display the list of completions, COMPLETIONS, using `standard-output'."
+       (display-completion-list completions)))))
+

 (defun message-expand-group ()
   "Expand the group name under point."
   (let* ((b (save-excursion
 (defun message-expand-group ()
   "Expand the group name under point."
   (let* ((b (save-excursion


@@ -6805,7 +6910,9 @@ those headers."
          (let ((buffer-read-only nil))
            (erase-buffer)
            (let ((standard-output (current-buffer)))
          (let ((buffer-read-only nil))
            (erase-buffer)
            (let ((standard-output (current-buffer)))

-             (display-completion-list (sort completions 'string<)))
+             (message-display-completion-list (sort completions 'string<)
+                                              string))
+           (setq buffer-read-only nil)

            (goto-char (point-min))
            (delete-region (point) (progn (forward-line 3) (point))))))))))
 
            (goto-char (point-min))
            (delete-region (point) (progn (forward-line 3) (point))))))))))
 


@@ -6940,6 +7047,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


@@ -6954,6 +7064,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"))))