X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=lisp%2Fmessage.el;h=6844ba49a00b4ef773511f11d08ffcc4f6e09389;hb=13969e775564d6326ccf6e3e5333c76e006ec389;hp=b32e13546a6cfe11bcfe63d5f5cf96ae4212164b;hpb=e242821f4c9558548735ca0246cd8b9d2aecdaaf;p=elisp%2Fgnus.git- diff --git a/lisp/message.el b/lisp/message.el index b32e135..6844ba4 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -1,5 +1,5 @@ -;;; message.el --- composing mail and news messages -*- coding: iso-latin-1 -*- -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 +;;; message.el --- composing mail and news messages +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -40,7 +40,12 @@ (require 'cl) (require 'smtp) (defvar gnus-list-identifiers)) ; gnus-sum is required where necessary -(require 'canlock) +(eval-and-compile + (if (boundp 'MULE) + (progn + (require 'base64) + (require 'canlock-om)) + (require 'canlock))) (require 'mailheader) (require 'nnheader) ;; This is apparently necessary even though things are autoloaded: @@ -56,7 +61,8 @@ (require 'rfc822) (eval-and-compile - (autoload 'sha1 "sha1-el")) + (autoload 'sha1 "sha1-el") + (autoload 'customize-save-variable "cus-edit"));; for Mule 2. (defgroup message '((user-mail-address custom-variable) (user-full-name custom-variable)) @@ -154,6 +160,11 @@ mailbox format." :group 'message-sending :type '(repeat (symbol :tag "Type"))) +(defcustom message-fcc-externalize-attachments nil + "If non-nil, attachments are included as external parts in Fcc copies." + :type 'boolean + :group 'message-sending) + (defcustom message-courtesy-message "The following message is a courtesy copy of an article\nthat has been posted to %s as well.\n\n" "*This is inserted at the start of a mailed copy of a posted message. @@ -192,7 +203,14 @@ Otherwise, most addresses look like `angles', but they look like (const default)) :group 'message-headers) -(defcustom message-syntax-checks nil +(defcustom message-insert-canlock t + "Whether to insert a Cancel-Lock header in news postings." + :version "21.3" + :group 'message-headers + :type 'boolean) + +(defcustom message-syntax-checks + (if message-insert-canlock '((sender . disabled)) nil) ;; Guess this one shouldn't be easy to customize... "*Controls what syntax checks should not be performed on outgoing posts. To disable checking of long signatures, for instance, add @@ -238,14 +256,14 @@ included. Organization, Lines and User-Agent are optional." :type 'sexp) (defcustom message-ignored-news-headers - "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:" + "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:" "*Regexp of headers to be removed unconditionally before posting." :group 'message-news :group 'message-headers :type 'regexp) (defcustom message-ignored-mail-headers - "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:" + "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:" "*Regexp of headers to be removed unconditionally before mailing." :group 'message-mail :group 'message-headers @@ -352,14 +370,21 @@ should return the new buffer name." :type 'boolean) (defcustom message-kill-buffer-query-function 'yes-or-no-p - "*A function called to query the user whether to kill buffer anyway or not. -If it is t, the buffer will be killed peremptorily." + "*Function used to prompt user whether to kill the message buffer. If +it is t, the buffer will be killed unconditionally." :type '(radio (function-item yes-or-no-p) (function-item y-or-n-p) (function-item nnheader-Y-or-n-p) (function :tag "Other" t)) :group 'message-buffers) +(defcustom message-kill-buffer-and-remove-file t + "*Non-nil means that the associated file will be removed before +removing the message buffer. However, it is treated as nil when the +command `message-mimic-kill-buffer' is used." + :group 'message-buffers + :type 'boolean) + (eval-when-compile (defvar gnus-local-organization)) (defcustom message-user-organization @@ -456,9 +481,22 @@ The provided functions are: (defcustom message-cite-prefix-regexp (if (string-match "[[:digit:]]" "1") ;; support POSIX? - "\\([ \t]*[-_.[:word:]]+>+\\|[ \t]*[]>~|:}+]\\)+" + "\\([ \t]*[-_.[:word:]]+>+\\|[ \t]*[]>»|:}+]\\)+" ;; ?-, ?_ or ?. MUST NOT be in syntax entry w. - "\\([ \t]*\\(\\w\\|[-_.]\\)+>+\\|[ \t]*[]>~|:}+]\\)+") + (let ((old-table (syntax-table)) + non-word-constituents) + (set-syntax-table text-mode-syntax-table) + (setq non-word-constituents + (concat + (if (string-match "\\w" "-") "" "-") + (if (string-match "\\w" "_") "" "_") + (if (string-match "\\w" ".") "" "."))) + (set-syntax-table old-table) + (if (equal non-word-constituents "") + "\\([ \t]*\\(\\w\\)+>+\\|[ \t]*[]>»|:}+]\\)+" + (concat "\\([ \t]*\\(\\w\\|[" + non-word-constituents + "]\\)+>+\\|[ \t]*[]>»|:}+]\\)+")))) "*Regexp matching the longest possible citation prefix on a line." :group 'message-insertion :type 'regexp) @@ -579,6 +617,13 @@ conjunction with `message-subscribed-regexps' and :group 'message-interface :type '(repeat sexp)) +(defcustom message-subscribed-address-file nil + "*A file containing addresses the user is subscribed to. +If nil, do not look at any files to determine list subscriptions. If +non-nil, each line of this file should be a mailing list address." + :group 'message-interface + :type 'string) + (defcustom message-subscribed-addresses nil "*Specifies a list of addresses the user is subscribed to. If nil, do not use any predefined list subscriptions. This list of @@ -840,7 +885,10 @@ If stringp, use this; if non-nil, use no host name (user name only)." (sexp :tag "none" :format "%t" t))) (defvar message-reply-buffer nil) -(defvar message-reply-headers nil) +(defvar message-reply-headers nil + "The headers of the current replied article. +It is a vector of the following headers: +\[number subject from date id references chars lines xref extra].") (defvar message-sent-message-via nil) (defvar message-checksum nil) (defvar message-send-actions nil @@ -984,8 +1032,9 @@ feet of Good Net-Keeping Seal of Approval. The following are foot candidates: `empty-article' Allow you to post an empty article; `quoted-text-only' Allow you to post quoted text only; -`multiple-copies' Allow you to post multiple copies.") -;; `cancel-messages' Allow you to cancel or supersede others' messages. +`multiple-copies' Allow you to post multiple copies; +`cancel-messages' Allow you to cancel or supersede messages from + your other email addresses.") (defsubst message-gnksa-enable-p (feature) (or (not (listp message-shoot-gnksa-feet)) @@ -1230,6 +1279,19 @@ The first matched address (not primary one) is used in the From field." :type '(choice (const :tag "Always use primary" nil) regexp)) +(defcustom message-hierarchical-addresses nil + "A list of hierarchical mail address definitions. + +Inside each entry, the first address is the \"top\" address, and +subsequent addresses are subaddresses; this is used to indicate that +mail sent to the first address will automatically be delivered to the +subaddresses. So if the first address appears in the recipient list +for a message, the subaddresses will be removed (if present) before +the mail is sent. All addresses in this structure should be +downcased." + :group 'message-headers + :type '(repeat (repeat string))) + (defcustom message-mail-user-agent nil "Like `mail-user-agent'. Except if it is nil, use Gnus native MUA; if it is t, use @@ -1257,11 +1319,7 @@ If this variable is non-nil, pose the question \"Reply to all recipients?\" before a wide reply to multiple recipients. If the user answers yes, reply to all recipients as usual. If the user answers no, only reply back to the author." - :group 'message-headers - :type 'boolean) - -(defcustom message-insert-canlock t - "Whether to insert a Cancel-Lock header in news postings." + :version "21.3" :group 'message-headers :type 'boolean) @@ -1733,6 +1791,7 @@ Point is left at the beginning of the narrowed-to region." (define-key message-mode-map "\C-c?" 'describe-mode) (define-key message-mode-map "\C-c\C-f\C-t" 'message-goto-to) + (define-key message-mode-map "\C-c\C-f\C-o" 'message-goto-from) (define-key message-mode-map "\C-c\C-f\C-b" 'message-goto-bcc) (define-key message-mode-map "\C-c\C-f\C-w" 'message-goto-fcc) (define-key message-mode-map "\C-c\C-f\C-c" 'message-goto-cc) @@ -1747,6 +1806,7 @@ Point is left at the beginning of the narrowed-to region." (define-key message-mode-map "\C-c\C-f\C-k" 'message-goto-keywords) (define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary) (define-key message-mode-map "\C-c\C-f\C-i" 'message-insert-or-toggle-importance) + (define-key message-mode-map "\C-c\C-f\C-a" 'message-gen-unsubscribed-mft) (define-key message-mode-map "\C-c\C-b" 'message-goto-body) (define-key message-mode-map "\C-c\C-i" 'message-goto-signature) (define-key message-mode-map "\C-c\C-fc" 'message-goto-mail-copies-to) @@ -1754,6 +1814,9 @@ Point is left at the beginning of the narrowed-to region." (define-key message-mode-map "\C-c\C-t" 'message-insert-to) (define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups) + (define-key message-mode-map "\C-c\C-u" 'message-insert-or-toggle-importance) + (define-key message-mode-map "\C-c\M-n" 'message-insert-disposition-notification-to) + (define-key message-mode-map "\C-c\C-y" 'message-yank-original) (define-key message-mode-map "\C-c\M-\C-y" 'message-yank-buffer) (define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message) @@ -1796,12 +1859,16 @@ Point is left at the beginning of the narrowed-to region." ["Kill To Signature" message-kill-to-signature t] ["Newline and Reformat" message-newline-and-reformat t] ["Rename buffer" message-rename-buffer t] - ["Flag as important" message-insert-importance-high + ["Flag As Important" message-insert-importance-high ,@(if (featurep 'xemacs) '(t) '(:help "Mark this message as important"))] - ["Flag as unimportant" message-insert-importance-low + ["Flag As Unimportant" message-insert-importance-low ,@(if (featurep 'xemacs) '(t) '(:help "Mark this message as unimportant"))] + ["Request Receipt" + message-insert-disposition-notification-to + ,@(if (featurep 'xemacs) '(t) + '(:help "Request a Disposition Notification of this article"))] ["Spellcheck" ispell-message ,@(if (featurep 'xemacs) '(t) '(:help "Spellcheck this message"))] @@ -1829,6 +1896,7 @@ Point is left at the beginning of the narrowed-to region." ["Fetch Newsgroups" message-insert-newsgroups t] "----" ["To" message-goto-to t] + ["From" message-goto-from t] ["Subject" message-goto-subject t] ["Cc" message-goto-cc t] ["Reply-To" message-goto-reply-to t] @@ -1902,7 +1970,9 @@ These properties are essential to work, so we should never strip them." This function is intended to be called from `after-change-functions'. See also `message-forbidden-properties'." (when (and message-strip-special-text-properties - (message-tamago-not-in-use-p begin)) + (message-tamago-not-in-use-p begin) + ;; Check whether the invisible MIME part is not inserted. + (not (text-property-any begin end 'mime-edit-invisible t))) (remove-text-properties begin end message-forbidden-properties))) ;;;###autoload @@ -1919,6 +1989,7 @@ C-c C-f move to a header field (and create it if there isn't): C-c C-f C-k move to Keywords C-c C-f C-d move to Distribution C-c C-f C-f move to Followup-To C-c C-f C-m move to Mail-Followup-To + C-c C-f C-i cycle through Importance values C-c C-f c move to Mail-Copies-To C-c C-t `message-insert-to' (add a To header to a news followup) C-c C-n `message-insert-newsgroups' (add a Newsgroup header to a news reply) @@ -1931,8 +2002,10 @@ C-c C-e `message-elide-region' (elide the text between point and mark). C-c C-v `message-delete-not-region' (remove the text outside the region). C-c C-z `message-kill-to-signature' (kill the text up to the signature). C-c C-r `message-caesar-buffer-body' (rot13 the message body). -C-c C-p `message-insert-or-toggle-importance' (insert or cycle importance) +C-c C-u `message-insert-or-toggle-importance' (insert or cycle importance). +C-c M-n `message-insert-disposition-notification-to' (request receipt). M-RET `message-newline-and-reformat' (break the line and reformat)." + (setq local-abbrev-table text-mode-abbrev-table) (set (make-local-variable 'message-reply-buffer) nil) (make-local-variable 'message-send-actions) (make-local-variable 'message-exit-actions) @@ -1967,14 +2040,19 @@ M-RET `message-newline-and-reformat' (break the line and reformat)." (set (make-local-variable 'tool-bar-map) (message-tool-bar-map)))) (easy-menu-add message-mode-menu message-mode-map) (easy-menu-add message-mode-field-menu message-mode-map) + ;; make-local-hook is harmless though obsolete in Emacs 21. + ;; Emacs 20 and XEmacs need make-local-hook. + (make-local-hook 'after-change-functions) ;; Mmmm... Forbidden properties... - (add-hook 'after-change-functions 'message-strip-forbidden-properties nil t) + (add-hook 'after-change-functions 'message-strip-forbidden-properties + nil 'local) ;; Allow mail alias things. (when (eq message-mail-alias-type 'abbrev) (if (fboundp 'mail-abbrevs-setup) (mail-abbrevs-setup) (mail-aliases-setup))) - (message-set-auto-save-file-name) + (unless buffer-file-name + (message-set-auto-save-file-name)) (set (make-local-variable 'indent-tabs-mode) nil)) ;No tabs for indentation. (defun message-setup-fill-variables () @@ -2032,6 +2110,11 @@ M-RET `message-newline-and-reformat' (break the line and reformat)." (interactive) (message-position-on-field "To")) +(defun message-goto-from () + "Move point to the From header." + (interactive) + (message-position-on-field "From")) + (defun message-goto-subject () "Move point to the Subject header." (interactive) @@ -2139,6 +2222,26 @@ return nil." (goto-char (point-max)) nil)) +(defun message-gen-unsubscribed-mft (&optional include-cc) + "Insert a reasonable MFT header in a post to an unsubscribed list. +When making original posts to a mailing list you are not subscribed to, +you have to type in a MFT header by hand. The contents, usually, are +the addresses of the list and your own address. This function inserts +such a header automatically. It fetches the contents of the To: header +in the current mail buffer, and appends the current user-mail-address. + +If the optional argument `include-cc' is non-nil, the addresses in the +Cc: header are also put into the MFT." + + (interactive) + (message-remove-header "Mail-Followup-To") + (let* ((cc (and include-cc (message-fetch-field "Cc"))) + (tos (if cc + (concat (message-fetch-field "To") "," cc) + (message-fetch-field "To")))) + (message-goto-mail-followup-to) + (insert (concat tos ", " user-mail-address)))) + (defun message-insert-to (&optional force) @@ -2295,10 +2398,14 @@ Prefix arg means justify as well." (if not-break (setq point nil) (if bolp - (insert "\n") - (insert "\n\n")) + (newline) + (newline) + (newline)) (setq point (point)) - (insert "\n\n") + ;; (newline 2) doesn't mark both newline's as hard, so call + ;; newline twice. -jas + (newline) + (newline) (delete-region (point) (re-search-forward "[ \t]*")) (when (and quoted (not bolp)) (insert quoted leading-space))) @@ -2409,6 +2516,16 @@ and `low'." (message-goto-eoh) (insert (format "Importance: %s\n" new))))) +(defun message-insert-disposition-notification-to () + "Request a disposition notification (return receipt) to this message. +Note that this should not be used in newsgroups." + (interactive) + (save-excursion + (message-remove-header "Disposition-Notification-To") + (message-goto-eoh) + (insert (format "Disposition-Notification-To: %s\n" + (or (message-fetch-field "From") (message-make-from)))))) + (defun message-elide-region (b e) "Elide the text in the region. An ellipsis (from `message-elide-ellipsis') will be inserted where the @@ -2834,7 +2951,8 @@ The text will also be indented the normal way." t))) (defun message-dont-send () - "Don't send the message you have been editing." + "Don't send the message you have been editing. +Instead, just auto-save the buffer and then bury it." (interactive) (message-save-drafts) (let ((actions message-postpone-actions) @@ -2860,7 +2978,8 @@ The text will also be indented the normal way." (org-frame message-original-frame)) (setq buffer-file-name nil) (kill-buffer (current-buffer)) - (when (and (or (and auto-save-file-name + (when (and message-kill-buffer-and-remove-file + (or (and auto-save-file-name (file-exists-p auto-save-file-name)) (and file-name (file-exists-p file-name))) @@ -2875,18 +2994,16 @@ The text will also be indented the normal way." (message "")) (defun message-mimic-kill-buffer () - "Kill the current buffer with query." + "Kill the current buffer with query. This is an imitation for +`kill-buffer', but it will delete a message frame." (interactive) - (unless (eq 'message-mode major-mode) - (error "%s must be invoked from a message buffer." this-command)) - (let ((command this-command) - (bufname (read-buffer (format "Kill buffer: (default %s) " - (buffer-name))))) - (if (or (not bufname) - (string-equal bufname "") - (string-equal bufname (buffer-name))) - (message-kill-buffer) - (message "%s must be invoked only for the current buffer." command)))) + (let ((bufname (read-buffer (format "Kill buffer: (default %s) " + (buffer-name)))) + message-kill-buffer-and-remove-file) + (when (or (not bufname) + (string-equal bufname "") + (string-equal bufname (buffer-name))) + (message-kill-buffer)))) (defun message-delete-frame (frame org-frame) "Delete frame for editing message." @@ -2949,7 +3066,7 @@ It should typically alter the sending method in some way or other." (save-excursion (set-buffer message-encoding-buffer) (erase-buffer) - ;; ;; Avoid copying text props. + ;; ;; Avoid copying text props (except hard newlines). ;; T-gnus change: copy all text props from the editing buffer ;; into the encoding buffer. (insert-buffer message-edit-buffer) @@ -2969,7 +3086,8 @@ It should typically alter the sending method in some way or other." (setq success (funcall (caddr elem) arg))) (setq sent t))))) (unless - (or sent (not success) + (or sent + (not success) (let ((fcc (message-fetch-field "Fcc")) (gcc (message-fetch-field "Gcc"))) (when (or fcc gcc) @@ -3037,6 +3155,17 @@ used to distinguish whether the invisible text is a MIME part or not." '(invisible t mime-edit-invisible t)) (put-text-property start end 'invisible t)))))) +(defun message-text-with-property (prop) + "Return a list of all points where the text has PROP." + (let ((points nil) + (point (point-min))) + (save-excursion + (while (< point (point-max)) + (when (get-text-property point prop) + (push point points)) + (incf point))) + (nreverse points))) + (defun message-fix-before-sending () "Do various things to make the message nice before sending it." ;; Make sure there's a newline at the end of the message. @@ -3070,14 +3199,59 @@ used to distinguish whether the invisible text is a MIME part or not." (set-window-start (selected-window) (gnus-point-at-bol)) (unless (yes-or-no-p "Invisible text found and made visible; continue posting? ") - (error "Invisible text found and made visible")))))) + (error "Invisible text found and made visible"))))) + (message-check 'illegible-text + (let ((mm-7bit-chars "\x20-\x7f\r\n\t\x7\x8\xb\xc\x1f\x1b") + found choice) + (message-goto-body) + (skip-chars-forward mm-7bit-chars) + (while (not (eobp)) + (when (let ((char (char-after))) + (or (< (mm-char-int char) 128) + (and (mm-multibyte-p) + (memq (char-charset char) + '(eight-bit-control eight-bit-graphic + control-1))))) + (add-text-properties (point) (1+ (point)) '(highlight t)) + (setq found t)) + (forward-char) + (skip-chars-forward mm-7bit-chars)) + (when found + (setq choice + (gnus-multiple-choice + "Illegible text found. Continue posting? " + '((?d "Remove and continue posting") + (?r "Replace with dots and continue posting") + (?e "Continue editing")))) + (if (eq choice ?e) + (error "Illegible text found")) + (message-goto-body) + (skip-chars-forward mm-7bit-chars) + (while (not (eobp)) + (when (let ((char (char-after))) + (or (< (mm-char-int char) 128) + (and (mm-multibyte-p) + (memq (char-charset char) + '(eight-bit-control eight-bit-graphic + control-1))))) + (delete-char 1) + (if (eq choice ?r) + (insert "."))) + (forward-char) + (skip-chars-forward mm-7bit-chars)))))) (defun message-add-action (action &rest types) "Add ACTION to be performed when doing an exit of type TYPES." + (while types + (add-to-list (intern (format "message-%s-actions" (pop types))) + action))) + +(defun message-delete-action (action &rest types) + "Delete ACTION from lists of actions performed when doing an exit of type TYPES." (let (var) (while types (set (setq var (intern (format "message-%s-actions" (pop types)))) - (nconc (symbol-value var) (list action)))))) + (delq action (symbol-value var)))))) (defun message-do-actions (actions) "Perform all actions in ACTIONS." @@ -3223,6 +3397,7 @@ This sub function is for exclusive use of `message-send-mail'." ;; Generate the Mail-Followup-To header if the header is not there... (if (and (or message-subscribed-regexps message-subscribed-addresses + message-subscribed-address-file message-subscribed-address-functions) (not (mail-fetch-field "mail-followup-to"))) (setq headers @@ -3246,6 +3421,9 @@ This sub function is for exclusive use of `message-send-mail'." (save-excursion (set-buffer tembuf) (erase-buffer) + ;; ;; Avoid copying text props (except hard newlines). + ;; T-gnus change: copy all text props from the editing buffer + ;; into the encoding buffer. (insert-buffer message-encoding-buffer) ;; Remove some headers. (save-restriction @@ -3254,7 +3432,6 @@ This sub function is for exclusive use of `message-send-mail'." ;; ;; We (re)generate the Lines header. ;; (when (memq 'Lines message-required-mail-headers) ;; (message-generate-headers '(Lines))) - ;; Remove some headers. (message-remove-header message-ignored-mail-headers t)) (goto-char (point-max)) ;; require one newline at the end. @@ -3581,7 +3758,7 @@ Otherwise, generate and save a value for `canlock-password' first." (backward-char 1) (run-hooks 'message-send-news-hook) (gnus-open-server method) - (message "Sending news with %s..." (gnus-server-string method)) + (message "Sending news via %s..." (gnus-server-string method)) (gnus-request-post method) )) @@ -3678,7 +3855,7 @@ Otherwise, generate and save a value for `canlock-password' first." (zerop (length (setq to (completing-read - "Followups to: (default all groups) " + "Followups to (default: no Followup-To header) " (mapcar (lambda (g) (list g)) (cons "poster" (message-tokenize-header @@ -4026,7 +4203,8 @@ Otherwise, generate and save a value for `canlock-password' first." (let ((case-fold-search t) (coding-system-for-write 'raw-text) (output-coding-system 'raw-text) - list file) + list file + (mml-externalize-attachments message-fcc-externalize-attachments)) (save-excursion (save-restriction (message-narrow-to-headers) @@ -4179,7 +4357,7 @@ If NOW, use that time instead." (aset user (match-beginning 0) ?_)) user) (message-number-base36 (user-uid) -1)) - (message-number-base36 (+ (car tm) + (message-number-base36 (+ (car tm) (lsh (% message-unique-id-char 25) 16)) 4) (message-number-base36 (+ (nth 1 tm) (lsh (/ message-unique-id-char 25) 16)) 4) @@ -4296,16 +4474,6 @@ If NOW, use that time instead." (aset tmp (1- (match-end 0)) ?-)) (string-match "[\\()]" tmp))))) (insert fullname) - (goto-char (point-min)) - ;; Look for a character that cannot appear unquoted - ;; according to RFC 822. - (when (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" nil 1) - ;; Quote fullname, escaping specials. - (goto-char (point-min)) - (insert "\"") - (while (re-search-forward "[\"\\]" nil 1) - (replace-match "\\\\\\&" t)) - (insert "\"")) (insert " <" login ">")) (t ; 'parens or default (insert login " (") @@ -4367,7 +4535,7 @@ give as trustworthy answer as possible." (match-string 1 user-mail)) ;; Default to this bogus thing. (t - (concat system-name ".i-did-not-set--mail-host-address--so-shoot-me"))))) + (concat system-name ".i-did-not-set--mail-host-address--so-tickle-me"))))) (defun message-make-host-name () "Return the name of the host." @@ -4386,9 +4554,25 @@ give as trustworthy answer as possible." (recipients (mapcar 'mail-strip-quoted-names (message-tokenize-header msg-recipients))) + (file-regexps + (if message-subscribed-address-file + (let (begin end item re) + (save-excursion + (with-temp-buffer + (insert-file-contents message-subscribed-address-file) + (while (not (eobp)) + (setq begin (point)) + (forward-line 1) + (setq end (point)) + (if (bolp) (setq end (1- end))) + (setq item (regexp-quote (buffer-substring begin end))) + (if re (setq re (concat re "\\|" item)) + (setq re (concat "\\`\\(" item)))) + (and re (list (concat re "\\)\\'")))))))) (mft-regexps (apply 'append message-subscribed-regexps (mapcar 'regexp-quote message-subscribed-addresses) + file-regexps (mapcar 'funcall message-subscribed-address-functions)))) (save-match-data @@ -4522,6 +4706,8 @@ Headers already prepared in the buffer are not modified." (goto-char (point-max)) (insert (if (stringp header) header (symbol-name header)) ": " value) + ;; We check whether the value was ended by a + ;; newline. If now, we insert one. (unless (bolp) (insert "\n")) (forward-line -1)) @@ -4818,7 +5004,7 @@ than 988 characters long, and if they are not, trim them until they are." to group) (if (not (or (null name) (string-equal name "mail") - (string-equal name "news"))) + (string-equal name "posting"))) (setq name (concat "*sent " name "*")) (message-narrow-to-headers) (setq to (message-fetch-field "to")) @@ -4830,7 +5016,7 @@ than 988 characters long, and if they are not, trim them until they are." (or (car (mail-extract-address-components to)) to) "*")) ((and group (not (string= group ""))) - (concat "*sent news on " group "*")) + (concat "*sent posting on " group "*")) (t "*sent mail*")))) (unless (string-equal name (buffer-name)) (rename-buffer name t))))) @@ -5013,7 +5199,7 @@ OTHER-HEADERS is an alist of header/value pairs." "Start editing a news article to be sent." (interactive) (let ((message-this-is-news t)) - (message-pop-to-buffer (message-buffer-name "news" nil newsgroups)) + (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups)) (message-setup `((Newsgroups . ,(or newsgroups "")) (Subject . ,(or subject "")))))) @@ -5121,16 +5307,34 @@ responses here are directed to other addresses."))) ;; Perhaps "Mail-Copies-To: never" removed the only address? (if (string-equal recipients "") (setq recipients author)) - ;; Convert string to a list of (("foo@bar" . "Name ") ...). + ;; Convert string to a list of (("foo@bar" . "Name ") ...). (setq recipients (mapcar (lambda (addr) - (cons (mail-strip-quoted-names addr) addr)) + (cons (downcase (mail-strip-quoted-names addr)) addr)) (message-tokenize-header recipients))) ;; Remove first duplicates. (Why not all duplicates? Is this a bug?) (let ((s recipients)) (while s (setq recipients (delq (assoc (car (pop s)) s) recipients)))) + + ;; Remove hierarchical lists that are contained within each other, + ;; if message-hierarchical-addresses is defined. + (when message-hierarchical-addresses + (let ((plain-addrs (mapcar 'car recipients)) + subaddrs recip) + (while plain-addrs + (setq subaddrs (assoc (car plain-addrs) + message-hierarchical-addresses) + plain-addrs (cdr plain-addrs)) + (when subaddrs + (setq subaddrs (cdr subaddrs)) + (while subaddrs + (setq recip (assoc (car subaddrs) recipients) + subaddrs (cdr subaddrs)) + (if recip + (setq recipients (delq recip recipients)))))))) + ;; Build the header alist. Allow the user to be asked whether ;; or not to reply to all recipients in a wide reply. (setq follow-to (list (cons 'To (cdr (pop recipients))))) @@ -5622,6 +5826,8 @@ Optional NEWS will use news to forward instead of mail." (defun message-forward-make-body (forward-buffer) ;; Put point where we want it before inserting the forwarded ;; message. + ;; Note that this function definition for T-gnus is totally different + ;; from the original Gnus." (if message-forward-before-signature (message-goto-body) (goto-char (point-max))) @@ -5651,8 +5857,10 @@ Optional NEWS will use news to forward instead of mail." (defun message-forward-rmail-make-body (forward-buffer) (save-window-excursion (set-buffer forward-buffer) - (let (rmail-enable-mime) - (rmail-toggle-header 0))) + ;; Rmail doesn't have rmail-msg-restore-non-pruned-header in Emacs + ;; 20. FIXIT, or we drop support for rmail in Emacs 20. + (if (rmail-msg-is-pruned) + (rmail-msg-restore-non-pruned-header))) (message-forward-make-body forward-buffer)) ;;;###autoload @@ -5810,7 +6018,7 @@ you." (special-display-regexps nil) (same-window-buffer-names nil) (same-window-regexps nil)) - (message-pop-to-buffer (message-buffer-name "news" nil newsgroups))) + (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups))) (let ((message-this-is-news t)) (message-setup `((Newsgroups . ,(or newsgroups "")) (Subject . ,(or subject "")))))) @@ -5824,7 +6032,7 @@ you." (special-display-regexps nil) (same-window-buffer-names nil) (same-window-regexps nil)) - (message-pop-to-buffer (message-buffer-name "news" nil newsgroups))) + (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups))) (let ((message-this-is-news t)) (message-setup `((Newsgroups . ,(or newsgroups "")) (Subject . ,(or subject "")))))) @@ -5898,32 +6106,46 @@ which specify the range to operate on." (tool-bar-add-item-from-menu 'message-insert-importance-low "unimportant" message-mode-map) + (tool-bar-add-item-from-menu + 'message-insert-disposition-notification-to "receipt" + message-mode-map) tool-bar-map))))) ;;; Group name completion. -(defvar message-newgroups-header-regexp +(defcustom message-newgroups-header-regexp "^\\(Newsgroups\\|Followup-To\\|Posted-To\\|Gcc\\):" - "Regexp that match headers that lists groups.") + "Regexp that match headers that lists groups." + :group 'message + :type 'regexp) -(defvar message-completion-alist +(defcustom message-completion-alist (list (cons message-newgroups-header-regexp 'message-expand-group) '("^\\(Resent-\\)?\\(To\\|B?Cc\\):" . message-expand-name)) - "Alist of (RE . FUN). Use FUN for completion on header lines matching RE.") + "Alist of (RE . FUN). Use FUN for completion on header lines matching RE." + :group 'message + :type '(alist :key-type regexp :value-type function)) -(defvar message-tab-body-function 'indent-relative - "*Function to execute when `message-tab' (TAB) is executed in the body.") +(defcustom message-tab-body-function nil + "*Function to execute when `message-tab' (TAB) is executed in the body. +If nil, the function bound in `text-mode-map' or `global-map' is executed." + :group 'message + :type 'function) (defun message-tab () "Complete names according to `message-completion-alist'. -Do an `indent-relative' if not in those headers." +Execute function specified by `message-tab-body-function' when not in +those headers." (interactive) (let ((alist message-completion-alist)) (while (and alist (let ((mail-abbrev-mode-regexp (caar alist))) (not (mail-abbrev-in-expansion-header-p)))) (setq alist (cdr alist))) - (funcall (or (cdar alist) message-tab-body-function)))) + (funcall (or (cdar alist) message-tab-body-function + (lookup-key text-mode-map "\t") + (lookup-key global-map "\t") + 'indent-relative)))) (defun message-expand-group () "Expand the group name under point." @@ -6126,11 +6348,11 @@ regexp varstr." (message-narrow-to-headers-or-head) (message-remove-first-header "Content-Type") (message-remove-first-header "Content-Transfer-Encoding")) - ;; We always make sure that the message has a Content-Type header. - ;; This is because some broken MTAs and MUAs get awfully confused - ;; when confronted with a message with a MIME-Version header and - ;; without a Content-Type header. For instance, Solaris' - ;; /usr/bin/mail. + ;; We always make sure that the message has a Content-Type + ;; header. This is because some broken MTAs and MUAs get + ;; awfully confused when confronted with a message with a + ;; MIME-Version header and without a Content-Type header. For + ;; instance, Solaris' /usr/bin/mail. (unless content-type-p (goto-char (point-min)) ;; For unknown reason, MIME-Version doesn't exist. @@ -6138,16 +6360,16 @@ regexp varstr." (forward-line 1) (insert "Content-Type: text/plain; charset=us-ascii\n")))))) -(defun message-read-from-minibuffer (prompt) +(defun message-read-from-minibuffer (prompt &optional initial-contents) "Read from the minibuffer while providing abbrev expansion." (if (fboundp 'mail-abbrevs-setup) (let ((mail-abbrev-mode-regexp "") (minibuffer-setup-hook 'mail-abbrevs-setup) (minibuffer-local-map message-minibuffer-local-map)) - (read-from-minibuffer prompt)) + (read-from-minibuffer prompt initial-contents)) (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook) (minibuffer-local-map message-minibuffer-local-map)) - (read-string prompt)))) + (read-string prompt initial-contents)))) (defun message-use-alternative-email-as-from () (require 'mail-utils) @@ -6212,7 +6434,9 @@ regexp varstr." (insert-buffer buffer) (setq message-reply-headers reply-headers) (message-generate-headers '((optional . In-Reply-To))) - (mime-edit-translate-buffer)) + (let ((mime-header-encode-method-alist + '((eword-encode-unstructured-field-body)))) + (mime-edit-translate-buffer))) (set-buffer-modified-p nil)) (message "Saving %s...done" buffer-file-name))