;;; message.el --- composing mail and news messages
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
(eval-and-compile
(autoload 'sha1 "sha1-el")
(autoload 'gnus-find-method-for-group "gnus")
- (autoload 'nnvirtual-find-group-art "nnvirtual"))
+ (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))
`message-required-mail-headers'."
:group 'message-news
:group 'message-headers
+ :link '(custom-manual "(message)Message Headers")
:type '(repeat sexp))
(defcustom message-draft-headers '(References From)
"*Headers to be generated when saving a draft message."
:group 'message-news
:group 'message-headers
+ :link '(custom-manual "(message)Message Headers")
:type '(repeat sexp))
(defcustom message-required-news-headers
header, remove it from this list."
:group 'message-news
:group 'message-headers
+ :link '(custom-manual "(message)Message Headers")
:type '(repeat sexp))
(defcustom message-required-mail-headers
included. Organization and User-Agent are optional."
:group 'message-mail
:group 'message-headers
+ :link '(custom-manual "(message)Message Headers")
:type '(repeat sexp))
(defcustom message-deletable-headers '(Message-ID Date Lines)
"Headers to be deleted if they already exist and were generated by message previously."
:group 'message-headers
+ :link '(custom-manual "(message)Message Headers")
:type 'sexp)
(defcustom message-ignored-news-headers
"*Regexp of headers to be removed unconditionally before posting."
:group 'message-news
:group 'message-headers
+ :link '(custom-manual "(message)Message Headers")
:type 'regexp)
(defcustom message-ignored-mail-headers
"*Regexp of headers to be removed unconditionally before mailing."
:group 'message-mail
:group '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:"
It's best to delete old Path and Date headers before posting to avoid
any confusion."
:group 'message-interface
+ :link '(custom-manual "(message)Superseding")
:type 'regexp)
(defcustom message-subject-re-regexp
"^[ \t]*\\([Rr][Ee]\\(\\[[0-9]*\\]\\)*:[ \t]*\\)*[ \t]*"
"*Regexp matching \"Re: \" in the subject line."
:group 'message-various
+ :link '(custom-manual "(message)Message Headers")
:type 'regexp)
;;; Start of variables adopted from `message-utils.el'.
(defcustom message-subject-trailing-was-query 'ask
- ;; should it default to nil or ask?
"*What to do with trailing \"(was: <old subject>)\" in subject lines.
If nil, leave the subject unchanged. If it is the symbol `ask', query
the user what do do. In this case, the subject is matched against
:type '(choice (const :tag "never" nil)
(const :tag "always strip" t)
(const ask))
+ :link '(custom-manual "(message)Message Headers")
:group 'message-various)
(defcustom message-subject-trailing-was-ask-regexp
It is okay to create some false positives here, as the user is asked."
:group 'message-various
+ :link '(custom-manual "(message)Message Headers")
:type 'regexp)
(defcustom message-subject-trailing-was-regexp
`message-strip-subject-trailing-was'. You should use a regexp creating very
few false positives here."
:group 'message-various
+ :link '(custom-manual "(message)Message Headers")
:type 'regexp)
;; Fixme: Why are all these things autoloaded?
"--8<---------------cut here---------------start------------->8---\n"
"How to mark the beginning of some inserted text."
:type 'string
+ :link '(custom-manual "(message)Insertion Variables")
:group 'message-various)
;;;###autoload
"--8<---------------cut here---------------end--------------->8---\n"
"How to mark the end of some inserted text."
:type 'string
+ :link '(custom-manual "(message)Insertion Variables")
:group 'message-various)
;;;###autoload
"Header to insert when you don't want your article to be archived.
Archives \(such as groups.google.com\) respect this header."
:type 'string
+ :link '(custom-manual "(message)Header Commands")
:group 'message-various)
;;;###autoload
If nil, don't insert any text in the body."
:type '(radio (string :format "%t: %v\n" :size 0)
(const nil))
+ :link '(custom-manual "(message)Header Commands")
:group 'message-various)
;;; Crossposts and Followups
(defcustom message-signature-separator "^-- *$"
"Regexp matching the signature separator."
:type 'regexp
+ :link '(custom-manual "(message)Various Message Variables")
:group 'message-various)
(defcustom message-elide-ellipsis "\n[...]\n\n"
"*The string which is inserted for elided text."
:type 'string
+ :link '(custom-manual "(message)Various Commands")
:group 'message-various)
(defcustom message-interactive t
nil means let mailer mail back a message to report errors."
:group 'message-sending
:group 'message-mail
+ :link '(custom-manual "(message)Sending Variables")
:type 'boolean)
(defcustom message-generate-new-buffers 'unique
the to address and the group name. (Any of these may be nil.) The function
should return the new buffer name."
:group 'message-buffers
+ :link '(custom-manual "(message)Message Buffers")
:type '(choice (const :tag "off" nil)
(const :tag "unique" unique)
(const :tag "unsent" unsent)
(defcustom message-kill-buffer-on-exit nil
"*Non-nil means that the message buffer will be killed after sending a message."
:group 'message-buffers
+ :link '(custom-manual "(message)Message Buffers")
:type 'boolean)
(eval-when-compile
(defcustom message-user-organization-file "/usr/lib/news/organization"
"*Local news organization file."
:type 'file
+ :link '(custom-manual "(message)News Headers")
:group 'message-headers)
(defcustom message-make-forward-subject-function
* `message-forward-subject-fwd' Subject of article with 'Fwd:' prepended
to it."
:group 'message-forwarding
+ :link '(custom-manual "(message)Forwarding")
:type '(radio (function-item message-forward-subject-author-subject)
(function-item message-forward-subject-fwd)
(function-item message-forward-subject-name-subject)
Otherwise, directly inline the old message in the forwarded message."
:version "21.1"
:group 'message-forwarding
+ :link '(custom-manual "(message)Forwarding")
:type 'boolean)
(defcustom message-forward-show-mml 'best
"*Non-nil means try to remove as much cruft as possible from the subject.
Done before generating the new subject of a forward."
:group 'message-forwarding
+ :link '(custom-manual "(message)Forwarding")
:type 'boolean)
(defcustom message-ignored-resent-headers "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:\\|^>?From "
"*All headers that match this regexp will be deleted when resending a message."
:group 'message-interface
+ :link '(custom-manual "(message)Resending")
:type 'regexp)
(defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus"
(defcustom message-ignored-cited-headers "."
"*Delete these headers from the messages you yank."
:group 'message-insertion
+ :link '(custom-manual "(message)Insertion Variables")
:type 'regexp)
(defcustom message-cite-prefix-regexp
"]\\)+>+\\|[ \t]*[]>|}+]\\)+"))))
"*Regexp matching the longest possible citation prefix on a line."
:group 'message-insertion
+ :link '(custom-manual "(message)Insertion Variables")
:type 'regexp)
(defcustom message-cancel-message "I am canceling my own article.\n"
"Message to be inserted in the cancel message."
:group 'message-interface
+ :link '(custom-manual "(message)Canceling News")
:type 'string)
;; Useful to set in site-init.el
(function-item feedmail-send-it)
(function :tag "Other"))
:group 'message-sending
+ :link '(custom-manual "(message)Mail Variables")
:group 'message-mail)
(defcustom message-send-news-function 'message-send-news
variable `mail-header-separator'."
:group 'message-sending
:group 'message-news
+ :link '(custom-manual "(message)News Variables")
:type 'function)
(defcustom message-reply-to-function nil
This function should pick out addresses from the To, Cc, and From headers
and respond with new To and Cc headers."
:group 'message-interface
+ :link '(custom-manual "(message)Reply")
:type '(choice function (const nil)))
(defcustom message-wide-reply-to-function nil
This function should pick out addresses from the To, Cc, and From headers
and respond with new To and Cc headers."
:group 'message-interface
+ :link '(custom-manual "(message)Wide Reply")
:type '(choice function (const nil)))
(defcustom message-followup-to-function nil
This function should pick out addresses from the To, Cc, and From headers
and respond with new To and Cc headers."
:group 'message-interface
+ :link '(custom-manual "(message)Followup")
:type '(choice function (const nil)))
(defcustom message-use-followup-to 'ask
always query the user whether to use the value. If it is the symbol
`use', always use the value."
:group 'message-interface
+ :link '(custom-manual "(message)Followup")
:type '(choice (const :tag "ignore" nil)
(const :tag "use & query" t)
(const use)
query the user whether to use the value. If it is the symbol `use',
always use the value."
:group 'message-interface
+ :link '(custom-manual "(message)Mailing Lists")
:type '(choice (const :tag "ignore" nil)
(const use)
(const ask)))
conjunction with `message-subscribed-regexps' and
`message-subscribed-addresses'."
:group 'message-interface
+ :link '(custom-manual "(message)Mailing Lists")
:type '(repeat sexp))
(defcustom message-subscribed-address-file nil
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
+ :link '(custom-manual "(message)Mailing Lists")
:type '(radio (file :format "%t: %v\n" :size 0)
(const nil)))
addresses can be used in conjunction with
`message-subscribed-address-functions' and `message-subscribed-regexps'."
:group 'message-interface
+ :link '(custom-manual "(message)Mailing Lists")
:type '(repeat string))
(defcustom message-subscribed-regexps nil
regular expressions can be used in conjunction with
`message-subscribed-address-functions' and `message-subscribed-addresses'."
:group 'message-interface
+ :link '(custom-manual "(message)Mailing Lists")
:type '(repeat regexp))
(defcustom message-allow-no-recipients 'ask
symbol `never', the posting is not allowed. If it is the symbol
`ask', you are prompted."
:group 'message-interface
+ :link '(custom-manual "(message)Message Headers")
:type '(choice (const always)
(const never)
(const ask)))
"*Non-nil means don't add \"-f username\" to the sendmail command line.
Doing so would be even more evil than leaving it out."
:group 'message-sending
+ :link '(custom-manual "(message)Mail Variables")
:type 'boolean)
(defcustom message-sendmail-envelope-from nil
:type '(choice (string :tag "From name")
(const :tag "Use From: header from message" header)
(const :tag "Use `user-mail-address'" nil))
+ :link '(custom-manual "(message)Mail Variables")
:group 'message-sending)
;; qmail-related stuff
(defcustom message-qmail-inject-program "/var/qmail/bin/qmail-inject"
"Location of the qmail-inject program."
:group 'message-sending
+ :link '(custom-manual "(message)Mail Variables")
:type 'file)
(defcustom message-qmail-inject-args nil
go to the right place or to deal with listserv's usage of that address, you
might set this variable to '(\"-f\" \"you@some.where\")."
:group 'message-sending
+ :link '(custom-manual "(message)Mail Variables")
:type '(choice (function)
(repeat string)))
;; will *not* have a `References:' header if `message-generate-headers-first'
;; is nil. See: http://article.gmane.org/gmane.emacs.gnus.general/51138
(defcustom message-generate-headers-first '(references)
- "*If non-nil, generate all required headers before composing.
-The variables `message-required-news-headers' and
+ "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
+generate. The variables `message-required-news-headers' and
`message-required-mail-headers' specify which headers to generate.
-This can also be a list of headers that should be generated before
-composing.
Note that the variable `message-deletable-headers' specifies headers which
are to be deleted and then re-generated before sending, so this variable
will not have a visible effect for those headers."
:group 'message-headers
+ :link '(custom-manual "(message)Message Headers")
:type '(choice (const :tag "None" nil)
(const :tag "References" '(references))
(const :tag "All" t)
"Normal hook, run each time a new outgoing message is initialized.
The function `message-setup' runs this hook."
:group 'message-various
+ :link '(custom-manual "(message)Various Message Variables")
:type 'hook)
(defcustom message-cancel-hook nil
"Hook run when cancelling articles."
:group 'message-various
+ :link '(custom-manual "(message)Various Message Variables")
:type 'hook)
(defcustom message-signature-setup-hook nil
It is run after the headers have been inserted and before
the signature is inserted."
:group 'message-various
+ :link '(custom-manual "(message)Various Message Variables")
:type 'hook)
(defcustom message-mode-hook nil
(defcustom message-header-setup-hook nil
"Hook called narrowed to the headers when setting up a message buffer."
:group 'message-various
+ :link '(custom-manual "(message)Various Message Variables")
:type 'hook)
(defcustom message-minibuffer-local-map
people who read your message will have to change their Gnus
configuration. See the variable `gnus-cite-attribution-suffix'."
:type 'function
+ :link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
;;;###autoload
Fix `message-cite-prefix-regexp' if it is set to an abnormal value.
See also `message-yank-cited-prefix'."
:type 'string
+ :link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
(defcustom message-yank-cited-prefix ">"
Fix `message-cite-prefix-regexp' if it is set to an abnormal value.
See also `message-yank-prefix'."
:type 'string
+ :link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
(defcustom message-indentation-spaces 3
"*Number of spaces to insert at the beginning of each cited line.
Used by `message-yank-original' via `message-yank-cite'."
:group 'message-insertion
+ :link '(custom-manual "(message)Insertion Variables")
:type 'integer)
;;;###autoload
(function-item message-cite-original-without-signature)
(function-item sc-cite-original)
(function :tag "Other"))
+ :link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
;;;###autoload
citation between (point) and (mark t). And each function should leave
point and mark around the citation text as modified."
:type 'function
+ :link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
;;;###autoload
If a function, the result from the function will be used instead.
If a form, the result from the form will be used instead."
:type 'sexp
+ :link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
;;;###autoload
Ignored if the named file doesn't exist.
If nil, don't insert a signature."
:type '(choice file (const :tags "None" nil))
+ :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."
:type 'boolean
+ :link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
(defcustom message-distribution-function nil
"*Function called to return a Distribution header."
:group 'message-news
:group 'message-headers
+ :link '(custom-manual "(message)News Headers")
:type '(choice function (const nil)))
(defcustom message-expires 14
It is inserted before you edit the message, so you can edit or delete
these lines."
:group 'message-headers
+ :link '(custom-manual "(message)Message Headers")
:type 'message-header-lines)
(defcustom message-default-mail-headers ""
"*A string of header lines to be inserted in outgoing mails."
:group 'message-headers
:group 'message-mail
+ :link '(custom-manual "(message)Mail Headers")
:type 'message-header-lines)
(defcustom message-default-news-headers ""
"*A string of header lines to be inserted in outgoing news articles."
:group 'message-headers
:group 'message-news
+ :link '(custom-manual "(message)News Headers")
:type 'message-header-lines)
;; Note: could use /usr/ucb/mail instead of sendmail;
The value should be an expression to test whether the problem will
actually occur."
:group 'message-sending
+ :link '(custom-manual "(message)Mail Variables")
:type 'sexp)
;;;###autoload
"*Directory where Message auto-saves buffers if Gnus isn't running.
If nil, Message won't auto-save."
:group 'message-buffers
+ :link '(custom-manual "(message)Various Message Variables")
:type '(choice directory (const :tag "Don't auto-save" nil)))
(defcustom message-default-charset
If nil, you might be asked to input the charset."
:version "21.1"
:group 'message
+ :link '(custom-manual "(message)Various Message Variables")
:type 'symbol)
(defcustom message-dont-reply-to-names
A value of nil means exclude your own user name only."
:version "21.1"
:group 'message
+ :link '(custom-manual "(message)Wide Reply")
:type '(choice (const :tag "Yourself" nil)
regexp))
(defcustom message-hidden-headers nil
"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.."
+starting with `not' and followed by regexps."
:group 'message
+ :link '(custom-manual "(message)Message Headers")
:type '(repeat regexp))
;;; Internal variables.
This hook is run quite early when sending."
:group 'message-various
:options '(ispell-message)
+ :link '(custom-manual "(message)Various Message Variables")
:type 'hook)
(defcustom message-send-mail-hook nil
This hook is run very late -- just before the message is sent as
mail."
:group 'message-various
+ :link '(custom-manual "(message)Various Message Variables")
:type 'hook)
(defcustom message-send-news-hook nil
This hook is run very late -- just before the message is sent as
news."
:group 'message-various
+ :link '(custom-manual "(message)Various Message Variables")
:type 'hook)
(defcustom message-sent-hook nil
should be sent in several parts. If it is nil, the size is unlimited."
:version "21.1"
:group 'message-buffers
+ :link '(custom-manual "(message)Mail Variables")
:type '(choice (const :tag "unlimited" nil)
(integer 1000000)))
"A regexp to match the alternative email addresses.
The first matched address (not primary one) is used in the From field."
:group 'message-headers
+ :link '(custom-manual "(message)Message Headers")
:type '(choice (const :tag "Always use primary" nil)
regexp))
no, only reply back to the author."
:version "21.3"
:group 'message-headers
+ :link '(custom-manual "(message)Wide Reply")
:type 'boolean)
(defcustom message-user-fqdn nil
'ask)
"Whether to encode non-ASCII in domain names into ASCII according to IDNA."
:group 'message-headers
+ :link '(custom-manual "(message)IDNA")
:type '(choice (const :tag "Ask" ask)
(const :tag "Never" nil)
(const :tag "Always" t)))
(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 'gnus-groups-from-server "gnus")
(autoload 'rmail-output "rmailout")
(autoload 'gnus-delay-article "gnus-delay")
- (autoload 'gnus-make-local-hook "gnus-util"))
+ (autoload 'gnus-make-local-hook "gnus-util")
+ (autoload 'gnus-extract-address-components "gnus-util"))
\f
(set-text-properties 0 (length value) nil value)
value)))
+(defun message-field-value (header &optional not-all)
+ "The same as `message-fetch-field', only narrow to the headers first."
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers-or-head)
+ (message-fetch-field header not-all))))
+
(defun message-narrow-to-field ()
"Narrow the buffer to the header on the current line."
(beginning-of-line)
;;;###autoload
(defun message-change-subject (new-subject)
"Ask for NEW-SUBJECT header, append (was: <Old Subject>)."
+ ;; <URL:http://www.landfield.com/usefor/drafts/draft-ietf-usefor-useage--1.02.unpaged>
(interactive
(list
(read-from-minibuffer "New subject: ")))
See `message-mark-insert-begin' and `message-mark-insert-end'."
(interactive "r")
(save-excursion
- ; add to the end of the region first, otherwise end would be invalid
+ ;; add to the end of the region first, otherwise end would be invalid
(goto-char end)
(insert message-mark-insert-end)
(goto-char beg)
(easy-menu-define
message-mode-field-menu message-mode-map ""
`("Field"
- ["Fetch To" message-insert-to t]
- ["Fetch Newsgroups" message-insert-newsgroups t]
- "----"
["To" message-goto-to t]
["From" message-goto-from t]
["Subject" message-goto-subject t]
["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]
["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]
+ ["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]
If you use one of these packages, turn this option off, and hope the
message composition doesn't break too bad."
:group 'message-various
+ :link '(custom-manual "(message)Various Message Variables")
:type 'boolean)
(defconst message-forbidden-properties
(defun message-insert-to (&optional force)
"Insert a To header that points to the author of the article being replied to.
-If the original author requested not to be sent mail, the function signals
-an error.
-With the prefix argument FORCE, insert the header anyway."
+If the original author requested not to be sent mail, don't insert unless the
+prefix FORCE is given."
(interactive "P")
- (let ((co (message-fetch-reply-field "mail-copies-to")))
- (when (and (null force)
- co
- (or (equal (downcase co) "never")
- (equal (downcase co) "nobody")))
- (error "The user has requested not to have copies sent via mail")))
- (message-carefully-insert-headers
- (list (cons 'To
- (or (message-fetch-reply-field "mail-reply-to")
- (message-fetch-reply-field "reply-to")
- (message-fetch-reply-field "from")
- "")))))
+ (let* ((mct (message-fetch-reply-field "mail-copies-to"))
+ (dont (and mct (or (equal (downcase mct) "never")
+ (equal (downcase mct) "nobody"))))
+ (to (or (message-fetch-reply-field "mail-reply-to")
+ (message-fetch-reply-field "reply-to")
+ (message-fetch-reply-field "from"))))
+ (when (and dont to)
+ (message
+ (if force
+ "Ignoring the user request not to have copies sent via mail"
+ "Complying with the user request not to have copies sent via mail")))
+ (when (and force (not to))
+ (error "No mail address in the article"))
+ (when (and to (or force (not dont)))
+ (message-carefully-insert-headers (list (cons 'To to))))))
(defun message-insert-wide-reply ()
"Insert To and Cc headers as if you were doing a wide reply."
(message-get-reply-headers t))))
(message-carefully-insert-headers headers)))
+(defcustom message-header-synonyms
+ '((To Cc Bcc))
+ "List of lists of header synonyms.
+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."
+ :group 'message-headers
+ :link '(custom-manual "(message)Message Headers")
+ :type '(repeat sexp))
+
(defun message-carefully-insert-headers (headers)
+ "Insert the HEADERS, an alist, into the message buffer.
+Does not insert the headers when they are already present there
+or in the synonym headers, defined by `message-header-synonyms'."
+ ;; FIXME: Should compare only the address and not the full name. Comparison
+ ;; should be done case-folded (and with `string=' rather than
+ ;; `string-match').
(dolist (header headers)
- (let ((header-name (symbol-name (car header))))
- (when (and (message-position-on-field header-name)
- (mail-fetch-field header-name)
- (not (string-match "\\` *\\'"
- (mail-fetch-field header-name))))
- (insert ", "))
- (insert (cdr header)))))
+ (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))
+ (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)))
+ (if old-header
+ (message "already have `%s' in `%s'" new-header old-header)
+ (when (and (message-position-on-field header-name)
+ (setq old-header (mail-fetch-field header-name))
+ (not (string-match "\\` *\\'" old-header)))
+ (insert ", "))
+ (insert new-header)))))
(defun message-widen-reply ()
"Widen the reply to include maximum recipients."
(message-remove-header "Disposition-Notification-To"))
(message-goto-eoh)
(insert (format "Disposition-Notification-To: %s\n"
- (or (save-excursion
- (save-restriction
- (message-narrow-to-headers)
- (message-fetch-field "From")))
+ (or (message-field-value "Reply-to")
+ (message-field-value "From")
(message-make-from))))))
(defun message-elide-region (b e)
(defun message-yank-buffer (buffer)
"Insert BUFFER into the current buffer and quote it."
(interactive "bYank buffer: ")
- (let ((message-reply-buffer buffer))
+ (let ((message-reply-buffer (get-buffer buffer)))
(save-window-excursion
(message-yank-original))))
(defun message-cite-original-without-signature ()
"Cite function in the standard Message manner."
- (let ((start (point))
- (end (mark t))
- (functions
- (when message-indent-citation-function
- (if (listp message-indent-citation-function)
- message-indent-citation-function
- (list message-indent-citation-function)))))
+ (let* ((start (point))
+ (end (mark t))
+ (functions
+ (when message-indent-citation-function
+ (if (listp message-indent-citation-function)
+ message-indent-citation-function
+ (list message-indent-citation-function))))
+ ;; This function may be called by `gnus-summary-yank-message' and
+ ;; may insert a different article from the original. So, we will
+ ;; modify the value of `message-reply-headers' with that article.
+ (message-reply-headers
+ (save-restriction
+ (narrow-to-region start end)
+ (message-narrow-to-head-1)
+ (vector 0
+ (or (message-fetch-field "subject") "none")
+ (message-fetch-field "from")
+ (message-fetch-field "date")
+ (message-fetch-field "message-id" t)
+ (message-fetch-field "references")
+ 0 0 ""))))
(mml-quote-region start end)
;; Allow undoing.
(undo-boundary)
(if (and (boundp 'mail-citation-hook)
mail-citation-hook)
(run-hooks 'mail-citation-hook)
- (let ((start (point))
- (end (mark t))
- (functions
- (when message-indent-citation-function
- (if (listp message-indent-citation-function)
- message-indent-citation-function
- (list message-indent-citation-function)))))
+ (let* ((start (point))
+ (end (mark t))
+ (functions
+ (when message-indent-citation-function
+ (if (listp message-indent-citation-function)
+ message-indent-citation-function
+ (list message-indent-citation-function))))
+ ;; This function may be called by `gnus-summary-yank-message' and
+ ;; may insert a different article from the original. So, we will
+ ;; modify the value of `message-reply-headers' with that article.
+ (message-reply-headers
+ (save-restriction
+ (narrow-to-region start end)
+ (message-narrow-to-head-1)
+ (vector 0
+ (or (message-fetch-field "subject") "none")
+ (message-fetch-field "from")
+ (message-fetch-field "date")
+ (message-fetch-field "message-id" t)
+ (message-fetch-field "references")
+ 0 0 ""))))
(mml-quote-region start end)
(goto-char start)
(while functions
(when (let ((char (char-after)))
(or (< (mm-char-int char) 128)
(and (mm-multibyte-p)
- (> (length (mm-find-mime-charset-region
- (point) (point-max)))
- 1))))
+ (memq (char-charset char)
+ '(eight-bit-control eight-bit-graphic
+ control-1))
+ (not (get-text-property
+ (point) 'untranslated-utf-8)))))
(message-overlay-put (message-make-overlay (point) (1+ (point)))
'face 'highlight)
(setq found t))
;; use find-coding-systems-region.
(memq (char-charset char)
'(eight-bit-control eight-bit-graphic
- control-1)))))
+ control-1))
+ (not (get-text-property
+ (point) 'untranslated-utf-8)))))
(if (eq choice ?i)
(message-kill-all-overlays)
(delete-char 1)
(user-domain
(if (and user-mail
(string-match "@\\(.*\\)\\'" user-mail))
- (match-string 1 user-mail))))
+ (match-string 1 user-mail)))
+ (case-fold-search t))
(cond
((and message-user-fqdn
(stringp message-user-fqdn)
(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 con't insert it anyway.
(unless optionalp
(error
(split-line))))
-
(defun message-fill-header (header value)
(let ((begin (point))
(fill-column 78)
"Whether \\<message-mode-map>\\[message-beginning-of-line]\
goes to beginning of header values."
:group 'message-buffers
+ :link '(custom-manual "(message)Movement")
:type 'boolean)
(defun message-beginning-of-line (&optional n)
(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)
(defun message-get-reply-headers (wide &optional to-address address-headers)
(let (follow-to mct never-mct to cc author mft recipients)
;; Find all relevant headers we need.
- (setq to (message-fetch-field "to")
- cc (message-fetch-field "cc")
- mct (message-fetch-field "mail-copies-to")
- author (or (message-fetch-field "mail-reply-to")
- (message-fetch-field "reply-to")
- (message-fetch-field "from")
- "")
- mft (and message-use-mail-followup-to
- (message-fetch-field "mail-followup-to")))
+ (save-restriction
+ (message-narrow-to-headers-or-head)
+ ;; 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)
+ (message-fetch-field "original-to")))
+ cc (message-fetch-field "cc")
+ mct (message-fetch-field "mail-copies-to")
+ author (or (message-fetch-field "mail-reply-to")
+ (message-fetch-field "reply-to")
+ (message-fetch-field "from")
+ "")
+ mft (and message-use-mail-followup-to
+ (message-fetch-field "mail-followup-to"))))
;; Handle special values of Mail-Copies-To.
(when mct
(defvar message-forward-decoded-p nil
"Non-nil means the original message is decoded.")
-(defun message-forward-subject-author-subject (subject)
+(defun message-forward-subject-name-subject (subject)
"Generate a SUBJECT for a forwarded message.
The form is: [Source] Subject, where if the original message was mail,
-Source is the sender, and if the original message was news, Source is
-the list of newsgroups is was posted to."
- (concat "["
- (let ((prefix
- (or (message-fetch-field "newsgroups")
- (message-fetch-field "from")
- "(nowhere)")))
+Source is the name of the sender, and if the original message was
+news, Source is the list of newsgroups is was posted to."
+ (let* ((group (message-fetch-field "newsgroups"))
+ (from (message-fetch-field "from"))
+ (prefix
+ (if group
+ (gnus-group-decoded-name group)
+ (or (and from (car (gnus-extract-address-components from)))
+ "(nowhere)"))))
+ (concat "["
(if message-forward-decoded-p
prefix
- (mail-decode-encoded-word-string prefix)))
- "] " subject))
+ (mail-decode-encoded-word-string prefix))
+ "] " subject)))
-(defun message-forward-subject-name-subject (subject)
+(defun message-forward-subject-author-subject (subject)
"Generate a SUBJECT for a forwarded message.
The form is: [Source] Subject, where if the original message was mail,
-Source is the name of the sender, and if the original message was
-news, Source is the list of newsgroups is was posted to."
- (concat "["
- (let ((prefix
- (or (message-fetch-field "newsgroups")
- (let ((from (message-fetch-field "from")))
- (and from
- (cdr (mail-header-parse-address from))))
- "(nowhere)")))
+Source is the sender, and if the original message was news, Source is
+the list of newsgroups is was posted to."
+ (let* ((group (message-fetch-field "newsgroups"))
+ (prefix
+ (if group
+ (gnus-group-decoded-name group)
+ (or (message-fetch-field "from")
+ "(nowhere)"))))
+ (concat "["
(if message-forward-decoded-p
prefix
- (mail-decode-encoded-word-string prefix)))
- "] " subject))
+ (mail-decode-encoded-word-string prefix))
+ "] " subject)))
(defun message-forward-subject-fwd (subject)
"Generate a SUBJECT for a forwarded message.
The form is: Fwd: Subject, where Subject is the original subject of
the message."
- (concat "Fwd: " subject))
+ (if (string-match "^Fwd: " subject)
+ subject
+ (concat "Fwd: " subject)))
(defun message-make-forward-subject ()
"Return a Subject header suitable for the message in the current buffer."
(insert
"\n-------------------- Start of forwarded message --------------------\n")
(let ((b (point)) e)
- (save-restriction
- (narrow-to-region (point) (point))
- (mml-insert-buffer forward-buffer)
- (goto-char (point-min))
- (when (looking-at "From ")
- (replace-match "X-From-Line: "))
- (goto-char (point-max)))
+ (insert
+ (with-temp-buffer
+ (mm-disable-multibyte)
+ (insert
+ (with-current-buffer forward-buffer
+ (mm-with-unibyte-current-buffer (buffer-string))))
+ (mm-enable-multibyte)
+ (mime-to-mml)
+ (goto-char (point-min))
+ (when (looking-at "From ")
+ (replace-match "X-From-Line: "))
+ (buffer-string)))
(setq e (point))
(insert
- "\n-------------------- End of forwarded message --------------------\n")))
+ "\n-------------------- End of forwarded message --------------------\n")
+ (when (and (not current-prefix-arg)
+ message-forward-ignored-headers)
+ (save-restriction
+ (narrow-to-region b e)
+ (goto-char b)
+ (narrow-to-region (point)
+ (or (search-forward "\n\n" nil t) (point)))
+ (message-remove-header message-forward-ignored-headers t)))))
(defun message-forward-make-body-mime (forward-buffer)
(insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n")
"Content-Type: *multipart/\\(signed\\|encrypted\\)"
nil t)))))
(message-forward-make-body-mml forward-buffer)
- (message-forward-make-body-mime forward-buffer)))
- (message-forward-make-body-plain forward-buffer))
+ (message-forward-make-body-mime forward-buffer))
+ (message-forward-make-body-plain forward-buffer)))
(message-position-point))
;;;###autoload
(mm-insert-part handles)
(undo-boundary)
(goto-char (point-min))
- (search-forward "\n\n" nil t)
- (if (or (and (re-search-forward message-unsent-separator nil t)
- (forward-line 1))
- (re-search-forward "^Return-Path:.*\n" nil t))
- ;; We remove everything before the bounced mail.
- (delete-region
- (point-min)
- (if (re-search-forward "^[^ \n\t]+:" nil t)
- (match-beginning 0)
- (point)))
+ (re-search-forward "\n\n+" nil t)
+ (setq boundary (point))
+ ;; We remove everything before the bounced mail.
+ (if (or (re-search-forward message-unsent-separator nil t)
+ (progn
+ (search-forward "\n\n" nil 'move)
+ (re-search-backward "^Return-Path:.*\n" boundary t)))
+ (progn
+ (forward-line 1)
+ (delete-region (point-min)
+ (if (re-search-forward "^[^ \n\t]+:" nil t)
+ (match-beginning 0)
+ (point))))
+ (goto-char boundary)
(when (re-search-backward "^.?From .*\n" nil t)
(delete-region (match-beginning 0) (match-end 0)))))
(mm-enable-multibyte)
"*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
+ :link '(custom-manual "(message)Various Commands")
:type 'function)
(defun message-tab ()
projects / gnus / blobdiff