diff options
Diffstat (limited to 'lisp/gnus/message.el')
| -rw-r--r-- | lisp/gnus/message.el | 350 |
1 files changed, 206 insertions, 144 deletions
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 461f61f144d..66356b6fda2 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -28,9 +28,7 @@ ;;; Code: -(eval-when-compile - (require 'cl)) - +(require 'cl-lib) (require 'mailheader) (require 'gmm-utils) (require 'mail-utils) @@ -158,7 +156,7 @@ If this variable is nil, no such courtesy message will be added." :group 'message-interface :type 'regexp) -(defcustom message-from-style mail-from-style +(defcustom message-from-style 'angles "Specifies how \"From\" headers look. If nil, they contain just the return address like: @@ -170,12 +168,16 @@ If `angles', they look like: Otherwise, most addresses look like `angles', but they look like `parens' if `angles' would need quoting and `parens' would not." - :version "23.2" + :version "27.1" :type '(choice (const :tag "simple" nil) (const parens) (const angles) (const default)) :group 'message-headers) +(make-obsolete-variable + 'message-from-style + "Only the `angles' value is valid according to RFC2822" "27.1") + (defcustom message-insert-canlock t "Whether to insert a Cancel-Lock header in news postings." @@ -550,10 +552,15 @@ The provided functions are: (function-item message-forward-subject-name-subject) (repeat :tag "List of functions" function))) -(defcustom message-forward-as-mime t +(defcustom message-forward-as-mime nil "Non-nil means forward messages as an inline/rfc822 MIME section. -Otherwise, directly inline the old message in the forwarded message." - :version "21.1" +Otherwise, directly inline the old message in the forwarded +message. + +When forwarding as MIME, certain MIME-related headers in the +forwarded message may be removed/altered to ensure that the +resulting mail is syntactically valid." + :version "27.1" :group 'message-forwarding :link '(custom-manual "(message)Forwarding") :type 'boolean) @@ -605,6 +612,9 @@ Done before generating the new subject of a forward." (defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus" "All headers that match this regexp will be deleted when forwarding a message. +This variable is only consulted when forwarding \"normally\", not +when forwarding as MIME or the like. + This may also be a list of regexps." :version "21.1" :group 'message-forwarding @@ -615,11 +625,12 @@ This may also be a list of regexps." (widget-editable-list-match widget value))) regexp)) -(defcustom message-forward-included-headers nil +(defcustom message-forward-included-headers + '("^From:" "^Subject:" "^Date:") "If non-nil, delete non-matching headers when forwarding a message. Only headers that match this regexp will be included. This variable should be a regexp or a list of regexps." - :version "25.1" + :version "27.1" :group 'message-forwarding :type '(repeat :value-to-internal (lambda (widget value) (custom-split-regexp-maybe value)) @@ -1241,13 +1252,13 @@ called and its result is inserted." ;; Ease the transition from mail-mode to message-mode. See bugs#4431, 5555. (concat (if (and (boundp 'mail-default-reply-to) (stringp mail-default-reply-to)) - (format "Reply-to: %s\n" mail-default-reply-to)) + (format "Reply-To: %s\n" mail-default-reply-to)) (if (and (boundp 'mail-self-blind) mail-self-blind) - (format "BCC: %s\n" user-mail-address)) + (format "Bcc: %s\n" user-mail-address)) (if (and (boundp 'mail-archive-file-name) (stringp mail-archive-file-name)) - (format "FCC: %s\n" mail-archive-file-name)) + (format "Fcc: %s\n" mail-archive-file-name)) mail-default-headers) "A string of header lines to be inserted in outgoing mails." :version "23.2" @@ -1341,7 +1352,8 @@ If nil, Message won't auto-save." :link '(custom-manual "(message)Various Message Variables") :type '(choice directory (const :tag "Don't auto-save" nil))) -(defcustom message-default-charset (and (not (mm-multibyte-p)) 'iso-8859-1) +(defcustom message-default-charset (and (not enable-multibyte-characters) + 'iso-8859-1) "Default charset used in non-MULE Emacsen. If nil, you might be asked to input the charset." :version "21.1" @@ -1436,8 +1448,6 @@ starting with `not' and followed by regexps." :bold t :italic t)) "Face used for displaying To headers." :group 'message-faces) -(define-obsolete-face-alias 'message-header-to-face - 'message-header-to "22.1") (defface message-header-cc '((((class color) @@ -1450,8 +1460,6 @@ starting with `not' and followed by regexps." :bold t)) "Face used for displaying Cc headers." :group 'message-faces) -(define-obsolete-face-alias 'message-header-cc-face - 'message-header-cc "22.1") (defface message-header-subject '((((class color) @@ -1464,8 +1472,6 @@ starting with `not' and followed by regexps." :bold t)) "Face used for displaying Subject headers." :group 'message-faces) -(define-obsolete-face-alias 'message-header-subject-face - 'message-header-subject "22.1") (defface message-header-newsgroups '((((class color) @@ -1478,8 +1484,6 @@ starting with `not' and followed by regexps." :bold t :italic t)) "Face used for displaying Newsgroups headers." :group 'message-faces) -(define-obsolete-face-alias 'message-header-newsgroups-face - 'message-header-newsgroups "22.1") (defface message-header-other '((((class color) @@ -1492,8 +1496,6 @@ starting with `not' and followed by regexps." :bold t :italic t)) "Face used for displaying other headers." :group 'message-faces) -(define-obsolete-face-alias 'message-header-other-face - 'message-header-other "22.1") (defface message-header-name '((((class color) @@ -1506,8 +1508,6 @@ starting with `not' and followed by regexps." :bold t)) "Face used for displaying header names." :group 'message-faces) -(define-obsolete-face-alias 'message-header-name-face - 'message-header-name "22.1") (defface message-header-xheader '((((class color) @@ -1520,8 +1520,6 @@ starting with `not' and followed by regexps." :bold t)) "Face used for displaying X-Header headers." :group 'message-faces) -(define-obsolete-face-alias 'message-header-xheader-face - 'message-header-xheader "22.1") (defface message-separator '((((class color) @@ -1534,8 +1532,6 @@ starting with `not' and followed by regexps." :bold t)) "Face used for displaying the separator." :group 'message-faces) -(define-obsolete-face-alias 'message-separator-face - 'message-separator "22.1") (defface message-cited-text '((((class color) @@ -1548,8 +1544,6 @@ starting with `not' and followed by regexps." :bold t)) "Face used for displaying cited text names." :group 'message-faces) -(define-obsolete-face-alias 'message-cited-text-face - 'message-cited-text "22.1") (defface message-mml '((((class color) @@ -1562,53 +1556,50 @@ starting with `not' and followed by regexps." :bold t)) "Face used for displaying MML." :group 'message-faces) -(define-obsolete-face-alias 'message-mml-face - 'message-mml "22.1") -(defun message-font-lock-make-header-matcher (regexp) - (let ((form - `(lambda (limit) - (let ((start (point))) - (save-restriction - (widen) - (goto-char (point-min)) - (if (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$") - nil t) - (setq limit (min limit (match-beginning 0)))) - (goto-char start)) - (and (< start limit) - (re-search-forward ,regexp limit t)))))) - (if (featurep 'bytecomp) - (byte-compile form) - form))) +(defun message-match-to-eoh (_limit) + (let ((start (point))) + (rfc822-goto-eoh) + ;; Typical situation: some temporary change causes the header to be + ;; incorrect, so EOH comes earlier than intended: the last lines of the + ;; intended headers are now not considered part of the header any more, + ;; so they don't have the multiline property set. When the change is + ;; completed and the header has its correct shape again, the lack of the + ;; multiline property means we won't rehighlight the last lines of + ;; the header. + (if (< (point) start) + nil ;No header within start..limit. + ;; Here we disregard LIMIT so that we may extend the area again. + (set-match-data (list start (point))) + (point)))) (defvar message-font-lock-keywords (let ((content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)\n?")) - `((,(message-font-lock-make-header-matcher - (concat "^\\([Tt]o:\\)" content)) - (1 'message-header-name) - (2 'message-header-to nil t)) - (,(message-font-lock-make-header-matcher - (concat "^\\(^[GBF]?[Cc][Cc]:\\|^[Rr]eply-[Tt]o:\\)" content)) - (1 'message-header-name) - (2 'message-header-cc nil t)) - (,(message-font-lock-make-header-matcher - (concat "^\\([Ss]ubject:\\)" content)) - (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) - (2 'message-header-newsgroups nil t)) - (,(message-font-lock-make-header-matcher - (concat "^\\(X-[A-Za-z0-9-]+:\\|In-Reply-To:\\)" content)) - (1 'message-header-name) - (2 'message-header-xheader)) - (,(message-font-lock-make-header-matcher - (concat "^\\([A-Z][^: \n\t]+:\\)" content)) - (1 'message-header-name) - (2 'message-header-other nil t)) + `((message-match-to-eoh + (,(concat "^\\([Tt]o:\\)" content) + (progn (goto-char (match-beginning 0)) (match-end 0)) nil + (1 'message-header-name) + (2 'message-header-to nil t)) + (,(concat "^\\(^[GBF]?[Cc][Cc]:\\|^[Rr]eply-[Tt]o:\\)" content) + (progn (goto-char (match-beginning 0)) (match-end 0)) nil + (1 'message-header-name) + (2 'message-header-cc nil t)) + (,(concat "^\\([Ss]ubject:\\)" content) + (progn (goto-char (match-beginning 0)) (match-end 0)) nil + (1 'message-header-name) + (2 'message-header-subject nil t)) + (,(concat "^\\([Nn]ewsgroups:\\|Followup-[Tt]o:\\)" content) + (progn (goto-char (match-beginning 0)) (match-end 0)) nil + (1 'message-header-name) + (2 'message-header-newsgroups nil t)) + (,(concat "^\\(X-[A-Za-z0-9-]+:\\|In-Reply-To:\\)" content) + (progn (goto-char (match-beginning 0)) (match-end 0)) nil + (1 'message-header-name) + (2 'message-header-xheader)) + (,(concat "^\\([A-Z][^: \n\t]+:\\)" content) + (progn (goto-char (match-beginning 0)) (match-end 0)) nil + (1 'message-header-name) + (2 'message-header-other nil t))) ,@(if (and mail-header-separator (not (equal mail-header-separator ""))) `((,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$") @@ -2436,7 +2427,7 @@ Return the number of headers removed." (looking-at "[!-9;-~]+:")) (looking-at regexp)) (progn - (incf number) + (cl-incf number) (when first (setq last t)) (delete-region @@ -2461,10 +2452,10 @@ Return the number of headers removed." (save-excursion (goto-char (point-min)) (while (re-search-forward regexp nil t) - (incf count))) + (cl-incf count))) (while (> count 1) (message-remove-header header nil t) - (decf count)))) + (cl-decf count)))) (defun message-narrow-to-headers () "Narrow the buffer to the head of the message." @@ -2607,6 +2598,36 @@ PGG manual, depending on the value of `mml2015-use'." (t 'message))))) +(defun message-all-recipients () + "Return a list of all recipients in the message, looking at TO, Cc and Bcc. + +Each recipient is in the format of `mail-extract-address-components'." + (mapcan (lambda (header) + (let ((header-value (message-fetch-field header))) + (and + header-value + (mail-extract-address-components header-value t)))) + '("To" "Cc" "Bcc"))) + +(defun message-all-epg-keys-available-p () + "Return non-nil if the pgp keyring has a public key for each recipient." + (require 'epa) + (let ((context (epg-make-context epa-protocol))) + (catch 'break + (dolist (recipient (message-all-recipients)) + (let ((recipient-email (cadr recipient))) + (when (and recipient-email (not (epg-list-keys context recipient-email))) + (throw 'break nil)))) + t))) + +(defun message-sign-encrypt-if-all-keys-available () + "Add MML tag to encrypt message when there is a key for each recipient. + +Consider adding this function to `message-send-hook' to +systematically send encrypted emails when possible." + (when (message-all-epg-keys-available-p) + (mml-secure-message-sign-encrypt))) + ;;; @@ -2844,8 +2865,7 @@ See also `message-forbidden-properties'." (message-display-abbrev)) (when (and message-strip-special-text-properties (message-tamago-not-in-use-p begin)) - (let ((buffer-read-only nil) - (inhibit-read-only t)) + (let ((inhibit-read-only t)) (remove-text-properties begin end message-forbidden-properties)))) (defvar message-smileys '(":-)" ":)" @@ -2952,7 +2972,7 @@ M-RET `message-newline-and-reformat' (break the line and reformat)." (easy-menu-add message-mode-menu message-mode-map) (easy-menu-add message-mode-field-menu message-mode-map) ;; Mmmm... Forbidden properties... - (add-hook 'after-change-functions 'message-strip-forbidden-properties + (add-hook 'after-change-functions #'message-strip-forbidden-properties nil 'local) ;; Allow mail alias things. (cond @@ -2960,7 +2980,9 @@ M-RET `message-newline-and-reformat' (break the line and reformat)." (mail-abbrevs-setup)) ((message-mail-alias-type-p 'ecomplete) (ecomplete-setup))) - (add-hook 'completion-at-point-functions 'message-completion-function nil t) + ;; FIXME: merge the completion tables from ecomplete/bbdb/...? + ;;(add-hook 'completion-at-point-functions #'message-ecomplete-capf nil t) + (add-hook 'completion-at-point-functions #'message-completion-function nil t) (unless buffer-file-name (message-set-auto-save-file-name)) (unless (buffer-base-buffer) @@ -3094,17 +3116,15 @@ M-RET `message-newline-and-reformat' (break the line and reformat)." (push-mark) (message-position-on-field "Summary" "Subject")) -(defun message-goto-body () - "Move point to the beginning of the message body." - (interactive) - (when (and (called-interactively-p 'any) - (looking-at "[ \t]*\n")) +(define-obsolete-function-alias 'message-goto-body-1 'message-goto-body "27.1") +(defun message-goto-body (&optional interactive) + "Move point to the beginning of the message body. +Returns point." + (interactive "p") + (when interactive + (when (looking-at "[ \t]*\n") (expand-abbrev)) - (push-mark) - (message-goto-body-1)) - -(defun message-goto-body-1 () - "Go to the body and return point." + (push-mark)) (goto-char (point-min)) (or (search-forward (concat "\n" mail-header-separator "\n") nil t) ;; If the message is mangled, find the end of the headers the @@ -3123,12 +3143,12 @@ M-RET `message-newline-and-reformat' (break the line and reformat)." "Return t if point is in the message body." (>= (point) (save-excursion - (message-goto-body-1)))) + (message-goto-body)))) -(defun message-goto-eoh () +(defun message-goto-eoh (&optional interactive) "Move point to the end of the headers." - (interactive) - (message-goto-body) + (interactive "p") + (message-goto-body interactive) (forward-line -1)) (defun message-goto-signature () @@ -3219,13 +3239,13 @@ or in the synonym headers, defined by `message-header-synonyms'." (dolist (header headers) (let* ((header-name (symbol-name (car header))) (new-header (cdr header)) - (synonyms (loop for synonym in message-header-synonyms - when (memq (car header) synonym) return synonym)) + (synonyms (cl-loop for synonym in message-header-synonyms + when (memq (car header) synonym) return synonym)) (old-header - (loop for synonym in synonyms - for old-header = (mail-fetch-field (symbol-name synonym)) - when (and old-header (string-match new-header old-header)) - return synonym))) + (cl-loop for synonym in synonyms + for old-header = (mail-fetch-field (symbol-name synonym)) + when (and old-header (string-match new-header old-header)) + return synonym))) (if old-header (message "already have `%s' in `%s'" new-header old-header) (when (and (message-position-on-field header-name) @@ -3545,7 +3565,7 @@ Note that this should not be used in newsgroups." (message-remove-header "Disposition-Notification-To")) (message-goto-eoh) (insert (format "Disposition-Notification-To: %s\n" - (or (message-field-value "Reply-to") + (or (message-field-value "Reply-To") (message-field-value "From") (message-make-from)))))) @@ -3586,7 +3606,7 @@ text was killed." "Create a rot table with offset N." (let ((i -1) (table (make-string 256 0))) - (while (< (incf i) 256) + (while (< (cl-incf i) 256) (aset table i i)) (concat (substring table 0 ?A) @@ -3754,13 +3774,13 @@ To use this automatically, you may add this function to (goto-char (mark t)) (insert-before-markers ?\n) (goto-char pt)))) - (case message-cite-reply-position - (above + (pcase message-cite-reply-position + ('above (message-goto-body) (insert body-text) (insert (if (bolp) "\n" "\n\n")) (message-goto-body)) - (below + ('below (message-goto-signature))) ;; Add a `message-setup-very-last-hook' here? ;; Add `gnus-article-highlight-citation' here? @@ -4278,7 +4298,7 @@ conformance." (point-max)))) (setq char (char-after))) (when (or (< char 128) - (and (mm-multibyte-p) + (and enable-multibyte-characters (memq (char-charset char) '(eight-bit-control eight-bit-graphic ;; Emacs 23, Bug#1770: @@ -4310,7 +4330,7 @@ conformance." (while (not (eobp)) (when (let ((char (char-after))) (or (< char 128) - (and (mm-multibyte-p) + (and enable-multibyte-characters ;; FIXME: Wrong for Emacs 23 (unicode) and for ;; things like undecodable utf-8 (in Emacs 21?). ;; Should at least use find-coding-systems-region. @@ -4383,7 +4403,7 @@ This function could be useful in `message-setup-hook'." (if (string= encoded bog) "" (format " (%s)" encoded)))))) - (error "Bogus address")))))))) + (user-error "Bogus address")))))))) (custom-add-option 'message-setup-hook 'message-check-recipients) @@ -4605,9 +4625,9 @@ This function could be useful in `message-setup-hook'." (with-current-buffer mailbuf message-courtesy-message))) ;; Let's make sure we encoded all the body. - (assert (save-excursion - (goto-char (point-min)) - (not (re-search-forward "[^\000-\377]" nil t)))) + (cl-assert (save-excursion + (goto-char (point-min)) + (not (re-search-forward "[^\000-\377]" nil t)))) (mm-disable-multibyte) (if (or (not message-send-mail-partially-limit) (< (buffer-size) message-send-mail-partially-limit) @@ -4672,9 +4692,11 @@ that instead." (message-send-mail-with-sendmail)) ((equal (car method) "smtp") (require 'smtpmail) - (let ((smtpmail-smtp-server (nth 1 method)) - (smtpmail-smtp-service (nth 2 method)) - (smtpmail-smtp-user (or (nth 3 method) smtpmail-smtp-user))) + (let* ((smtpmail-smtp-server (nth 1 method)) + (service (nth 2 method)) + (port (string-to-number service)) + (smtpmail-smtp-service (if (> port 0) port service)) + (smtpmail-smtp-user (or (nth 3 method) smtpmail-smtp-user))) (message-smtpmail-send-it))) (t (error "Unknown method %s" method)))))) @@ -4761,7 +4783,7 @@ to find out how to use this." (replace-match "\n") (run-hooks 'message-send-mail-hook) ;; send the message - (case + (pcase (let ((coding-system-for-write message-send-coding-system)) (apply 'call-process-region (point-min) (point-max) @@ -4792,7 +4814,7 @@ to find out how to use this." (100 (error "qmail-inject reported permanent failure")) (111 (error "qmail-inject reported transient failure")) ;; should never happen - (t (error "qmail-inject reported unknown failure")))) + (_ (error "qmail-inject reported unknown failure")))) (defvar mh-previous-window-config) @@ -5315,7 +5337,9 @@ Otherwise, generate and save a value for `canlock-password' first." ;; Check for control characters. (message-check 'control-chars (if (re-search-forward - (string-to-multibyte "[\000-\007\013\015-\032\034-\037\200-\237]") + (eval-when-compile + (decode-coding-string "[\000-\007\013\015-\032\034-\037\200-\237]" + 'binary)) nil t) (y-or-n-p "The article contains control characters. Really post? ") @@ -5417,7 +5441,7 @@ Otherwise, generate and save a value for `canlock-password' first." (concat "^" (regexp-quote mail-header-separator) "$") nil t) (replace-match "" t t )) - ;; Process FCC operations. + ;; Process Fcc operations. (while list (setq file (pop list)) (if (string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" file) @@ -5540,7 +5564,7 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'." ;; Instead we use this randomly inited counter. (setq message-unique-id-char (% (1+ (or message-unique-id-char - (logand (random most-positive-fixnum) (1- (lsh 1 20))))) + (random (ash 1 20)))) ;; (current-time) returns 16-bit ints, ;; and 2^16*25 just fits into 4 digits i base 36. (* 25 25))) @@ -5555,9 +5579,9 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'." user) (message-number-base36 (user-uid) -1)) (message-number-base36 (+ (car tm) - (lsh (% message-unique-id-char 25) 16)) 4) + (ash (% message-unique-id-char 25) 16)) 4) (message-number-base36 (+ (nth 1 tm) - (lsh (/ message-unique-id-char 25) 16)) 4) + (ash (/ message-unique-id-char 25) 16)) 4) ;; Append a given name, because while the generated ID is unique ;; to this newsreader, other newsreaders might otherwise generate ;; the same ID via another algorithm. @@ -5842,10 +5866,10 @@ subscribed address (and not the additional To and Cc header contents)." message-subscribed-address-functions)))) (save-match-data (let ((list - (loop for recipient in recipients - when (loop for regexp in mft-regexps - thereis (string-match regexp recipient)) - return recipient))) + (cl-loop for recipient in recipients + when (cl-loop for regexp in mft-regexps + thereis (string-match regexp recipient)) + return recipient))) (when list (if only-show-subscribed list @@ -6194,7 +6218,7 @@ they are." (when (> count maxcount) (let ((surplus (- count maxcount))) (message-shorten-1 refs cut surplus) - (decf count surplus))) + (cl-decf count surplus))) ;; When sending via news, make sure the total folded length will ;; be less than 998 characters. This is to cater to broken INN @@ -6719,9 +6743,9 @@ The function is called with one parameter, a cons cell ..." ;; Gmane renames "To". Look at "Original-To", too, if it is present in ;; message-header-synonyms. (setq to (or (message-fetch-field "to") - (and (loop for synonym in message-header-synonyms - when (memq 'Original-To synonym) - return t) + (and (cl-loop for synonym in message-header-synonyms + when (memq 'Original-To synonym) + return t) (message-fetch-field "original-to"))) cc (message-fetch-field "cc") extra (when message-extra-wide-headers @@ -6859,6 +6883,9 @@ want to get rid of this query permanently."))) (setq recipients (delq recip recipients)))))))) (setq recipients (message-prune-recipients recipients)) + (setq recipients + (cl-loop for (id . address) in recipients + collect (cons id (message--alter-repeat-address address)))) ;; Build the header alist. Allow the user to be asked whether ;; or not to reply to all recipients in a wide reply. @@ -6889,6 +6916,15 @@ want to get rid of this query permanently."))) (setq recipients (delq recipient recipients)))))))) recipients) +(defun message--alter-repeat-address (address) + "Transform an address on the form \"\"foo@bar.com\"\" <foo@bar.com>\". +The first bit will be elided if a match is made." + (let ((bits (gnus-extract-address-components address))) + (if (equal (car bits) (cadr bits)) + (car bits) + ;; Return the original address if we don't have repetition. + address))) + (defcustom message-simplify-subject-functions '(message-strip-list-identifiers message-strip-subject-re @@ -7403,7 +7439,8 @@ Optional DIGEST will use digest to forward." (when message-forward-included-headers (message-remove-header (if (listp message-forward-included-headers) - (regexp-opt message-forward-included-headers) + (mapconcat #'identity (cons "^$" message-forward-included-headers) + "\\|") message-forward-included-headers) t nil t))))) @@ -7877,6 +7914,8 @@ See `gmm-tool-bar-from-list' for the format of the list." :group 'message) (defvar image-load-path) +(declare-function image-load-path-for-library "image" + (library image &optional path no-error)) (defun message-make-tool-bar (&optional force) "Make a message mode tool bar from `message-tool-bar-list'. @@ -7903,6 +7942,7 @@ When FORCE, rebuild the tool bar." :type 'regexp) (defcustom message-completion-alist + ;; FIXME: Make it possible to use the standard completion UI. (list (cons message-newgroups-header-regexp 'message-expand-group) '("^\\(Resent-\\)?\\(To\\|B?Cc\\):" . message-expand-name) '("^\\(Reply-To\\|From\\|Mail-Followup-To\\|Mail-Copies-To\\):" @@ -8126,11 +8166,12 @@ From headers in the original article." (message-tokenize-header (mail-strip-quoted-names (mapconcat 'message-fetch-reply-field fields ",")))) - (email (cond ((functionp message-alternative-emails) - (car (cl-remove-if-not message-alternative-emails emails))) - (t (loop for email in emails - if (string-match-p message-alternative-emails email) - return email))))) + (email + (cond ((functionp message-alternative-emails) + (car (cl-remove-if-not message-alternative-emails emails))) + (t (cl-loop for email in emails + if (string-match-p message-alternative-emails email) + return email))))) (unless (or (not email) (equal email user-mail-address)) (message-remove-header "From") (goto-char (point-max)) @@ -8226,16 +8267,19 @@ From headers in the original article." (autoload 'ecomplete-display-matches "ecomplete") +(defun message--in-tocc-p () + (and (memq (char-after (point-at-bol)) '(?C ?T ?\t ? )) + (message-point-in-header-p) + (save-excursion + (beginning-of-line) + (while (and (memq (char-after) '(?\t ? )) + (zerop (forward-line -1)))) + (looking-at "To:\\|Cc:")))) + (defun message-display-abbrev (&optional choose) "Display the next possible abbrev for the text before point." (interactive (list t)) - (when (and (memq (char-after (point-at-bol)) '(?C ?T ?\t ? )) - (message-point-in-header-p) - (save-excursion - (beginning-of-line) - (while (and (memq (char-after) '(?\t ? )) - (zerop (forward-line -1)))) - (looking-at "To:\\|Cc:"))) + (when (message--in-tocc-p) (let* ((end (point)) (start (save-excursion (and (re-search-backward "[\n\t ]" nil t) @@ -8248,6 +8292,20 @@ From headers in the original article." (delete-region start end) (insert match))))) +(defun message-ecomplete-capf () + "Return completion data for email addresses in Ecomplete. +Meant for use on `completion-at-point-functions'." + (when (and (bound-and-true-p ecomplete-database) + (fboundp 'ecomplete-completion-table) + (message--in-tocc-p)) + (let ((end (save-excursion + (skip-chars-forward "^, \t\n") + (point))) + (start (save-excursion + (skip-chars-backward "^, \t\n") + (point)))) + `(,start ,end ,(ecomplete-completion-table 'mail))))) + ;; To send pre-formatted letters like the example below, you can use ;; `message-send-form-letter': ;; --8<---------------cut here---------------start------------->8--- @@ -8355,6 +8413,9 @@ even if NEW-VALUE is empty." (message-position-on-field header)) (insert new-value)))) +(make-obsolete-variable + 'message-recipients-without-full-name + "Recipients are simplified by default" "27.1") (defcustom message-recipients-without-full-name (list "ding@gnus.org" "bugs@gnus.org" @@ -8370,6 +8431,7 @@ Used in `message-simplify-recipients'." :version "23.1" ;; No Gnus :group 'message-headers) +(make-obsolete 'message-simplify-recipients nil "27.1") (defun message-simplify-recipients () (interactive) (dolist (hdr '("Cc" "To")) |