(require 'mml))
(require 'rfc822)
-(eval-and-compile
- (autoload 'customize-save-variable "cus-edit") ;; for Mule 2.
- (autoload 'sha1 "sha1-el")
- (autoload 'gnus-find-method-for-group "gnus")
- (autoload 'nnvirtual-find-group-art "nnvirtual")
- (autoload 'gnus-group-decoded-name "gnus-group"))
(defgroup message '((user-mail-address custom-variable)
(user-full-name custom-variable))
(defcustom message-fcc-externalize-attachments nil
"If non-nil, attachments are included as external parts in Fcc copies."
+ :version "21.4"
:type 'boolean
:group 'message-sending)
`message-subject-trailing-was-query' is t, always strip the trailing
old subject. In this case, `message-subject-trailing-was-regexp' is
used."
+ :version "21.4"
:type '(choice (const :tag "never" nil)
(const :tag "always strip" t)
(const ask))
`message-subject-trailing-was-regexp' instead.
It is okay to create some false positives here, as the user is asked."
+ :version "21.4"
:group 'message-various
:link '(custom-manual "(message)Message Headers")
:type 'regexp)
matched against `message-subject-trailing-was-regexp' in
`message-strip-subject-trailing-was'. You should use a regexp creating very
few false positives here."
+ :version "21.4"
:group 'message-various
:link '(custom-manual "(message)Message Headers")
:type 'regexp)
(defcustom message-mark-insert-begin
"--8<---------------cut here---------------start------------->8---\n"
"How to mark the beginning of some inserted text."
+ :version "21.4"
:type 'string
:link '(custom-manual "(message)Insertion Variables")
:group 'message-various)
(defcustom message-mark-insert-end
"--8<---------------cut here---------------end--------------->8---\n"
"How to mark the end of some inserted text."
+ :version "21.4"
:type 'string
:link '(custom-manual "(message)Insertion Variables")
:group 'message-various)
"X-No-Archive: Yes\n"
"Header to insert when you don't want your article to be archived.
Archives \(such as groups.google.com\) respect this header."
+ :version "21.4"
:type 'string
:link '(custom-manual "(message)Header Commands")
:group 'message-various)
"X-No-Archive: Yes - save http://groups.google.com/"
"Note to insert why you wouldn't want this posting archived.
If nil, don't insert any text in the body."
+ :version "21.4"
:type '(radio (string :format "%t: %v\n" :size 0)
(const nil))
:link '(custom-manual "(message)Header Commands")
If nil, `message-cross-post-followup-to' will only do a followup. Note that
you can explicitly override this setting by calling
`message-cross-post-followup-to' with a prefix."
+ :version "21.4"
:type 'boolean
:group 'message-various)
(defcustom message-cross-post-note
"Crosspost & Followup-To: "
"Note to insert before signature to notify of xpost and follow-up."
+ :version "21.4"
:type 'string
:group 'message-various)
(defcustom message-followup-to-note
"Followup-To: "
"Note to insert before signature to notify of follow-up only."
+ :version "21.4"
:type 'string
:group 'message-various)
The function will be called with four arguments. The function should not only
insert a note, but also ensure old notes are deleted. See the documentation
for `message-cross-post-insert-note'."
+ :version "21.4"
:type 'function
:group 'message-various)
(defcustom message-insert-canlock t
"Whether to insert a Cancel-Lock header in news postings."
- :version "21.3"
+ :version "21.4"
:group 'message-headers
:type 'boolean)
"*Headers to be generated or prompted for when sending a message.
Also see `message-required-news-headers' and
`message-required-mail-headers'."
+ :version "21.4"
:group 'message-news
:group 'message-headers
:link '(custom-manual "(message)Message Headers")
(defcustom message-draft-headers '(References From)
"*Headers to be generated when saving a draft message."
+ :version "21.4"
:group 'message-news
:group 'message-headers
:link '(custom-manual "(message)Message Headers")
:link '(custom-manual "(message)Mail Headers")
:type 'regexp)
-(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:\\|^X-Payment:"
+(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:\\|^X-Payment:\\|^Approved:"
"*Header lines matching this regexp will be deleted before posting.
It's best to delete old Path and Date headers before posting to avoid
any confusion."
(if (string-match "[[:digit:]]" "1") ;; support POSIX?
"\\([ \t]*[-_.[:word:]]+>+\\|[ \t]*[]>|}+]\\)+"
;; ?-, ?_ or ?. MUST NOT be in syntax entry w.
- (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)
+ (let (non-word-constituents)
+ (with-syntax-table text-mode-syntax-table
+ (setq non-word-constituents
+ (concat
+ (if (string-match "\\w" "-") "" "-")
+ (if (string-match "\\w" "_") "" "_")
+ (if (string-match "\\w" ".") "" "."))))
(if (equal non-word-constituents "")
"\\([ \t]*\\(\\w\\)+>+\\|[ \t]*[]>|}+]\\)+"
(concat "\\([ \t]*\\(\\w\\|["
If nil, always ignore the header. If it is the symbol `ask', always
query the user whether to use the value. If it is t or the symbol
`use', always use the value."
+ :version "21.4"
:group 'message-interface
:type '(choice (const :tag "ignore" nil)
(const :tag "maybe" t)
regular expressions to match lists. These functions can be used in
conjunction with `message-subscribed-regexps' and
`message-subscribed-addresses'."
+ :version "21.4"
:group 'message-interface
:link '(custom-manual "(message)Mailing Lists")
:type '(repeat sexp))
"*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."
+ :version "21.4"
:group 'message-interface
:link '(custom-manual "(message)Mailing Lists")
:type '(radio (file :format "%t: %v\n" :size 0)
If nil, do not use any predefined list subscriptions. This list of
addresses can be used in conjunction with
`message-subscribed-address-functions' and `message-subscribed-regexps'."
+ :version "21.4"
:group 'message-interface
:link '(custom-manual "(message)Mailing Lists")
:type '(repeat string))
If nil, do not use any predefined list subscriptions. This list of
regular expressions can be used in conjunction with
`message-subscribed-address-functions' and `message-subscribed-addresses'."
+ :version "21.4"
:group 'message-interface
:link '(custom-manual "(message)Mailing Lists")
:type '(repeat regexp))
If it is the symbol `always', the posting is allowed. If it is the
symbol `never', the posting is not allowed. If it is the symbol
`ask', you are prompted."
+ :version "21.4"
:group 'message-interface
:link '(custom-manual "(message)Message Headers")
:type '(choice (const always)
:type '(choice (function)
(repeat string)))
-(defvar message-cater-to-broken-inn t
- "Non-nil means Gnus should not fold the `References' header.
-Folding `References' makes ancient versions of INN create incorrect
-NOV lines.")
-
(eval-when-compile
(defvar gnus-post-method)
(defvar gnus-select-method))
;; is nil. See: http://article.gmane.org/gmane.emacs.gnus.general/51138
(defcustom message-generate-headers-first '(references)
"Which headers should be generated before starting to compose a message.
-If `t', generate all required headers. This can also be a list of headers to
+If t, generate all required headers. This can also be a list of headers to
generate. The variables `message-required-news-headers' and
`message-required-mail-headers' specify which headers to generate.
"*Prefix inserted on cited or empty lines of yanked messages.
Fix `message-cite-prefix-regexp' if it is set to an abnormal value.
See also `message-yank-prefix'."
+ :version "21.4"
:type 'string
:link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
;;;###autoload
(defcustom message-signature-insert-empty-line t
"*If non-nil, insert an empty line before the signature separator."
+ :version "21.4"
:type 'boolean
:link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
"Regexp of headers to be hidden when composing new messages.
This can also be a list of regexps to match headers. Or a list
starting with `not' and followed by regexps."
+ :version "21.4"
:group 'message
:link '(custom-manual "(message)Message Headers")
:type '(repeat regexp))
+(defcustom message-cite-articles-with-x-no-archive t
+ "If non-nil, cite text from articles that has X-No-Archive set."
+ :group 'message
+ :type 'boolean)
+
;;; Internal variables.
;;; Well, not really internal.
for a message, the subaddresses will be removed (if present) before
the mail is sent. All addresses in this structure should be
downcased."
+ :version "21.4"
:group 'message-headers
:type '(repeat (repeat string)))
"Like `mail-user-agent'.
Except if it is nil, use Gnus native MUA; if it is t, use
`mail-user-agent'."
+ :version "21.4"
:type '(radio (const :tag "Gnus native"
:format "%t\n"
nil)
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."
- :version "21.3"
+ :version "21.4"
:group 'message-headers
:link '(custom-manual "(message)Wide Reply")
:type 'boolean)
(executable-find idna-program)
'ask)
"Whether to encode non-ASCII in domain names into ASCII according to IDNA."
+ :version "21.4"
:group 'message-headers
:link '(custom-manual "(message)IDNA")
:type '(choice (const :tag "Ask" ask)
"^|? *---+ +Message text follows: +---+ *|?$")
"A regexp that matches the separator before the text of a failed message.")
+(defvar message-field-fillers
+ '((To message-fill-field-address)
+ (Cc message-fill-field-address)
+ (From message-fill-field-address))
+ "Alist of header names/filler functions.")
+
(defvar message-header-format-alist
`((Newsgroups)
- (To . message-fill-address)
- (Cc . message-fill-address)
+ (To)
+ (Cc)
(Subject)
(In-Reply-To)
(Fcc)
"\\)")
"Regular expression that matches a valid FQDN."
;; see also: gnus-button-valid-fqdn-regexp
+ :version "21.4"
:group 'message-headers
:type 'regexp)
(eval-and-compile
- (autoload 'message-setup-toolbar "messagexmas")
- (autoload 'mh-new-draft-name "mh-comp")
- (autoload 'mh-send-letter "mh-comp")
- (autoload 'gnus-point-at-eol "gnus-util")
- (autoload 'gnus-point-at-bol "gnus-util")
- (autoload 'gnus-output-to-rmail "gnus-util")
- (autoload 'gnus-output-to-mail "gnus-util")
- (autoload 'nndraft-request-associate-buffer "nndraft")
- (autoload 'nndraft-request-expire-articles "nndraft")
- (autoload 'gnus-open-server "gnus-int")
- (autoload 'gnus-request-post "gnus-int")
- (autoload 'gnus-copy-article-buffer "gnus-msg")
(autoload 'gnus-alive-p "gnus-util")
- (autoload 'gnus-server-string "gnus")
+ (autoload 'gnus-delay-article "gnus-delay")
+ (autoload 'gnus-extract-address-components "gnus-util")
+ (autoload 'gnus-find-method-for-group "gnus")
+ (autoload 'gnus-group-decoded-name "gnus-group")
(autoload 'gnus-group-name-charset "gnus-group")
(autoload 'gnus-group-name-decode "gnus-group")
(autoload 'gnus-groups-from-server "gnus")
- (autoload 'rmail-output "rmailout")
- (autoload 'gnus-delay-article "gnus-delay")
(autoload 'gnus-make-local-hook "gnus-util")
- (autoload 'gnus-extract-address-components "gnus-util"))
-
-(eval-and-compile
- (autoload 'mu-cite-original "mu-cite"))
+ (autoload 'gnus-open-server "gnus-int")
+ (autoload 'gnus-output-to-mail "gnus-util")
+ (autoload 'gnus-output-to-rmail "gnus-util")
+ (autoload 'gnus-request-post "gnus-int")
+ (autoload 'gnus-server-string "gnus")
+ (autoload 'idna-to-ascii "idna")
+ (autoload 'message-setup-toolbar "messagexmas")
+ (autoload 'mh-new-draft-name "mh-comp")
+ (autoload 'mh-send-letter "mh-comp")
+ (autoload 'mu-cite-original "mu-cite")
+ (autoload 'nndraft-request-associate-buffer "nndraft")
+ (autoload 'nndraft-request-expire-articles "nndraft")
+ (autoload 'nnvirtual-find-group-art "nnvirtual")
+ (autoload 'rmail-dont-reply-to "mail-utils")
+ (autoload 'rmail-msg-is-pruned "rmail")
+ (autoload 'rmail-msg-restore-non-pruned-header "rmail")
+ (autoload 'rmail-output "rmailout"))
\f
(if (not header)
nil
(let ((regexp (format "[%s]+" (or separator ",")))
- (beg 1)
+ (beg (point-min))
(first t)
quoted elems paren)
(with-temp-buffer
The buffer is expected to be narrowed to just the header of the message;
see `message-narrow-to-headers-or-head'."
(let* ((inhibit-point-motion-hooks t)
- (case-fold-search t)
(value (mail-fetch-field header nil (not not-all))))
(when value
(while (string-match "\n[\t ]+" value)
(setq value (replace-match " " t t value)))
- (set-text-properties 0 (length value) nil value)
value)))
(defun message-field-value (header &optional not-all)
(defun message-narrow-to-field ()
"Narrow the buffer to the header on the current line."
(beginning-of-line)
+ (while (looking-at "[ \t]")
+ (forward-line -1))
(narrow-to-region
(point)
(progn
(forward-line 1)
(if (re-search-forward "^[^ \n\t]" nil t)
- (progn
- (beginning-of-line)
- (point))
+ (point-at-bol)
(point-max))))
(goto-char (point-min)))
(1+ max)))))
(message-sort-headers-1))))
+(defun message-kill-address ()
+ "Kill the address under point."
+ (interactive)
+ (let ((start (point)))
+ (message-skip-to-next-address)
+ (kill-region start (point))))
+
\f
;;;
(define-key message-mode-map "\C-c\C-d" 'message-dont-send)
(define-key message-mode-map "\C-c\n" 'gnus-delay-article)
+ (define-key message-mode-map "\C-c\M-k" 'message-kill-address)
(define-key message-mode-map "\C-c\C-e" 'message-elide-region)
(define-key message-mode-map "\C-c\C-v" 'message-delete-not-region)
(define-key message-mode-map "\C-c\C-z" 'message-kill-to-signature)
(define-key message-mode-map "\M-\r" 'message-newline-and-reformat)
- ;;(define-key message-mode-map "\M-q" 'message-fill-paragraph)
(define-key message-mode-map [remap split-line] 'message-split-line)
(define-key message-mode-map "\C-a" 'message-beginning-of-line)
(define-key message-mode-map "\C-xk" 'message-mimic-kill-buffer))
(easy-menu-define
- message-mode-menu message-mode-map "Message Menu."
- `("Message"
- ["Yank Original" message-yank-original t]
- ["Fill Yanked Message" message-fill-yanked-message t]
- ["Insert Signature" message-insert-signature t]
- ["Caesar (rot13) Message" message-caesar-buffer-body t]
- ["Caesar (rot13) Region" message-caesar-region (message-mark-active-p)]
- ["Elide Region" message-elide-region
- :active (message-mark-active-p)
- ,@(if (featurep 'xemacs) nil
- '(:help "Replace text in region with an ellipsis"))]
- ["Delete Outside Region" message-delete-not-region
- :active (message-mark-active-p)
- ,@(if (featurep 'xemacs) nil
- '(:help "Delete all quoted text outside region"))]
- ["Kill To Signature" message-kill-to-signature t]
- ["Newline and Reformat" message-newline-and-reformat t]
- ["Rename buffer" message-rename-buffer t]
- ["Spellcheck" ispell-message
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Spellcheck this message"))]
- ["Attach file as MIME" mime-edit-insert-file
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Attach a file at point"))]
- "----"
- ["Insert Region Marked" message-mark-inserted-region
- :active (message-mark-active-p)
- ,@(if (featurep 'xemacs) nil
- '(:help "Mark region with enclosing tags"))]
- ["Insert File Marked..." message-mark-insert-file
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Insert file at point marked with enclosing tags"))]
- "----"
- ["Send Message" message-send-and-exit
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Send this message"))]
- ["Postpone Message" message-dont-send
- ,@(if (featurep 'xemacs) '(t)
- '(:help "File this draft message and exit"))]
- ["Send at Specific Time..." gnus-delay-article
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Ask, then arrange to send message at that time"))]
- ["Kill Message" message-kill-buffer
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Delete this message without sending"))]))
+ message-mode-menu message-mode-map "Message Menu."
+ `("Message"
+ ["Yank Original" message-yank-original t]
+ ["Fill Yanked Message" message-fill-yanked-message t]
+ ["Insert Signature" message-insert-signature t]
+ ["Caesar (rot13) Message" message-caesar-buffer-body t]
+ ["Caesar (rot13) Region" message-caesar-region (message-mark-active-p)]
+ ["Elide Region" message-elide-region
+ :active (message-mark-active-p)
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Replace text in region with an ellipsis"))]
+ ["Delete Outside Region" message-delete-not-region
+ :active (message-mark-active-p)
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Delete all quoted text outside region"))]
+ ["Kill To Signature" message-kill-to-signature t]
+ ["Newline and Reformat" message-newline-and-reformat t]
+ ["Rename buffer" message-rename-buffer t]
+ ["Spellcheck" ispell-message
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Spellcheck this message"))]
+ ["Attach file as MIME" mime-edit-insert-file
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Attach a file at point"))]
+ "----"
+ ["Insert Region Marked" message-mark-inserted-region
+ :active (message-mark-active-p)
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Mark region with enclosing tags"))]
+ ["Insert File Marked..." message-mark-insert-file
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Insert file at point marked with enclosing tags"))]
+ "----"
+ ["Send Message" message-send-and-exit
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Send this message"))]
+ ["Postpone Message" message-dont-send
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "File this draft message and exit"))]
+ ["Send at Specific Time..." gnus-delay-article
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Ask, then arrange to send message at that time"))]
+ ["Kill Message" message-kill-buffer
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Delete this message without sending"))]))
(easy-menu-define
- message-mode-field-menu message-mode-map ""
- `("Field"
- ["To" message-goto-to t]
- ["From" message-goto-from t]
- ["Subject" message-goto-subject t]
- ["Change subject..." message-change-subject t]
- ["Cc" message-goto-cc t]
- ["Bcc" message-goto-bcc t]
- ["Fcc" message-goto-fcc t]
- ["Reply-To" message-goto-reply-to t]
- ["Flag As Important" message-insert-importance-high
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Mark this message as important"))]
- ["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 receipt notification"))]
- "----"
- ;; (typical) news stuff
- ["Summary" message-goto-summary t]
- ["Keywords" message-goto-keywords t]
- ["Newsgroups" message-goto-newsgroups t]
- ["Fetch Newsgroups" message-insert-newsgroups t]
- ["Followup-To" message-goto-followup-to t]
- ;; ["Followup-To (with note in body)" message-cross-post-followup-to t]
- ["Crosspost / Followup-To..." message-cross-post-followup-to t]
- ["Distribution" message-goto-distribution t]
- ["X-No-Archive:" message-add-archive-header t ]
- "----"
- ;; (typical) mailing-lists stuff
- ["Fetch To" message-insert-to
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Insert a To header that points to the author."))]
- ["Fetch To and Cc" message-insert-wide-reply
- ,@(if (featurep 'xemacs) '(t)
- '(:help
- "Insert To and Cc headers as if you were doing a wide reply."))]
- "----"
- ["Send to list only" message-to-list-only t]
- ["Mail-Followup-To" message-goto-mail-followup-to t]
- ["Mail-Reply-To" message-goto-mail-reply-to t]
- ["Mail-Copies-To" message-goto-mail-copies-to t]
- ["Unsubscribed list post" message-generate-unsubscribed-mail-followup-to
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Insert a reasonable `Mail-Followup-To:' header."))]
- ["Reduce To: to Cc:" message-reduce-to-to-cc t]
- "----"
- ["Sort Headers" message-sort-headers t]
- ["Encode non-ASCII domain names" message-idna-to-ascii-rhs t]
- ["Goto Body" message-goto-body t]
- ["Goto Signature" message-goto-signature t]))
+ message-mode-field-menu message-mode-map ""
+ `("Field"
+ ["To" message-goto-to t]
+ ["From" message-goto-from t]
+ ["Subject" message-goto-subject t]
+ ["Change subject..." message-change-subject t]
+ ["Cc" message-goto-cc t]
+ ["Bcc" message-goto-bcc t]
+ ["Fcc" message-goto-fcc t]
+ ["Reply-To" message-goto-reply-to t]
+ ["Flag As Important" message-insert-importance-high
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Mark this message as important"))]
+ ["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 receipt notification"))]
+ "----"
+ ;; (typical) news stuff
+ ["Summary" message-goto-summary t]
+ ["Keywords" message-goto-keywords t]
+ ["Newsgroups" message-goto-newsgroups t]
+ ["Fetch Newsgroups" message-insert-newsgroups t]
+ ["Followup-To" message-goto-followup-to t]
+ ;; ["Followup-To (with note in body)" message-cross-post-followup-to t]
+ ["Crosspost / Followup-To..." message-cross-post-followup-to t]
+ ["Distribution" message-goto-distribution t]
+ ["X-No-Archive:" message-add-archive-header t ]
+ "----"
+ ;; (typical) mailing-lists stuff
+ ["Fetch To" message-insert-to
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Insert a To header that points to the author."))]
+ ["Fetch To and Cc" message-insert-wide-reply
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help
+ "Insert To and Cc headers as if you were doing a wide reply."))]
+ "----"
+ ["Send to list only" message-to-list-only t]
+ ["Mail-Followup-To" message-goto-mail-followup-to t]
+ ["Mail-Reply-To" message-goto-mail-reply-to t]
+ ["Mail-Copies-To" message-goto-mail-copies-to t]
+ ["Unsubscribed list post" message-generate-unsubscribed-mail-followup-to
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Insert a reasonable `Mail-Followup-To:' header."))]
+ ["Reduce To: to Cc:" message-reduce-to-to-cc t]
+ "----"
+ ["Sort Headers" message-sort-headers t]
+ ["Encode non-ASCII domain names" message-idna-to-ascii-rhs t]
+ ["Goto Body" message-goto-body t]
+ ["Goto Signature" message-goto-signature t]))
(defvar message-tool-bar-map nil)
packages requires these properties to be present in order to work.
If you use one of these packages, turn this option off, and hope the
message composition doesn't break too bad."
+ :version "21.4"
:group 'message-various
:link '(custom-manual "(message)Various Message Variables")
:type 'boolean)
(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)))
- (while (not (= begin end))
- (when (not (get-text-property begin 'message-hidden))
- (remove-text-properties begin (1+ begin)
- message-forbidden-properties))
- (incf begin))))
+ (dolist (from-to (message-text-with-property 'message-hidden
+ begin end t))
+ (remove-text-properties (car from-to) (cdr from-to)
+ message-forbidden-properties))))
;;;###autoload
(define-derived-mode message-mode text-mode "Message"
(setq message-parameter-alist
(copy-sequence message-startup-parameter-alist))
(message-setup-fill-variables)
- (set
- (make-local-variable 'paragraph-separate)
- (format "\\(%s\\)\\|\\(%s\\)"
- paragraph-separate
- "<#!*/?\\(multipart\\|part\\|external\\|mml\\|secure\\)"))
;; Allow using comment commands to add/remove quoting.
- (set (make-local-variable 'comment-start) message-yank-prefix)
+ ;; (set (make-local-variable 'comment-start) message-yank-prefix)
+ (when message-yank-prefix
+ (set (make-local-variable 'comment-start) message-yank-prefix)
+ (set (make-local-variable 'comment-start-skip)
+ (concat "^" (regexp-quote message-yank-prefix) "[ \t]*")))
(if (featurep 'xemacs)
(message-setup-toolbar)
(set (make-local-variable 'font-lock-defaults)
"---+$\\|" ; delimiters for forwarded messages
page-delimiter "$\\|" ; spoiler warnings
".*wrote:$\\|" ; attribution lines
- quote-prefix-regexp "$")) ; empty lines in quoted text
+ quote-prefix-regexp "$\\|" ; empty lines in quoted text
+ mime-edit-tag-regexp)) ; MIME-Edit tags
(setq paragraph-separate paragraph-start)
(setq adaptive-fill-regexp
(concat quote-prefix-regexp "\\|" adaptive-fill-regexp))
(message-position-on-field "Followup-To" "Newsgroups"))
(defun message-goto-mail-followup-to ()
- "Move point to the Mail-Followup-To header. If the header is newly created
-and To field contains only one address, the address is inserted in default."
+ "Move point to the Mail-Followup-To header.
+If the header is newly created and To field contains only one address,
+the address is inserted by default."
(interactive)
- (unless (message-position-on-field "Mail-Followup-To" "Subject")
+ (unless (message-position-on-field "Mail-Followup-To" "To")
(let ((start (point))
addresses)
(save-restriction
E.g., if this list contains a member list with elements `Cc' and `To',
then `message-carefully-insert-headers' will not insert a `To' header
when the message is already `Cc'ed to the recipient."
+ :version "21.4"
:group 'message-headers
:link '(custom-manual "(message)Message Headers")
:type '(repeat sexp))
;; FIXME: Should compare only the address and not the full name. Comparison
;; should be done case-folded (and with `string=' rather than
;; `string-match').
+ ;; (mail-strip-quoted-names "Foo Bar <foo@bar>, bla@fasel (Bla Fasel)")
(dolist (header headers)
(let* ((header-name (symbol-name (car header)))
(new-header (cdr header))
(when (message-goto-signature)
(forward-line -2)))
-(defun message-kill-to-signature ()
- "Deletes all text up to the signature."
- (interactive)
- (let ((point (point)))
- (message-goto-signature)
- (unless (eobp)
- (end-of-line -1))
- (kill-region point (point))
- (unless (bolp)
- (insert "\n"))))
+(defun message-kill-to-signature (&optional arg)
+ "Kill all text up to the signature.
+If a numberic argument or prefix arg is given, leave that number
+of lines before the signature intact."
+ (interactive "p")
+ (save-excursion
+ (save-restriction
+ (let ((point (point)))
+ (narrow-to-region point (point-max))
+ (message-goto-signature)
+ (unless (eobp)
+ (if (and arg (numberp arg))
+ (forward-line (- -1 arg))
+ (end-of-line -1)))
+ (unless (= point (point))
+ (kill-region point (point))
+ (insert "\n"))))))
(defun message-newline-and-reformat (&optional arg not-break)
"Insert four newlines, and then reformat if inside quoted text.
(interactive (list (if current-prefix-arg 'full)))
(if (if (boundp 'filladapt-mode) filladapt-mode)
nil
- (message-newline-and-reformat arg t)
+ (if (message-point-in-header-p)
+ (message-fill-field)
+ (message-newline-and-reformat arg t))
t))
;; Is it better to use `mail-header-end'?
(run-hooks 'mail-citation-hook)
(let ((start (point))
(end (mark t))
+ (x-no-archive nil)
(functions
(when message-indent-citation-function
(if (listp 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)))
+ (save-restriction
+ (narrow-to-region (point) (if (search-forward "\n\n" nil t)
+ (1- (point))
+ (point-max)))
+ (mail-header-set-from message-reply-headers
(or (message-fetch-field "from")
- "unknown sender")))
+ "unknown sender"))
+ (setq x-no-archive (message-fetch-field "x-no-archive")))
(goto-char start)
(while functions
(funcall (pop functions)))
(when message-citation-line-function
(unless (bolp)
(insert "\n"))
- (funcall message-citation-line-function)))))
+ (funcall message-citation-line-function))
+ (when (and x-no-archive
+ message-cite-articles-with-x-no-archive
+ (string-match "yes" x-no-archive))
+ (undo-boundary)
+ (delete-region (point) (mark t))
+ (insert "> [Quoted text removed due to X-No-Archive]\n")
+ (forward-line -1)))))
(defun message-insert-citation-line ()
"Insert a simple citation line."
'(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-text-with-property (prop &optional start end reverse)
+ "Return a list of start and end positions where the text has PROP.
+START and END bound the search, they default to `point-min' and
+`point-max' respectively. If REVERSE is non-nil, find text which does
+not have PROP."
+ (unless start
+ (setq start (point-min)))
+ (unless end
+ (setq end (point-max)))
+ (let (next regions)
+ (if reverse
+ (while (and start
+ (setq start (text-property-any start end prop nil)))
+ (setq next (next-single-property-change start prop nil end))
+ (push (cons start (or next end)) regions)
+ (setq start next))
+ (while (and start
+ (or (get-text-property start prop)
+ (and (setq start (next-single-property-change
+ start prop nil end))
+ (get-text-property start prop))))
+ (setq next (text-property-any start end prop nil))
+ (push (cons start (or next end)) regions)
+ (setq start next)))
+ (nreverse regions)))
(defun message-fix-before-sending ()
"Do various things to make the message nice before sending it."
(unless (bolp)
(insert "\n"))
;; Make the hidden headers visible.
- (let ((points (message-text-with-property 'message-hidden)))
- (when points
- (goto-char (car points))
- (dolist (point points)
- (add-text-properties point (1+ point)
- '(invisible nil intangible nil)))))
+ (dolist (from-to (message-text-with-property 'message-hidden))
+ (add-text-properties (car from-to) (cdr from-to)
+ '(invisible nil intangible nil)))
;; Make invisible text visible except for mime parts which may be
;; inserted by the MIME-Edit.
;; It doesn't seem as if this is useful, since the invisible property
font-lock-face highlight))))
(when hidden-start
(goto-char hidden-start)
- (set-window-start (selected-window) (gnus-point-at-bol))
+ (set-window-start (selected-window) (point-at-bol))
(unless (yes-or-no-p
"Invisible text found and made visible; continue sending? ")
(error "Invisible text found and made visible")))))
(when (eval message-mailer-swallows-blank-line)
(newline))
(when message-interactive
- (save-excursion
- (set-buffer errbuf)
+ (with-current-buffer errbuf
(erase-buffer))))
(let* ((default-directory "/")
(cpr (as-binary-process
(save-excursion
(set-buffer errbuf)
(goto-char (point-min))
- (while (re-search-forward "\n\n* *" nil t)
+ (while (re-search-forward "\n+ *" nil t)
(replace-match "; "))
(if (not (zerop (buffer-size)))
(error "Sending...failed to %s"
(case
(as-binary-process
(apply
- 'call-process-region 1 (point-max) message-qmail-inject-program
- nil nil nil
+ 'call-process-region (point-min) (point-max)
+ message-qmail-inject-program nil nil nil
;; qmail-inject's default behaviour is to look for addresses on the
;; command line; if there're none, it scans the headers.
;; yes, it does The Right Thing w.r.t. Resent-To and it's kin.
"Send the prepared message buffer with `smtpmail-send-it'.
This only differs from `smtpmail-send-it' that this command evaluates
`message-send-mail-hook' just before sending a message. It is useful
-if your ISP requires the POP-before-SMTP authentication. See the
-documentation for the function `mail-source-touch-pop'."
+if your ISP requires the POP-before-SMTP authentication. See the Gnus
+manual for details."
(run-hooks 'message-send-mail-hook)
(smtpmail-send-it))
(defun message-canlock-generate ()
"Return a string that is non-trivial to guess.
Do not use this for anything important, it is cryptographically weak."
+ (require 'sha1)
(let (sha1-maximum-internal-length)
(sha1 (concat (message-unique-id)
(format "%x%x%x" (random) (random t) (random))
(defun message-make-date (&optional now)
"Make a valid data header.
If NOW, use that time instead."
- (let* ((now (or now (current-time)))
- (zone (nth 8 (decode-time now)))
- (sign "+"))
- (when (< zone 0)
- (setq sign "-")
- (setq zone (- zone)))
- (concat
- ;; The day name of the %a spec is locale-specific. Pfff.
- (format "%s, " (capitalize (car (rassoc (nth 6 (decode-time now))
- parse-time-weekdays))))
- (format-time-string "%d" now)
- ;; The month name of the %b spec is locale-specific. Pfff.
- (format " %s "
- (capitalize (car (rassoc (nth 4 (decode-time now))
- parse-time-months))))
- (format-time-string "%Y %H:%M:%S " now)
- ;; We do all of this because XEmacs doesn't have the %z spec.
- (format "%s%02d%02d" sign (/ zone 3600) (/ (% zone 3600) 60)))))
+ (let ((system-time-locale "C"))
+ (format-time-string "%a, %d %b %Y %T %z" now)))
(defun message-make-followup-subject (subject)
"Make a followup Subject."
(delete-region (match-beginning 0) (1+ (std11-field-end)))))))
message-user-agent)
-(defun message-idna-inside-rhs-p ()
- "Return t iff point is inside a RHS (heuristically).
-Only works properly if header contains mailbox-list or address-list.
-I.e., calling it on a Subject: header is useless."
- (save-restriction
- (narrow-to-region (save-excursion (or (re-search-backward "^[^ \t]" nil t)
- (point-min)))
- (save-excursion (or (re-search-forward "^[^ \t]" nil t)
- (point-max))))
- (if (re-search-backward "[\\\n\r\t ]"
- (save-excursion (search-backward "@" nil t)) t)
- ;; whitespace between @ and point
- nil
- (let ((dquote 1) (paren 1))
- (while (save-excursion (re-search-backward "[^\\]\"" nil t dquote))
- (incf dquote))
- (while (save-excursion (re-search-backward "[^\\]\(" nil t paren))
- (incf paren))
- (and (= (% dquote 2) 1) (= (% paren 2) 1))))))
-
-(autoload 'idna-to-ascii "idna")
-
(defun message-idna-to-ascii-rhs-1 (header)
"Interactively potentially IDNA encode domain names in HEADER."
- (let (rhs ace start startpos endpos ovl)
- (goto-char (point-min))
- (while (re-search-forward (concat "^" header) nil t)
- (while (re-search-forward "@\\([^ \t\r\n>,]+\\)"
- (or (save-excursion
- (re-search-forward "^[^ \t]" nil t))
- (point-max))
- t)
- (setq rhs (match-string-no-properties 1)
- startpos (match-beginning 1)
- endpos (match-end 1))
- (when (save-match-data
- (and (message-idna-inside-rhs-p)
- (setq ace (idna-to-ascii rhs))
- (not (string= rhs ace))
- (if (eq message-use-idna 'ask)
- (unwind-protect
- (progn
- (setq ovl (message-make-overlay startpos
- endpos))
- (message-overlay-put ovl 'face 'highlight)
- (y-or-n-p
- (format "Replace with `%s'? " ace)))
- (message "")
- (message-delete-overlay ovl))
- message-use-idna)))
- (replace-match (concat "@" ace)))))))
+ (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)))
+ (when (and (not (equal rhs ace))
+ (or (not (eq message-use-idna 'ask))
+ (y-or-n-p (format "Replace %s with %s? " rhs ace))))
+ (goto-char (point-min))
+ (while (re-search-forward (concat "^" header ":") nil t)
+ (message-narrow-to-field)
+ (while (search-forward (concat "@" rhs) nil t)
+ (replace-match (concat "@" ace) t t))
+ (goto-char (point-max))
+ (widen)))))))
(defun message-idna-to-ascii-rhs ()
"Possibly IDNA encode non-ASCII domain names in From:, To: and Cc: headers.
(if formatter
(funcall formatter header value)
(insert header-string ": " value))
+ (goto-char (message-fill-field))
;; We check whether the value was ended by a
- ;; newline. If now, we insert one.
+ ;; newline. If not, we insert one.
(unless (bolp)
(insert "\n"))
(forward-line -1)))
;; The value of this header was empty, so we clear
;; totally and insert the new value.
- (delete-region (point) (gnus-point-at-eol))
+ (delete-region (point) (point-at-eol))
;; If the header is optional, and the header was
;; empty, we can't insert it anyway.
(unless optionalp
(push header-string message-inserted-headers)
(insert value)
- (when (bolp)
- (delete-char -1))))
+ (message-fill-field)))
;; Add the deletable property to the headers that require it.
(and (memq header message-deletable-headers)
(progn (beginning-of-line) (looking-at "[^:]+: "))
;;; Setting up a message buffer
;;;
+(defun message-skip-to-next-address ()
+ (let ((end (save-excursion
+ (message-next-header)
+ (point)))
+ quoted char)
+ (when (looking-at ",")
+ (forward-char 1))
+ (while (and (not (= (point) end))
+ (or (not (eq char ?,))
+ quoted))
+ (skip-chars-forward "^,\"" (point-max))
+ (when (eq (setq char (following-char)) ?\")
+ (setq quoted (not quoted)))
+ (unless (= (point) end)
+ (forward-char 1)))
+ (skip-chars-forward " \t\n")))
+
(defun message-fill-address (header value)
- (save-restriction
- (narrow-to-region (point) (point))
- (insert (capitalize (symbol-name header))
- ": "
- (if (consp value) (car value) value)
- "\n")
- (narrow-to-region (point-min) (1- (point-max)))
- (let (quoted last)
- (goto-char (point-min))
- (while (not (eobp))
- (skip-chars-forward "^,\"" (point-max))
- (if (or (eq (char-after) ?,)
- (eobp))
- (when (not quoted)
- (if (and (> (current-column) 78)
- last)
- (save-excursion
- (goto-char last)
- (looking-at "[ \t]*")
- (replace-match "\n " t t)))
- (setq last (1+ (point))))
- (setq quoted (not quoted)))
- (unless (eobp)
- (forward-char 1))))
- (goto-char (point-max))
- (widen)
- (forward-line 1)))
+ (insert (capitalize (symbol-name header))
+ ": "
+ (if (consp value) (car value) value)
+ "\n")
+ (message-fill-field-address))
(defun message-fill-references (header value)
(insert (capitalize (symbol-name header))
(split-line message-yank-prefix) ;; Emacs 21.3.50+ supports arg.
(error
(split-line))))
-
-(defun message-fill-header (header value)
+
+(defun message-insert-header (header value)
+ (insert (capitalize (symbol-name header))
+ ": "
+ (if (consp value) (car value) value)))
+
+(defun message-field-name ()
+ (save-excursion
+ (goto-char (point-min))
+ (when (looking-at "\\([^:]+\\):")
+ (intern (capitalize (match-string 1))))))
+
+(defun message-fill-field ()
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-field)
+ (let ((field-name (message-field-name)))
+ (funcall (or (cadr (assq field-name message-field-fillers))
+ 'message-fill-field-general)))
+ (point-max))))
+
+(defun message-fill-field-address ()
+ (while (not (eobp))
+ (message-skip-to-next-address)
+ (let (last)
+ (if (and (> (current-column) 78)
+ last)
+ (progn
+ (save-excursion
+ (goto-char last)
+ (insert "\n\t"))
+ (setq last (1+ (point))))
+ (setq last (1+ (point)))))))
+
+(defun message-fill-field-general ()
(let ((begin (point))
(fill-column 78)
(fill-prefix " "))
- (insert (capitalize (symbol-name header))
- ": "
- (if (consp value) (car value) value)
- "\n")
- (save-restriction
- (narrow-to-region begin (point))
- (fill-region-as-paragraph begin (point))
- ;; Tapdance around looong Message-IDs.
- (forward-line -1)
- (when (looking-at "[ \t]*$")
- (message-delete-line))
- (goto-char begin)
- (re-search-forward ":" nil t)
- (when (looking-at "\n[ \t]+")
- (replace-match " " t t))
- (goto-char (point-max)))))
+ (while (and (search-forward "\n" nil t)
+ (not (eobp)))
+ (replace-match " " t t))
+ (fill-region-as-paragraph begin (point-max))
+ ;; Tapdance around looong Message-IDs.
+ (forward-line -1)
+ (when (looking-at "[ \t]*$")
+ (message-delete-line))
+ (goto-char begin)
+ (search-forward ":" nil t)
+ (when (looking-at "\n[ \t]+")
+ (replace-match " " t t))
+ (goto-char (point-max))))
(defun message-shorten-1 (list cut surplus)
"Cut SURPLUS elements out of LIST, beginning with CUTth one."
(defun message-shorten-references (header references)
"Trim REFERENCES to be 21 Message-ID long or less, and fold them.
-If folding is disallowed, also check that the REFERENCES are less
-than 988 characters long, and if they are not, trim them until they are."
+When sending via news, also check that the REFERENCES are less
+than 988 characters long, and if they are not, trim them until
+they are."
(let ((maxcount 21)
(count 0)
(cut 2)
(message-shorten-1 refs cut surplus)
(decf count surplus)))
- ;; If folding is disallowed, make sure the total length (including
- ;; the spaces between) will be less than MAXSIZE characters.
+ ;; When sending via news, make sure the total folded length will
+ ;; be less than 998 characters. This is to cater to broken INN
+ ;; 2.3 which counts the total number of characters in a header
+ ;; rather than the physical line length of each line, as it shuld.
;;
- ;; Only disallow folding for News messages. At this point the headers
- ;; have not been generated, thus we use message-this-is-news directly.
- (when (and message-this-is-news message-cater-to-broken-inn)
- (let ((maxsize 988)
- (totalsize (+ (apply #'+ (mapcar #'length refs))
- (1- count)))
- (surplus 0)
- (ptr (nthcdr (1- cut) refs)))
- ;; Decide how many elements to cut off...
- (while (> totalsize maxsize)
- (decf totalsize (1+ (length (car ptr))))
- (incf surplus)
- (setq ptr (cdr ptr)))
- ;; ...and do it.
- (when (> surplus 0)
- (message-shorten-1 refs cut surplus))))
-
+ ;; This hack should be removed when it's believed than INN 2.3 is
+ ;; no longer widely used.
+ ;;
+ ;; At this point the headers have not been generated, thus we use
+ ;; message-this-is-news directly.
+ (when message-this-is-news
+ (while (< 998
+ (with-temp-buffer
+ (message-insert-header
+ header (mapconcat #'identity refs " "))
+ (buffer-size)))
+ (message-shorten-1 refs cut 1)))
;; Finally, collect the references back into a string and insert
;; it into the buffer.
- (let ((refstring (mapconcat #'identity refs " ")))
- (if (and message-this-is-news message-cater-to-broken-inn)
- (insert (capitalize (symbol-name header)) ": "
- refstring "\n")
- (message-fill-header header refstring)))))
+ (message-insert-header header (mapconcat #'identity refs " "))))
(defun message-position-point ()
"Move point to where the user probably wants to find it."
(defcustom message-beginning-of-line t
"Whether \\<message-mode-map>\\[message-beginning-of-line]\
goes to beginning of header values."
+ :version "21.4"
:group 'message-buffers
:link '(custom-manual "(message)Movement")
:type 'boolean)
(message-point-in-header-p))
(let* ((here (point))
(bol (progn (beginning-of-line n) (point)))
- (eol (gnus-point-at-eol))
+ (eol (point-at-eol))
(eoh (re-search-forward ": *" eol t)))
(if (or (not eoh) (equal here eoh))
(goto-char bol)
(when message-default-headers
(insert message-default-headers)
(or (bolp) (insert ?\n)))
- (put-text-property
- (point)
- (progn
- (insert mail-header-separator "\n")
- (1- (point)))
- 'read-only nil)
+ (insert mail-header-separator "\n")
(forward-line -1)
(when (message-news-p)
(when message-default-news-headers
(defun message-forward-rmail-make-body (forward-buffer)
(save-window-excursion
(set-buffer forward-buffer)
- ;; 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))
(let ((end1 (make-marker)))
(move-marker end1 (max start end))
(goto-char (min start end))
- (while (re-search-forward "\b" end1 t)
+ (while (search-forward "\b" end1 t)
(if (eq (char-after) (char-after (- (point) 2)))
(delete-char -2))))))
-(defalias 'message-exchange-point-and-mark 'exchange-point-and-mark)
+(defun message-exchange-point-and-mark ()
+ "Exchange point and mark, but don't activate region if it was inactive."
+ (unless (prog1
+ (message-mark-active-p)
+ (exchange-point-and-mark))
+ (setq mark-active nil)))
+
(defalias 'message-make-overlay 'make-overlay)
(defalias 'message-delete-overlay 'delete-overlay)
(defalias 'message-overlay-put 'overlay-put)
:group 'message
:type '(alist :key-type regexp :value-type function))
+(defcustom message-expand-name-databases
+ (list 'bbdb 'eudc 'lsdb)
+ "List of databases to try for name completion (`message-expand-name').
+Each element is a symbol and can be `bbdb', `eudc' or `lsdb'."
+ :group 'message
+ :type '(set (const bbdb) (const eudc) (const lsdb)))
+
(defcustom message-expand-name-function
- (if (fboundp 'bbdb-complete-name)
- 'bbdb-complete-name
- (if (fboundp 'lsdb-complete-name)
- 'lsdb-complete-name
- 'expand-abbrev))
- "*A function called to expand addresses in field body."
+ (cond ((and (boundp 'eudc-protocol)
+ eudc-protocol)
+ 'eudc-expand-inline)
+ ((fboundp 'bbdb-complete-name)
+ 'bbdb-complete-name)
+ ((fboundp 'lsdb-complete-name)
+ 'lsdb-complete-name)
+ (t 'expand-abbrev))
+ "*A function called to expand addresses in field body.
+This variable is semi-obsolete, set it as nil and use
+`message-expand-name-databases' instead."
:group 'message
- :type 'function)
+ :type '(radio (const :format "Invalidate it: %v\n" nil)
+ (function-item :format "eudc: %v\n" eudc-expand-inline)
+ (function-item :format "bbdb: %v\n" bbdb-complete-name)
+ (function-item :format "lsdb: %v\n" lsdb-complete-name)
+ (function :size 0 :value expand-abbrev)))
(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."
+ :version "21.4"
:group 'message
:link '(custom-manual "(message)Various Commands")
:type 'function)
(delete-region (point) (progn (forward-line 3) (point))))))))))
(defun message-expand-name ()
- (funcall message-expand-name-function))
+ (cond (message-expand-name-function
+ (funcall message-expand-name-function))
+ ((and (memq 'eudc message-expand-name-databases)
+ (boundp 'eudc-protocol)
+ eudc-protocol)
+ (eudc-expand-inline))
+ ((and (memq 'bbdb message-expand-name-databases)
+ (fboundp 'bbdb-complete-name))
+ (bbdb-complete-name))
+ ((and (memq 'lsdb message-expand-name-databases)
+ (fboundp 'lsdb-complete-name))
+ (lsdb-complete-name))
+ (t 'expand-abbrev)))
;;; Help stuff.
(let ((locals (save-excursion
(set-buffer buffer)
(buffer-local-variables)))
- (regexp
- "^\\(gnus\\|nn\\|message\\|user-\\(mail-address\\|full-name\\)\\)"))
+ (regexp "^gnus\\|^nn\\|^message\\|^sendmail\\|^smtp\\|^user-mail-address\\|^user-full-name"))
(mapcar
(lambda (local)
(when (and (consp local)