X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fmessage.el;h=bf8dd1767e3a1ebf3b4b6e3ba5a890e85ee2130e;hb=348ca824b5116f395afc7d69321c3cedf60b0d3f;hp=aa37162429e33006e18e91c263efad6192e48fb8;hpb=b14f481994e4c4a2cfb64c8560789b40862d628c;p=elisp%2Fgnus.git- diff --git a/lisp/message.el b/lisp/message.el index aa37162..bf8dd17 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -1,6 +1,7 @@ ;;; 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 ;; MORIOKA Tomohiko @@ -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 -;; 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: @@ -72,46 +73,46 @@ (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 - "Message Buffers" + "Message Buffers." :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 - "Message Interface" + "Message Interface." :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 - "Message Insertion" + "Message Insertion." :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 - "Composing News Messages" + "Composing News Messages." :group 'message) (defgroup message-mail nil - "Composing Mail Messages" + "Composing Mail Messages." :group 'message) (defgroup message-faces nil @@ -549,9 +550,10 @@ command `message-mimic-kill-buffer' is used." :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'." + :version "23.0" ;; No Gnus :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'." - :version "22.1") + :version "22.1" + :group 'message-various) ;;;###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. -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) -(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 ">" - "*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. -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") @@ -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'. -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) @@ -1092,6 +1085,16 @@ Note that `message-cite-original' uses `mail-citation-hook' if that is non-nil." :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 @@ -1102,14 +1105,23 @@ even if it is an add-hoc expedient." :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 @@ -1348,7 +1360,7 @@ starting with `not' and followed by regexps." 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)) @@ -1359,8 +1371,10 @@ starting with `not' and followed by regexps." (: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)) @@ -1371,8 +1385,10 @@ starting with `not' and followed by regexps." (: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")) @@ -1383,8 +1399,10 @@ starting with `not' and followed by regexps." (: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)) @@ -1395,8 +1413,10 @@ starting with `not' and followed by regexps." (: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")) @@ -1407,8 +1427,10 @@ starting with `not' and followed by regexps." (: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")) @@ -1419,8 +1441,10 @@ starting with `not' and followed by regexps." (: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")) @@ -1431,8 +1455,10 @@ starting with `not' and followed by regexps." (: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")) @@ -1443,8 +1469,10 @@ starting with `not' and followed by regexps." (: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")) @@ -1455,8 +1483,10 @@ starting with `not' and followed by regexps." (: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")) @@ -1467,6 +1497,8 @@ starting with `not' and followed by regexps." (: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 @@ -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)) - (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)) - (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)) - (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)) - (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)) - (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)) - (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) "\\)$") - 1 'message-separator-face)) + 1 'message-separator)) 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 - (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 @@ -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 - '((bold . bold-region) + '((bold . message-bold-region) (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.") @@ -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 - "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) @@ -1657,7 +1694,7 @@ no, only reply back to the author." :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") @@ -1668,8 +1705,13 @@ no, only reply back to the author." (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") @@ -2055,7 +2097,6 @@ Leading \"Re: \" is not stripped by this function. Use the function ;;; Suggested by Jonas Steverud @ www.dtek.chalmers.se/~d4jonas/ -;;;###autoload (defun message-change-subject (new-subject) "Ask for NEW-SUBJECT header, append (was: )." ;; @@ -2087,32 +2128,31 @@ Leading \"Re: \" is not stripped by this function. Use the function " (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. -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) - (insert message-mark-insert-end) + (insert (if verbatim "#v-\n" message-mark-insert-end)) (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. -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))) - (insert message-mark-insert-end) + (insert (if verbatim "#v-\n" message-mark-insert-end)) (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 @@ -2132,7 +2172,6 @@ body, set `message-archive-note' to nil." (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." @@ -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)) -;;;###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. @@ -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"))))) -;;;###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." @@ -2251,7 +2288,6 @@ With prefix-argument just set Follow-Up, don't cross-post." ;;; 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) @@ -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-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" @@ -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] - ["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 @@ -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-e move to Expires C-c C-f C-i cycle through Importance values C-c C-f s change subject and append \"(was: )\" 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)) - (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))) - (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)) @@ -3214,7 +3254,9 @@ Prefix arg means justify as well." (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 @@ -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)) - (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))) @@ -3530,8 +3575,10 @@ be added to the \"References\" field." (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)) @@ -3612,49 +3659,14 @@ be added to the \"References\" field." (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) @@ -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) + (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")) @@ -3690,6 +3716,15 @@ be added to the \"References\" field." (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 @@ -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)) - (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? ")) @@ -4778,7 +4813,7 @@ Otherwise, generate and save a value for `canlock-password' first." (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 @@ -5236,6 +5271,22 @@ If NOW, use that time instead." (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) @@ -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 - (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)) - (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) @@ -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 "Mail-Reply-To") + (message-idna-to-ascii-rhs-1 "Mail-Followup-To") (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))) - (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 @@ -6223,6 +6275,12 @@ are not included." ;; 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)) @@ -6707,9 +6765,9 @@ that further discussion should take place only in " (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. -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 ;; @@ -7290,7 +7348,7 @@ you." ;; 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 @@ -7306,7 +7364,7 @@ which specify the range to operate on." (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." @@ -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") - :type 'function) + :type '(choice (const nil) + function)) (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 () + "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 @@ -7684,6 +7746,7 @@ regexp VARSTR." 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"))))