Sven Willner writes: > Before 'message-kill-buffer' would ask to delete backup file if > draft has been > saved regardless if a backup file has actually been created. Now > only ask if > a backup file exists. > > Copyright-paperwork-exempt: yes > --- > etc/NEWS | 5 +- > lisp/gnus/message.el | 6174 > +++++++++++++++++++++--------------------- > 2 files changed, 3091 insertions(+), 3088 deletions(-) > > diff --git a/etc/NEWS b/etc/NEWS > index f30ab69823..ca4efcb9b2 100644 > --- a/etc/NEWS > +++ b/etc/NEWS > @@ -562,6 +562,9 @@ GnuTLS manual) is recommended instead. > > ** Message > > +--- > +*** 'message-kill-buffer' asks to delete backup file only if > one actually exists > + > +++ > *** Messages can now be systematically encrypted > when the PGP keyring contains a public key for every recipient. > To > @@ -947,5 +950,5 @@ along with GNU Emacs. If not, see > . > Local variables: > coding: utf-8 > mode: outline > -paragraph-separate: "[ ]*$" > +paragraph-separate: "[ ]*$" > end: > diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el > index dde9c28656..aff92aed27 100644 > --- a/lisp/gnus/message.el > +++ b/lisp/gnus/message.el > @@ -57,7 +57,7 @@ > (defvar rmail-enable-mime-composing) > > (defgroup message '((user-mail-address custom-variable) > - (user-full-name custom-variable)) > + (user-full-name custom-variable)) > "Mail and news message composing." > :link '(custom-manual "(message)Top") > :group 'mail > @@ -132,7 +132,7 @@ This function will be called with the name > of the file to store the > article in. The default function is `message-output' which > saves in Unix > mailbox format." > :type '(radio (function-item message-output) > - (function :tag "Other")) > + (function :tag "Other")) > :group 'message-sending) > > (defcustom message-fcc-externalize-attachments nil > @@ -160,19 +160,19 @@ If this variable is nil, no such courtesy > message will be added." > "Specifies how \"From\" headers look. > > If nil, they contain just the return address like: > - king@grassland.com > + king@grassland.com > If `parens', they look like: > - king@grassland.com (Elvis Parsley) > + king@grassland.com (Elvis Parsley) > If `angles', they look like: > - Elvis Parsley > + Elvis Parsley > > Otherwise, most addresses look like `angles', but they look > like > `parens' if `angles' would need quoting and `parens' would > not." > :version "27.1" > :type '(choice (const :tag "simple" nil) > - (const parens) > - (const angles) > - (const default)) > + (const parens) > + (const angles) > + (const default)) > :group 'message-headers) > (make-obsolete-variable > 'message-from-style > @@ -205,7 +205,7 @@ and `valid-newsgroups'." > :type '(repeat sexp)) ; Fixme: improve this > > (defcustom message-required-headers '((optional . References) > - From) > + From) > "Headers to be generated or prompted for when sending a > message. > Also see `message-required-news-headers' and > `message-required-mail-headers'." > @@ -225,8 +225,8 @@ Also see `message-required-news-headers' and > > (defcustom message-required-news-headers > '(From Newsgroups Subject Date Message-ID > - (optional . Organization) > - (optional . User-Agent)) > + (optional . Organization) > + (optional . User-Agent)) > "Headers to be generated or prompted for when posting an > article. > RFC977 and RFC1036 require From, Date, Newsgroups, Subject, > Message-ID. Organization, Lines, In-Reply-To, Expires, and > @@ -239,7 +239,7 @@ header, remove it from this list." > > (defcustom message-required-mail-headers > '(From Subject Date (optional . In-Reply-To) Message-ID > - (optional . User-Agent)) > + (optional . User-Agent)) > "Headers to be generated or prompted for when mailing a > message. > It is recommended that From, Date, To, Subject and Message-ID > be > included. Organization and User-Agent are optional." > @@ -270,11 +270,11 @@ This is a list of regexps and regexp > matches." > :group 'message-headers > :link '(custom-manual "(message)Message Headers") > :type '(repeat :value-to-internal (lambda (widget value) > - (custom-split-regexp-maybe value)) > - :match (lambda (widget value) > - (or (stringp value) > - (widget-editable-list-match widget value))) > - regexp)) > + (custom-split-regexp-maybe value)) > + :match (lambda (widget value) > + (or (stringp value) > + (widget-editable-list-match widget value))) > + regexp)) > > (defcustom message-ignored-mail-headers > "^\\([GF]cc\\|Resent-Fcc\\|Xref\\|X-Draft-From\\|X-Gnus-Agent-Meta-Information\\):" > @@ -291,11 +291,11 @@ any confusion." > :group 'message-interface > :link '(custom-manual "(message)Superseding") > :type '(repeat :value-to-internal (lambda (widget value) > - (custom-split-regexp-maybe value)) > - :match (lambda (widget value) > - (or (stringp value) > - (widget-editable-list-match widget value))) > - regexp)) > + (custom-split-regexp-maybe value)) > + :match (lambda (widget value) > + (or (stringp value) > + (widget-editable-list-match widget value))) > + regexp)) > > (defcustom message-subject-re-regexp > "^[ \t]*\\([Rr][Ee]\\(\\[[0-9]*\\]\\)* ?:[ \t]*\\)*[ \t]*" > @@ -316,8 +316,8 @@ old subject. In this case, > `message-subject-trailing-was-regexp' is > used." > :version "24.1" > :type '(choice (const :tag "never" nil) > - (const :tag "always strip" t) > - (const ask)) > + (const :tag "always strip" t) > + (const ask)) > :link '(custom-manual "(message)Message Headers") > :group 'message-various) > > @@ -432,8 +432,8 @@ when `message-cite-function' is > are \"^-- $\" (strict) and \"^-- *$\" (loose; allow missing > whitespace)." > :type '(choice (const :tag "strict" "^-- $") > - (const :tag "loose" "^-- *$") > - regexp) > + (const :tag "loose" "^-- *$") > + regexp) > :version "22.3" ;; Gnus 5.10.12 (changed default) > :link '(custom-manual "(message)Various Message Variables") > :group 'message-various) > @@ -491,11 +491,11 @@ function > :group 'message-buffers > :link '(custom-manual "(message)Message Buffers") > :type '(choice (const nil) > - (sexp :tag "unique" :format "unique\n" :value unique > - :match (lambda (widget value) (memq value '(unique t)))) > - (const unsent) > - (const standard) > - (function :format "\n %{%t%}: %v"))) > + (sexp :tag "unique" :format "unique\n" :value unique > + :match (lambda (widget value) (memq value '(unique t)))) > + (const unsent) > + (const standard) > + (function :format "\n %{%t%}: %v"))) > > (defcustom message-kill-buffer-on-exit nil > "Non-nil means that the message buffer will be killed after > sending a message." > @@ -516,15 +516,15 @@ This is used by `message-kill-buffer'." > If t, use `message-user-organization-file'." > :group 'message-headers > :type '(choice string > - (const :tag "consult file" t))) > + (const :tag "consult file" t))) > > (defcustom message-user-organization-file > (let (orgfile) > (dolist (f (list "/etc/organization" > - "/etc/news/organization" > - "/usr/lib/news/organization")) > + "/etc/news/organization" > + "/usr/lib/news/organization")) > (when (file-readable-p f) > - (setq orgfile f))) > + (setq orgfile f))) > orgfile) > "Local news organization file." > :type '(choice (const nil) file) > @@ -548,9 +548,9 @@ The provided functions are: > :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) > - (repeat :tag "List of functions" function))) > + (function-item message-forward-subject-fwd) > + (function-item message-forward-subject-name-subject) > + (repeat :tag "List of functions" function))) > > (defcustom message-forward-as-mime nil > "Non-nil means forward messages as an inline/rfc822 MIME > section. > @@ -576,8 +576,8 @@ digital signature." > :version "21.1" > :group 'message-forwarding > :type '(choice (const :tag "use MML" t) > - (const :tag "don't use MML " nil) > - (const :tag "use MML when appropriate" best))) > + (const :tag "don't use MML " nil) > + (const :tag "use MML when appropriate" best))) > > (defcustom message-forward-before-signature t > "Non-nil means put forwarded message before signature, else > after." > @@ -604,11 +604,11 @@ Done before generating the new subject of > a forward." > :group 'message-interface > :link '(custom-manual "(message)Resending") > :type '(repeat :value-to-internal (lambda (widget value) > - (custom-split-regexp-maybe value)) > - :match (lambda (widget value) > - (or (stringp value) > - (widget-editable-list-match widget value))) > - regexp)) > + (custom-split-regexp-maybe value)) > + :match (lambda (widget value) > + (or (stringp value) > + (widget-editable-list-match widget value))) > + regexp)) > > (defcustom message-forward-ignored-headers > "^Content-Transfer-Encoding:\\|^X-Gnus" > "All headers that match this regexp will be deleted when > forwarding a message. > @@ -619,11 +619,11 @@ This may also be a list of regexps." > :version "21.1" > :group 'message-forwarding > :type '(repeat :value-to-internal (lambda (widget value) > - (custom-split-regexp-maybe value)) > - :match (lambda (widget value) > - (or (stringp value) > - (widget-editable-list-match widget value))) > - regexp)) > + (custom-split-regexp-maybe value)) > + :match (lambda (widget value) > + (or (stringp value) > + (widget-editable-list-match widget value))) > + regexp)) > > (defcustom message-forward-included-headers > '("^From:" "^Subject:" "^Date:") > @@ -633,11 +633,11 @@ variable should be a regexp or a list of > regexps." > :version "27.1" > :group 'message-forwarding > :type '(repeat :value-to-internal (lambda (widget value) > - (custom-split-regexp-maybe value)) > - :match (lambda (widget value) > - (or (stringp value) > - (widget-editable-list-match widget value))) > - regexp)) > + (custom-split-regexp-maybe value)) > + :match (lambda (widget value) > + (or (stringp value) > + (widget-editable-list-match widget value))) > + regexp)) > > (defcustom message-ignored-cited-headers "." > "Delete these headers from the messages you yank." > @@ -652,11 +652,11 @@ variable should be a regexp or a list of > regexps." > :link '(custom-manual "(message)Insertion Variables") > :type 'regexp > :set (lambda (symbol value) > - (prog1 > - (custom-set-default symbol value) > - (if (boundp 'gnus-message-cite-prefix-regexp) > - (setq gnus-message-cite-prefix-regexp > - (concat "^\\(?:" value "\\)")))))) > + (prog1 > + (custom-set-default symbol value) > + (if (boundp 'gnus-message-cite-prefix-regexp) > + (setq gnus-message-cite-prefix-regexp > + (concat "^\\(?:" value "\\)")))))) > > (defcustom message-cancel-message "I am canceling my own > article.\n" > "Message to be inserted in the cancel message." > @@ -667,26 +667,26 @@ variable should be a regexp or a list of > regexps." > (defun message-send-mail-function () > "Return suitable value for the variable > `message-send-mail-function'." > (cond ((and (require 'sendmail) > - (boundp 'sendmail-program) > - sendmail-program > - (executable-find sendmail-program)) > - 'message-send-mail-with-sendmail) > - ((and (locate-library "smtpmail") > - (boundp 'smtpmail-default-smtp-server) > - smtpmail-default-smtp-server) > - 'message-smtpmail-send-it) > - ((locate-library "mailclient") > - 'message-send-mail-with-mailclient) > - (t > - (error "Don't know how to send mail. Please customize > `message-send-mail-function'")))) > + (boundp 'sendmail-program) > + sendmail-program > + (executable-find sendmail-program)) > + 'message-send-mail-with-sendmail) > + ((and (locate-library "smtpmail") > + (boundp 'smtpmail-default-smtp-server) > + smtpmail-default-smtp-server) > + 'message-smtpmail-send-it) > + ((locate-library "mailclient") > + 'message-send-mail-with-mailclient) > + (t > + (error "Don't know how to send mail. Please customize > `message-send-mail-function'")))) > > (defun message-default-send-mail-function () > (cond ((eq send-mail-function 'smtpmail-send-it) > 'message-smtpmail-send-it) > - ((eq send-mail-function 'feedmail-send-it) 'feedmail-send-it) > - ((eq send-mail-function 'sendmail-query-once) > 'sendmail-query-once) > - ((eq send-mail-function 'mailclient-send-it) > - 'message-send-mail-with-mailclient) > - (t (message-send-mail-function)))) > + ((eq send-mail-function 'feedmail-send-it) 'feedmail-send-it) > + ((eq send-mail-function 'sendmail-query-once) > 'sendmail-query-once) > + ((eq send-mail-function 'mailclient-send-it) > + 'message-send-mail-with-mailclient) > + (t (message-send-mail-function)))) > > ;; Useful to set in site-init.el > (defcustom message-send-mail-function > (message-default-send-mail-function) > @@ -703,14 +703,14 @@ default is system dependent and determined > by the function > > See also `send-mail-function'." > :type '(radio (function-item message-send-mail-with-sendmail) > - (function-item message-send-mail-with-mh) > - (function-item message-send-mail-with-qmail) > - (function-item message-smtpmail-send-it) > - (function-item smtpmail-send-it) > - (function-item feedmail-send-it) > - (function-item message-send-mail-with-mailclient > - :tag "Use Mailclient package") > - (function :tag "Other")) > + (function-item message-send-mail-with-mh) > + (function-item message-send-mail-with-qmail) > + (function-item message-smtpmail-send-it) > + (function-item smtpmail-send-it) > + (function-item feedmail-send-it) > + (function-item message-send-mail-with-mailclient > + :tag "Use Mailclient package") > + (function :tag "Other")) > :group 'message-sending > :version "23.2" > :initialize 'custom-initialize-default > @@ -765,9 +765,9 @@ always query the user whether to use the > value. If it is the symbol > :group 'message-interface > :link '(custom-manual "(message)Followup") > :type '(choice (const :tag "ignore" nil) > - (const :tag "use & query" t) > - (const use) > - (const ask))) > + (const :tag "use & query" t) > + (const use) > + (const ask))) > > (defcustom message-use-mail-followup-to 'use > "Specifies what to do with Mail-Followup-To header. > @@ -778,8 +778,8 @@ always use the value." > :group 'message-interface > :link '(custom-manual "(message)Mailing Lists") > :type '(choice (const :tag "ignore" nil) > - (const use) > - (const ask))) > + (const use) > + (const ask))) > > (defcustom message-subscribed-address-functions nil > "Specifies functions for determining list subscription. > @@ -831,8 +831,8 @@ symbol `never', the posting is not allowed. > If it is the symbol > :group 'message-interface > :link '(custom-manual "(message)Message Headers") > :type '(choice (const always) > - (const never) > - (const ask))) > + (const never) > + (const ask))) > > (defcustom message-sendmail-f-is-evil nil > "Non-nil means don't add \"-f username\" to the sendmail > command line. > @@ -849,8 +849,8 @@ If this is nil, use `user-mail-address'. If > it is the symbol > `header', use the From: header of the message." > :version "23.2" > :type '(choice (string :tag "From name") > - (const :tag "Use From: header from message" header) > - (const :tag "Use `user-mail-address'" nil)) > + (const :tag "Use From: header from message" header) > + (const :tag "Use `user-mail-address'" nil)) > :link '(custom-manual "(message)Mail Variables") > :group 'message-sending) > > @@ -880,18 +880,18 @@ might set this variable to (\"-f\" > \"you@some.where\")." > :group 'message-sending > :link '(custom-manual "(message)Mail Variables") > :type '(choice (function) > - (repeat string))) > + (repeat string))) > > (defvar gnus-post-method) > (defvar gnus-select-method) > (defcustom message-post-method > (cond ((and (boundp 'gnus-post-method) > - (listp gnus-post-method) > - gnus-post-method) > - gnus-post-method) > - ((boundp 'gnus-select-method) > - gnus-select-method) > - (t '(nnspool ""))) > + (listp gnus-post-method) > + gnus-post-method) > + gnus-post-method) > + ((boundp 'gnus-select-method) > + gnus-select-method) > + (t '(nnspool ""))) > "Method used to post news. > Note that when posting from inside Gnus, for instance, this > variable isn't used." > @@ -913,8 +913,8 @@ 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 "All" t) > - (repeat (sexp :tag "Header")))) > + (const :tag "All" t) > + (repeat (sexp :tag "Header")))) > > (defcustom message-fill-column 72 > "Column beyond which automatic line-wrapping should happen. > @@ -923,7 +923,7 @@ auto-fill in message buffers." > :group 'message-various > ;; :link '(custom-manual "(message)Message Headers") > :type '(choice (const :tag "Don't turn on auto fill" nil) > - (integer))) > + (integer))) > > (defcustom message-setup-hook nil > "Normal hook, run each time a new outgoing message is > initialized. > @@ -984,9 +984,9 @@ Note that Gnus provides a feature where the > reader can click on > people who read your message will have to change their Gnus > configuration. See the variable > `gnus-cite-attribution-suffix'." > :type '(choice > - (function-item :tag "plain" message-insert-citation-line) > - (function-item :tag "formatted" > message-insert-formatted-citation-line) > - (function :tag "Other")) > + (function-item :tag "plain" message-insert-citation-line) > + (function-item :tag "formatted" > message-insert-formatted-citation-line) > + (function :tag "Other")) > :link '(custom-manual "(message)Insertion Variables") > :group 'message-insertion) > > @@ -1014,8 +1014,8 @@ so you should always check it yourself. > Please also read the note in the documentation of > `message-citation-line-function'." > :type '(choice (const :tag "Plain" "%f writes:") > - (const :tag "Include date" "On %a, %b %d %Y, %n wrote:") > - string) > + (const :tag "Include date" "On %a, %b %d %Y, %n wrote:") > + string) > :link '(custom-manual "(message)Insertion Variables") > :version "23.1" ;; No Gnus > :group 'message-insertion) > @@ -1060,9 +1060,9 @@ Predefined functions include > `message-cite-original' and > `message-cite-original-without-signature'. > Note that these functions use `mail-citation-hook' if that is > non-nil." > :type '(radio (function-item message-cite-original) > - (function-item message-cite-original-without-signature) > - (function-item sc-cite-original) > - (function :tag "Other")) > + (function-item message-cite-original-without-signature) > + (function-item sc-cite-original) > + (function :tag "Other")) > :link '(custom-manual "(message)Insertion Variables") > :version "22.3" ;; Gnus 5.10.12 (changed default) > :group 'message-insertion) > @@ -1083,8 +1083,8 @@ If a function, the result from the > function will be used instead. > If a form, the result from the form will be used instead." > :version "23.2" > :type '(choice string (const :tag "Contents of signature > file" t) > - function > - sexp) > + function > + sexp) > :risky t > :link '(custom-manual "(message)Insertion Variables") > :group 'message-insertion) > @@ -1130,8 +1130,8 @@ e.g. using `gnus-posting-styles': > (eval (set (make-local-variable > \\='message-cite-reply-position) \\='above))" > :version "24.1" > :type '(choice (const :tag "Reply inline" traditional) > - (const :tag "Reply above" above) > - (const :tag "Reply below" below)) > + (const :tag "Reply above" above) > + (const :tag "Reply below" below)) > :group 'message-insertion) > > (defcustom message-cite-style nil > @@ -1148,10 +1148,10 @@ use in `gnus-posting-styles', such as: > :version "24.1" > :group 'message-insertion > :type '(choice (const :tag "Do not override variables" :value > nil) > - (const :tag "MS Outlook" :value message-cite-style-outlook) > - (const :tag "Mozilla Thunderbird" :value > message-cite-style-thunderbird) > - (const :tag "Gmail" :value message-cite-style-gmail) > - (variable :tag "User-specified"))) > + (const :tag "MS Outlook" :value message-cite-style-outlook) > + (const :tag "Mozilla Thunderbird" :value > message-cite-style-thunderbird) > + (const :tag "Gmail" :value message-cite-style-gmail) > + (variable :tag "User-specified"))) > > (defconst message-cite-style-outlook > '((message-cite-function 'message-cite-original) > @@ -1204,8 +1204,8 @@ If stringp, use this; if non-nil, use no > host name (user name only)." > :group 'message-headers > :link '(custom-manual "(message)News Headers") > :type '(choice (const :tag "nntp" nil) > - (string :tag "name") > - (sexp :tag "none" :format "%t" t))) > + (string :tag "name") > + (sexp :tag "none" :format "%t" t))) > > ;; This can be the name of a buffer, or a cons cell (FUNCTION . > ;; ARGS) > ;; for yanking the original buffer. > @@ -1251,15 +1251,15 @@ called and its result is inserted." > (defcustom message-default-mail-headers > ;; 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)) > - (if (and (boundp 'mail-self-blind) > - mail-self-blind) > - (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)) > - mail-default-headers) > + (stringp 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)) > + (if (and (boundp 'mail-archive-file-name) > + (stringp 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" > :group 'message-headers > @@ -1278,9 +1278,9 @@ called and its result is inserted." > ;; options -t, and -v if not interactive. > (defcustom message-mailer-swallows-blank-line > (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)" > - system-configuration) > - (file-readable-p "/etc/sendmail.cf") > - (with-temp-buffer > + system-configuration) > + (file-readable-p "/etc/sendmail.cf") > + (with-temp-buffer > (insert-file-contents "/etc/sendmail.cf") > (goto-char (point-min)) > (let ((case-fold-search nil)) > @@ -1329,8 +1329,8 @@ This can also be a list of values." > :group 'message > :link '(custom-manual "(message)Mail Aliases") > :type '(choice (const :tag "Use Mailabbrev" abbrev) > - (const :tag "Use ecomplete" ecomplete) > - (const :tag "No expansion" nil))) > + (const :tag "Use ecomplete" ecomplete) > + (const :tag "No expansion" nil))) > > (defcustom message-self-insert-commands '(self-insert-command) > "List of `self-insert-command's used to trigger ecomplete. > @@ -1353,7 +1353,7 @@ If nil, Message won't auto-save." > :type '(choice directory (const :tag "Don't auto-save" nil))) > > (defcustom message-default-charset (and (not > enable-multibyte-characters) > - 'iso-8859-1) > + 'iso-8859-1) > "Default charset used in non-MULE Emacsen. > If nil, you might be asked to input the charset." > :version "21.1" > @@ -1374,8 +1374,8 @@ If a function email is passed as the > argument." > :group 'message > :link '(custom-manual "(message)Wide Reply") > :type '(choice (const :tag "Yourself" nil) > - regexp > - (repeat :tag "Regexp List" regexp))) > + regexp > + (repeat :tag "Regexp List" regexp))) > > (defsubst message-dont-reply-to-names () > (if (functionp message-dont-reply-to-names) > @@ -1392,19 +1392,19 @@ candidates: > `quoted-text-only' Allow you to post quoted text only; > `multiple-copies' Allow you to post multiple copies; > `cancel-messages' Allow you to cancel or supersede messages > from > - your other email addresses; > + your other email addresses; > `canlock-verify' Allow you to cancel messages without verifying > canlock." > :group 'message > :type '(set (const empty-article) (const quoted-text-only) > - (const multiple-copies) (const cancel-messages) > - (const canlock-verify))) > + (const multiple-copies) (const cancel-messages) > + (const canlock-verify))) > > (defsubst message-gnksa-enable-p (feature) > (or (not (listp message-shoot-gnksa-feet)) > (memq feature message-shoot-gnksa-feet))) > > (defcustom message-hidden-headers '("^References:" "^Face:" > "^X-Face:" > - "^X-Draft-From:") > + "^X-Draft-From:") > "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." > @@ -1412,14 +1412,14 @@ starting with `not' and followed by > regexps." > :group 'message > :link '(custom-manual "(message)Message Headers") > :type '(choice > - :format "%{%t%}: %[Value Type%] %v" > - (regexp :menu-tag "regexp" :format "regexp\n%t: %v") > - (repeat :menu-tag "(regexp ...)" :format "(regexp ...)\n%v%i" > - (regexp :format "%t: %v")) > - (cons :menu-tag "(not regexp ...)" :format "(not regexp > ...)\n%v" > - (const not) > - (repeat :format "%v%i" > - (regexp :format "%t: %v"))))) > + :format "%{%t%}: %[Value Type%] %v" > + (regexp :menu-tag "regexp" :format "regexp\n%t: %v") > + (repeat :menu-tag "(regexp ...)" :format "(regexp ...)\n%v%i" > + (regexp :format "%t: %v")) > + (cons :menu-tag "(not regexp ...)" :format "(not regexp > ...)\n%v" > + (const not) > + (repeat :format "%v%i" > + (regexp :format "%t: %v"))))) > > (defcustom message-cite-articles-with-x-no-archive t > "If non-nil, cite text from articles that has X-No-Archive > set." > @@ -1577,39 +1577,39 @@ starting with `not' and followed by > regexps." > (let ((content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)\n?")) > `((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)) > + (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)) > + (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)) > + (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)) > + (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)) > + (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 > + (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) > "\\)$") > - 1 'message-separator)) > - nil) > + (not (equal mail-header-separator ""))) > + `((,(concat "^\\(" (regexp-quote mail-header-separator) > "\\)$") > + 1 'message-separator)) > + nil) > ((lambda (limit) > - (re-search-forward (concat "^\\(" > - message-cite-prefix-regexp > - "\\).*") > - limit t)) > + (re-search-forward (concat "^\\(" > + message-cite-prefix-regexp > + "\\).*") > + limit t)) > (0 'message-cited-text)) > ("<#/?\\(multipart\\|part\\|external\\|mml\\|secure\\)[^>]*>" > (0 'message-mml)))) > @@ -1619,8 +1619,8 @@ starting with `not' and followed by > regexps." > '((bold . message-bold-region) > (underline . underline-region) > (default . (lambda (b e) > - (message-unbold-region b e) > - (ununderline-region b e)))) > + (message-unbold-region b e) > + (ununderline-region b e)))) > "Alist of mail and news faces for facemenu. > The cdr of each entry is a function for applying the face to a > region.") > > @@ -1667,7 +1667,7 @@ should be sent in several parts. If it is > nil, the size is unlimited." > :group 'message-buffers > :link '(custom-manual "(message)Mail Variables") > :type '(choice (const :tag "unlimited" nil) > - (integer 1000000))) > + (integer 1000000))) > > (defcustom message-alternative-emails nil > "Regexp or predicate function matching alternative email > addresses. > @@ -1682,7 +1682,7 @@ off `message-setup-hook'." > :group 'message-headers > :link '(custom-manual "(message)Message Headers") > :type '(choice (const :tag "Always use primary" nil) > - regexp > + regexp > function)) > > (defcustom message-hierarchical-addresses nil > @@ -1705,18 +1705,18 @@ Except if it is nil, use Gnus native > MUA; if it is t, use > `mail-user-agent'." > :version "22.1" > :type '(radio (const :tag "Gnus native" > - :format "%t\n" > - nil) > - (const :tag "`mail-user-agent'" > - :format "%t\n" > - t) > - (function-item :tag "Default Emacs mail" > - :format "%t\n" > - sendmail-user-agent) > - (function-item :tag "Emacs interface to MH" > - :format "%t\n" > - mh-e-user-agent) > - (function :tag "Other")) > + :format "%t\n" > + nil) > + (const :tag "`mail-user-agent'" > + :format "%t\n" > + t) > + (function-item :tag "Default Emacs mail" > + :format "%t\n" > + sendmail-user-agent) > + (function-item :tag "Emacs interface to MH" > + :format "%t\n" > + mh-e-user-agent) > + (function :tag "Other")) > :version "21.1" > :group 'message) > > @@ -1738,7 +1738,7 @@ no, only reply back to the author." > :group 'message-headers > :link '(custom-manual "(message)News Headers") > :type '(radio (const :format "%v " nil) > - (string :format "FQDN: %v"))) > + (string :format "FQDN: %v"))) > > (defcustom message-use-idna t > "Whether to encode non-ASCII in domain names into ASCII > according to IDNA." > @@ -1746,8 +1746,8 @@ no, only reply back to the author." > :group 'message-headers > :link '(custom-manual "(message)IDNA") > :type '(choice (const :tag "Ask" ask) > - (const :tag "Never" nil) > - (const :tag "Always" t))) > + (const :tag "Never" nil) > + (const :tag "Always" t))) > > (defcustom message-generate-hashcash (if (executable-find > "hashcash") 'opportunistic) > "Whether to generate X-Hashcash: headers. > @@ -1760,8 +1760,8 @@ You must have the \"hashcash\" binary > installed, see `hashcash-path'." > :group 'message-headers > :link '(custom-manual "(message)Mail Headers") > :type '(choice (const :tag "Always" t) > - (const :tag "Never" nil) > - (const :tag "Opportunistic" opportunistic))) > + (const :tag "Never" nil) > + (const :tag "Opportunistic" opportunistic))) > > ;;; Internal variables. > > @@ -1784,10 +1784,10 @@ You must have the \"hashcash\" binary > installed, see `hashcash-path'." > ;;; of rmail.el's rmail-unix-mail-delimiter. > (defvar message-unix-mail-delimiter > (let ((time-zone-regexp > - (concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?" > - "\\|[-+]?[0-9][0-9][0-9][0-9]" > - "\\|" > - "\\) *"))) > + (concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?" > + "\\|[-+]?[0-9][0-9][0-9][0-9]" > + "\\|" > + "\\) *"))) > (concat > "From " > > @@ -1836,14 +1836,14 @@ You must have the \"hashcash\" binary > installed, see `hashcash-path'." > > (defvar message-unsent-separator > (concat "^ *---+ +Unsent message follows +---+ *$\\|" > - "^ *---+ +Returned message +---+ *$\\|" > - "^Start of returned message$\\|" > - "^ *---+ +Original message +---+ *$\\|" > - "^ *--+ +begin message +--+ *$\\|" > - "^ *---+ +Original message follows +---+ *$\\|" > - "^ *---+ +Undelivered message follows +---+ *$\\|" > - "^------ This is a copy of the message, including all the > headers. ------ *$\\|" > - "^|? *---+ +Message text follows: +---+ *|?$") > + "^ *---+ +Returned message +---+ *$\\|" > + "^Start of returned message$\\|" > + "^ *---+ +Original message +---+ *$\\|" > + "^ *--+ +begin message +--+ *$\\|" > + "^ *---+ +Original message follows +---+ *$\\|" > + "^ *---+ +Undelivered message follows +---+ *$\\|" > + "^------ This is a copy of the message, including all the > headers. ------ *$\\|" > + "^|? *---+ +Message text follows: +---+ *|?$") > "A regexp that matches the separator before the text of a > failed message.") > > (defvar message-field-fillers > @@ -1919,7 +1919,7 @@ You must have the \"hashcash\" binary > installed, see `hashcash-path'." > (defmacro message-delete-line (&optional n) > "Delete the current line (and the next N lines)." > `(delete-region (progn (beginning-of-line) (point)) > - (progn (forward-line ,(or n 1)) (point)))) > + (progn (forward-line ,(or n 1)) (point)))) > > (defun message-mark-active-p () > "Non-nil means the mark and region are currently active in > this buffer." > @@ -1928,11 +1928,11 @@ You must have the \"hashcash\" binary > installed, see `hashcash-path'." > (defun message-unquote-tokens (elems) > "Remove double quotes (\") from strings in list ELEMS." > (mapcar (lambda (item) > - (while (string-match "^\\(.*\\)\"\\(.*\\)$" item) > - (setq item (concat (match-string 1 item) > - (match-string 2 item)))) > - item) > - elems)) > + (while (string-match "^\\(.*\\)\"\\(.*\\)$" item) > + (setq item (concat (match-string 1 item) > + (match-string 2 item)))) > + item) > + elems)) > > (defun message-tokenize-header (header &optional separator) > "Split HEADER into a list of header elements. > @@ -1941,41 +1941,41 @@ is used by default." > (if (not header) > nil > (let ((regexp (format "[%s]+" (or separator ","))) > - (first t) > - beg quoted elems paren) > + (first t) > + beg quoted elems paren) > (with-temp-buffer > - (mm-enable-multibyte) > - (setq beg (point-min)) > - (insert header) > - (goto-char (point-min)) > - (while (not (eobp)) > - (if first > - (setq first nil) > - (forward-char 1)) > - (cond ((and (> (point) beg) > - (or (eobp) > - (and (looking-at regexp) > - (not quoted) > - (not paren)))) > - (push (buffer-substring beg (point)) elems) > - (setq beg (match-end 0))) > - ((eq (char-after) ?\") > - (setq quoted (not quoted))) > - ((and (eq (char-after) ?\() > - (not quoted)) > - (setq paren t)) > - ((and (eq (char-after) ?\)) > - (not quoted)) > - (setq paren nil)))) > - (nreverse elems))))) > + (mm-enable-multibyte) > + (setq beg (point-min)) > + (insert header) > + (goto-char (point-min)) > + (while (not (eobp)) > + (if first > + (setq first nil) > + (forward-char 1)) > + (cond ((and (> (point) beg) > + (or (eobp) > + (and (looking-at regexp) > + (not quoted) > + (not paren)))) > + (push (buffer-substring beg (point)) elems) > + (setq beg (match-end 0))) > + ((eq (char-after) ?\") > + (setq quoted (not quoted))) > + ((and (eq (char-after) ?\() > + (not quoted)) > + (setq paren t)) > + ((and (eq (char-after) ?\)) > + (not quoted)) > + (setq paren nil)))) > + (nreverse elems))))) > > (autoload 'nnheader-insert-file-contents "nnheader") > > (defun message-mail-file-mbox-p (file) > "Say whether FILE looks like a Unix mbox file." > (when (and (file-exists-p file) > - (file-readable-p file) > - (file-regular-p file)) > + (file-readable-p file) > + (file-regular-p file)) > (with-temp-buffer > (nnheader-insert-file-contents file) > (goto-char (point-min)) > @@ -1986,10 +1986,10 @@ is used by default." > 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) > - (value (mail-fetch-field header nil (not not-all)))) > + (value (mail-fetch-field header nil (not not-all)))) > (when value > (while (string-match "\n[\t ]+" value) > - (setq value (replace-match " " t t value))) > + (setq value (replace-match " " t t value))) > value))) > > (defun message-field-value (header &optional not-all) > @@ -2009,7 +2009,7 @@ see `message-narrow-to-headers-or-head'." > (progn > (forward-line 1) > (if (re-search-forward "^[^ \n\t]" nil t) > - (point-at-bol) > + (point-at-bol) > (point-max)))) > (goto-char (point-min))) > > @@ -2018,21 +2018,21 @@ see > `message-narrow-to-headers-or-head'." > (while headers > (let (hclean) > (unless (string-match "^\\([^:]+\\):[ \t]*[^ \t]" (car > headers)) > - (error "Invalid header `%s'" (car headers))) > + (error "Invalid header `%s'" (car headers))) > (setq hclean (match-string 1 (car headers))) > (save-restriction > - (message-narrow-to-headers) > - (unless (re-search-forward (concat "^" (regexp-quote hclean) > ":") nil t) > - (goto-char (point-max)) > - (if (string-match "\n$" (car headers)) > - (insert (car headers)) > - (insert (car headers) ?\n))))) > + (message-narrow-to-headers) > + (unless (re-search-forward (concat "^" (regexp-quote hclean) > ":") nil t) > + (goto-char (point-max)) > + (if (string-match "\n$" (car headers)) > + (insert (car headers)) > + (insert (car headers) ?\n))))) > (setq headers (cdr headers)))) > > (defmacro message-with-reply-buffer (&rest forms) > "Evaluate FORMS in the reply buffer, if it exists." > `(when (and (bufferp message-reply-buffer) > - (buffer-name message-reply-buffer)) > + (buffer-name message-reply-buffer)) > (with-current-buffer message-reply-buffer > ,@forms))) > > @@ -2050,15 +2050,15 @@ see > `message-narrow-to-headers-or-head'." > "Remove list identifiers in `gnus-list-identifiers' from > string SUBJECT." > (require 'gnus-sum) ; for gnus-list-identifiers > (let ((regexp (if (stringp gnus-list-identifiers) > - gnus-list-identifiers > - (mapconcat 'identity gnus-list-identifiers " *\\|")))) > + gnus-list-identifiers > + (mapconcat 'identity gnus-list-identifiers " *\\|")))) > (if (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp > - " *\\)\\)+\\(Re: +\\)?\\)") subject) > - (concat (substring subject 0 (match-beginning 1)) > - (or (match-string 3 subject) > - (match-string 5 subject)) > - (substring subject > - (match-end 1))) > + " *\\)\\)+\\(Re: +\\)?\\)") subject) > + (concat (substring subject 0 (match-beginning 1)) > + (or (match-string 3 subject) > + (match-string 5 subject)) > + (substring subject > + (match-end 1))) > subject))) > > (defun message-strip-subject-re (subject) > @@ -2072,8 +2072,8 @@ see `message-narrow-to-headers-or-head'." > :group 'message-various > :version "22.1" ;; Gnus 5.10.9 > :type '(choice string > - (const ".") > - (const "?"))) > + (const ".") > + (const "?"))) > > ;; FIXME: We also should call > ;; `message-strip-subject-encoded-words' > ;; when forwarding. Probably in `message-make-forward-subject' > ;; and > @@ -2083,79 +2083,79 @@ see > `message-narrow-to-headers-or-head'." > "Fix non-decodable words in SUBJECT." > ;; Cf. `gnus-simplify-subject-fully'. > (let* ((case-fold-search t) > - (replacement-chars (format "[%s%s%s]" > - message-replacement-char > - message-replacement-char > - message-replacement-char)) > - (enc-word-re > "=\\?\\([^?]+\\)\\?\\([QB]\\)\\?\\([^?]+\\)\\(\\?=\\)") > - cs-string > - (have-marker > - (with-temp-buffer > - (insert subject) > - (goto-char (point-min)) > - (when (re-search-forward enc-word-re nil t) > - (setq cs-string (match-string 1))))) > - cs-coding q-or-b word-beg word-end) > + (replacement-chars (format "[%s%s%s]" > + message-replacement-char > + message-replacement-char > + message-replacement-char)) > + (enc-word-re > "=\\?\\([^?]+\\)\\?\\([QB]\\)\\?\\([^?]+\\)\\(\\?=\\)") > + cs-string > + (have-marker > + (with-temp-buffer > + (insert subject) > + (goto-char (point-min)) > + (when (re-search-forward enc-word-re nil t) > + (setq cs-string (match-string 1))))) > + cs-coding q-or-b word-beg word-end) > (if (or (not have-marker) ;; No encoded word found... > - ;; ... or double encoding was correct: > - (and (stringp cs-string) > - (setq cs-string (downcase cs-string)) > - (mm-coding-system-p (intern cs-string)) > - (not (prog1 > - (y-or-n-p > - (format "\ > + ;; ... or double encoding was correct: > + (and (stringp cs-string) > + (setq cs-string (downcase cs-string)) > + (mm-coding-system-p (intern cs-string)) > + (not (prog1 > + (y-or-n-p > + (format "\ > Decoded Subject \"%s\" > contains a valid encoded word. Decode again? " > - subject)) > - (setq cs-coding (intern cs-string)))))) > - subject > + subject)) > + (setq cs-coding (intern cs-string)))))) > + subject > (with-temp-buffer > - (insert subject) > - (goto-char (point-min)) > - (while (re-search-forward enc-word-re nil t) > - (setq cs-string (downcase (match-string 1)) > - q-or-b (match-string 2) > - word-beg (match-beginning 0) > - word-end (match-end 0)) > - (setq cs-coding > - (if (mm-coding-system-p (intern cs-string)) > - (setq cs-coding (intern cs-string)) > - nil)) > - ;; No double encoded subject? => bogus charset. > - (unless cs-coding > - (setq cs-coding > - (read-coding-system > - (format-message "\ > + (insert subject) > + (goto-char (point-min)) > + (while (re-search-forward enc-word-re nil t) > + (setq cs-string (downcase (match-string 1)) > + q-or-b (match-string 2) > + word-beg (match-beginning 0) > + word-end (match-end 0)) > + (setq cs-coding > + (if (mm-coding-system-p (intern cs-string)) > + (setq cs-coding (intern cs-string)) > + nil)) > + ;; No double encoded subject? => bogus charset. > + (unless cs-coding > + (setq cs-coding > + (read-coding-system > + (format-message "\ > Decoded Subject \"%s\" > contains an encoded word. The charset `%s' is unknown or > invalid. > Hit RET to replace non-decodable characters with \"%s\" or > enter replacement > charset: " > - subject cs-string message-replacement-char))) > - (if cs-coding > - (replace-match (concat "=?" (symbol-name cs-coding) > - "?\\2?\\3\\4\\5")) > - (save-excursion > - (goto-char word-beg) > - (re-search-forward "=\\?\\([^?]+\\)\\?\\([QB]\\)\\?" word-end > t) > - (replace-match "") > - ;; QP or base64 > - (if (string-match "\\`Q\\'" q-or-b) > - ;; QP > - (progn > - (message "Replacing non-decodable characters with \"%s\"." > - message-replacement-char) > - (while (re-search-forward "\\(=[A-F0-9][A-F0-9]\\)+" > - word-end t) > - (replace-match message-replacement-char))) > - ;; base64 > - (message "Replacing non-decodable characters with \"%s\"." > - replacement-chars) > - (re-search-forward "[^?]+" word-end t) > - (replace-match replacement-chars)) > - (re-search-forward "\\?=") > - (replace-match ""))))) > - (rfc2047-decode-region (point-min) (point-max)) > - (buffer-string))))) > + subject cs-string message-replacement-char))) > + (if cs-coding > + (replace-match (concat "=?" (symbol-name cs-coding) > + "?\\2?\\3\\4\\5")) > + (save-excursion > + (goto-char word-beg) > + (re-search-forward "=\\?\\([^?]+\\)\\?\\([QB]\\)\\?" word-end > t) > + (replace-match "") > + ;; QP or base64 > + (if (string-match "\\`Q\\'" q-or-b) > + ;; QP > + (progn > + (message "Replacing non-decodable characters with \"%s\"." > + message-replacement-char) > + (while (re-search-forward "\\(=[A-F0-9][A-F0-9]\\)+" > + word-end t) > + (replace-match message-replacement-char))) > + ;; base64 > + (message "Replacing non-decodable characters with \"%s\"." > + replacement-chars) > + (re-search-forward "[^?]+" word-end t) > + (replace-match replacement-chars)) > + (re-search-forward "\\?=") > + (replace-match ""))))) > + (rfc2047-decode-region (point-min) (point-max)) > + (buffer-string))))) > > ;;; Start of functions adopted from `message-utils.el'. > > @@ -2192,29 +2192,29 @@ Leading \"Re: \" is not stripped by this > function. Use the function > (list > (read-from-minibuffer "New subject: "))) > (cond ((and (not (or (null new-subject) ; new subject not > empty > - (zerop (string-width new-subject)) > - (string-match "^[ \t]*$" new-subject)))) > - (save-excursion > - (let ((old-subject > - (save-restriction > - (message-narrow-to-headers) > - (message-fetch-field "Subject")))) > - (cond ((not old-subject) > - (error "No current subject")) > - ((not (string-match > - (concat "^[ \t]*" > - (regexp-quote new-subject) > - "[ \t]*$") > - old-subject)) ; yes, it really is a new subject > - ;; delete eventual Re: prefix > - (setq old-subject > - (message-strip-subject-re old-subject)) > - (message-goto-subject) > - (message-delete-line) > - (insert (concat "Subject: " > - new-subject > - " (was: " > - old-subject ")\n"))))))))) > + (zerop (string-width new-subject)) > + (string-match "^[ \t]*$" new-subject)))) > + (save-excursion > + (let ((old-subject > + (save-restriction > + (message-narrow-to-headers) > + (message-fetch-field "Subject")))) > + (cond ((not old-subject) > + (error "No current subject")) > + ((not (string-match > + (concat "^[ \t]*" > + (regexp-quote new-subject) > + "[ \t]*$") > + old-subject)) ; yes, it really is a new subject > + ;; delete eventual Re: prefix > + (setq old-subject > + (message-strip-subject-re old-subject)) > + (message-goto-subject) > + (message-delete-line) > + (insert (concat "Subject: " > + new-subject > + " (was: " > + old-subject ")\n"))))))))) > > (defun message-mark-inserted-region (beg end &optional > verbatim) > "Mark some region in the current article with enclosing tags. > @@ -2249,14 +2249,14 @@ body, set `message-archive-note' to > nil." > (interactive) > (if current-prefix-arg > (setq message-archive-note > - (read-from-minibuffer "Reason for No-Archive: " > - (cons message-archive-note 0)))) > + (read-from-minibuffer "Reason for No-Archive: " > + (cons message-archive-note 0)))) > (save-excursion > (if (message-goto-signature) > - (re-search-backward message-signature-separator)) > + (re-search-backward message-signature-separator)) > (when message-archive-note > - (insert message-archive-note) > - (newline)) > + (insert message-archive-note) > + (newline)) > (message-add-header message-archive-header) > (message-sort-headers))) > > @@ -2268,45 +2268,45 @@ With prefix-argument just set Follow-Up, > don't cross-post." > (replace-regexp-in-string > "\\`.*:" "" > (completing-read "Followup To: " > - (if (boundp 'gnus-newsrc-alist) > - gnus-newsrc-alist) > - nil nil '("poster" . 0) > - (if (boundp 'gnus-group-history) > - 'gnus-group-history))))) > + (if (boundp 'gnus-newsrc-alist) > + gnus-newsrc-alist) > + nil nil '("poster" . 0) > + (if (boundp 'gnus-group-history) > + 'gnus-group-history))))) > (message-remove-header "Follow[Uu]p-[Tt]o" t) > (message-goto-newsgroups) > (beginning-of-line) > ;; if we already did a crosspost before, kill old target > (if (and message-cross-post-old-target > - (re-search-forward > - (regexp-quote (concat "," message-cross-post-old-target)) > - nil t)) > + (re-search-forward > + (regexp-quote (concat "," message-cross-post-old-target)) > + nil t)) > (replace-match "")) > ;; unless (followup is to poster or user explicitly asked not > ;; to cross-post, or target-group is already in Newsgroups) > ;; add target-group to Newsgroups line. > (cond ((and (or > - ;; def: cross-post, req:no > - (and message-cross-post-default (not current-prefix-arg)) > - ;; def: no-cross-post, req:yes > - (and (not message-cross-post-default) current-prefix-arg)) > - (not (string-match "poster" target-group)) > - (not (string-match (regexp-quote target-group) > - (message-fetch-field "Newsgroups")))) > - (end-of-line) > - (insert (concat "," target-group)))) > + ;; def: cross-post, req:no > + (and message-cross-post-default (not current-prefix-arg)) > + ;; def: no-cross-post, req:yes > + (and (not message-cross-post-default) current-prefix-arg)) > + (not (string-match "poster" target-group)) > + (not (string-match (regexp-quote target-group) > + (message-fetch-field "Newsgroups")))) > + (end-of-line) > + (insert (concat "," target-group)))) > (end-of-line) ; ensure Followup: comes after Newsgroups: > ;; unless new followup would be identical to Newsgroups line > ;; make a new Followup-To line > (if (not (string-match (concat "^[ \t]*" > - target-group > - "[ \t]*$") > - (message-fetch-field "Newsgroups"))) > + target-group > + "[ \t]*$") > + (message-fetch-field "Newsgroups"))) > (insert (concat "\nFollowup-To: " target-group))) > (setq message-cross-post-old-target target-group)) > > (defun message-cross-post-insert-note (target-group cross-post > in-old > - _old-groups) > + _old-groups) > "Insert a in message body note about a set Followup or > Crosspost. > If there have been previous notes, delete them. TARGET-GROUP > specifies the > group to Followup-To. When CROSS-POST is t, insert note about > @@ -2316,25 +2316,25 @@ been made to before the user asked for a > Crosspost." > ;; start scanning body for previous uses > (message-goto-signature) > (let ((head (re-search-backward > - (concat "^" mail-header-separator) > - nil t))) ; just search in body > + (concat "^" mail-header-separator) > + nil t))) ; just search in body > (message-goto-signature) > (while (re-search-backward > - (concat "^" (regexp-quote message-cross-post-note) ".*") > - head t) > + (concat "^" (regexp-quote message-cross-post-note) ".*") > + head t) > (message-delete-line)) > (message-goto-signature) > (while (re-search-backward > - (concat "^" (regexp-quote message-followup-to-note) ".*") > - head t) > + (concat "^" (regexp-quote message-followup-to-note) ".*") > + head t) > (message-delete-line)) > ;; insert new note > (if (message-goto-signature) > - (re-search-backward message-signature-separator)) > + (re-search-backward message-signature-separator)) > (if (or in-old > - (not cross-post) > - (string-match "^[ \t]*poster[ \t]*$" target-group)) > - (insert (concat message-followup-to-note target-group "\n")) > + (not cross-post) > + (string-match "^[ \t]*poster[ \t]*$" target-group)) > + (insert (concat message-followup-to-note target-group "\n")) > (insert (concat message-cross-post-note target-group > "\n"))))) > > (defun message-cross-post-followup-to (target-group) > @@ -2345,40 +2345,40 @@ With prefix-argument just set Follow-Up, > don't cross-post." > (replace-regexp-in-string > "\\`.*:" "" > (completing-read "Followup To: " > - (if (boundp 'gnus-newsrc-alist) > - gnus-newsrc-alist) > - nil nil '("poster" . 0) > - (if (boundp 'gnus-group-history) > - 'gnus-group-history))))) > + (if (boundp 'gnus-newsrc-alist) > + gnus-newsrc-alist) > + nil nil '("poster" . 0) > + (if (boundp 'gnus-group-history) > + 'gnus-group-history))))) > (when (fboundp 'gnus-group-real-name) > (setq target-group (gnus-group-real-name target-group))) > (cond ((not (or (null target-group) ; new subject not empty > - (zerop (string-width target-group)) > - (string-match "^[ \t]*$" target-group))) > - (save-excursion > - (let* ((old-groups (message-fetch-field "Newsgroups")) > - (in-old (string-match > - (regexp-quote target-group) > - (or old-groups "")))) > - ;; check whether target exactly matches old Newsgroups > - (cond ((not old-groups) > - (error "No current newsgroup")) > - ((or (not in-old) > - (not (string-match > - (concat "^[ \t]*" > - (regexp-quote target-group) > - "[ \t]*$") > - old-groups))) > - ;; yes, Newsgroups line must change > - (message-cross-post-followup-to-header target-group) > - ;; insert note whether we do cross-post or followup-to > - (funcall message-cross-post-note-function > - target-group > - (if (or (and message-cross-post-default > - (not current-prefix-arg)) > - (and (not message-cross-post-default) > - current-prefix-arg)) t) > - in-old old-groups)))))))) > + (zerop (string-width target-group)) > + (string-match "^[ \t]*$" target-group))) > + (save-excursion > + (let* ((old-groups (message-fetch-field "Newsgroups")) > + (in-old (string-match > + (regexp-quote target-group) > + (or old-groups "")))) > + ;; check whether target exactly matches old Newsgroups > + (cond ((not old-groups) > + (error "No current newsgroup")) > + ((or (not in-old) > + (not (string-match > + (concat "^[ \t]*" > + (regexp-quote target-group) > + "[ \t]*$") > + old-groups))) > + ;; yes, Newsgroups line must change > + (message-cross-post-followup-to-header target-group) > + ;; insert note whether we do cross-post or followup-to > + (funcall message-cross-post-note-function > + target-group > + (if (or (and message-cross-post-default > + (not current-prefix-arg)) > + (and (not message-cross-post-default) > + current-prefix-arg)) t) > + in-old old-groups)))))))) > > ;;; Reduce To: to Cc: or Bcc: header > > @@ -2386,25 +2386,25 @@ With prefix-argument just set Follow-Up, > don't cross-post." > "Replace contents of To: header with contents of Cc: or Bcc: > header." > (interactive) > (let ((cc-content > - (save-restriction (message-narrow-to-headers) > - (message-fetch-field "cc"))) > + (save-restriction (message-narrow-to-headers) > + (message-fetch-field "cc"))) > (bcc nil)) > (if (and (not cc-content) > - (setq cc-content > - (save-restriction > - (message-narrow-to-headers) > - (message-fetch-field "bcc")))) > + (setq cc-content > + (save-restriction > + (message-narrow-to-headers) > + (message-fetch-field "bcc")))) > (setq bcc t)) > (cond (cc-content > - (save-excursion > - (message-goto-to) > - (message-delete-line) > - (insert (concat "To: " cc-content "\n")) > - (save-restriction > - (message-narrow-to-headers) > - (message-remove-header (if bcc > - "bcc" > - "cc")))))))) > + (save-excursion > + (message-goto-to) > + (message-delete-line) > + (insert (concat "To: " cc-content "\n")) > + (save-restriction > + (message-narrow-to-headers) > + (message-remove-header (if bcc > + "bcc" > + "cc")))))))) > > ;;; End of functions adopted from `message-utils.el'. > > @@ -2416,43 +2416,43 @@ If REVERSE, remove headers that doesn't > match HEADER. > Return the number of headers removed." > (goto-char (point-min)) > (let ((regexp (if is-regexp header (concat "^" (regexp-quote > header) ":"))) > - (number 0) > - (case-fold-search t) > - last) > + (number 0) > + (case-fold-search t) > + last) > (while (and (not (eobp)) > - (not last)) > + (not last)) > (if (if reverse > - (and (not (looking-at regexp)) > - ;; Don't remove things not looking like header. > - (looking-at "[!-9;-~]+:")) > - (looking-at regexp)) > - (progn > - (cl-incf number) > - (when first > - (setq last t)) > - (delete-region > - (point) > - ;; There might be a continuation header, so we have to search > - ;; until we find a new non-continuation line. > - (progn > - (forward-line 1) > - (if (re-search-forward "^[^ \t]" nil t) > - (goto-char (match-beginning 0)) > - (point-max))))) > - (forward-line 1) > - (if (re-search-forward "^[^ \t]" nil t) > - (goto-char (match-beginning 0)) > - (goto-char (point-max))))) > + (and (not (looking-at regexp)) > + ;; Don't remove things not looking like header. > + (looking-at "[!-9;-~]+:")) > + (looking-at regexp)) > + (progn > + (cl-incf number) > + (when first > + (setq last t)) > + (delete-region > + (point) > + ;; There might be a continuation header, so we have to search > + ;; until we find a new non-continuation line. > + (progn > + (forward-line 1) > + (if (re-search-forward "^[^ \t]" nil t) > + (goto-char (match-beginning 0)) > + (point-max))))) > + (forward-line 1) > + (if (re-search-forward "^[^ \t]" nil t) > + (goto-char (match-beginning 0)) > + (goto-char (point-max))))) > number)) > > (defun message-remove-first-header (header) > "Remove the first instance of HEADER if there is more than > one." > (let ((count 0) > - (regexp (concat "^" (regexp-quote header) ":"))) > + (regexp (concat "^" (regexp-quote header) ":"))) > (save-excursion > (goto-char (point-min)) > (while (re-search-forward regexp nil t) > - (cl-incf count))) > + (cl-incf count))) > (while (> count 1) > (message-remove-header header nil t) > (cl-decf count)))) > @@ -2463,7 +2463,7 @@ Return the number of headers removed." > (narrow-to-region > (goto-char (point-min)) > (if (re-search-forward > - (concat "^" (regexp-quote mail-header-separator) "\n") nil t) > + (concat "^" (regexp-quote mail-header-separator) "\n") nil t) > (match-beginning 0) > (point-max))) > (goto-char (point-min))) > @@ -2491,9 +2491,9 @@ Point is left at the beginning of the > narrowed-to region." > (narrow-to-region > (goto-char (point-min)) > (if (re-search-forward (concat "\\(\n\\)\n\\|^\\(" > - (regexp-quote mail-header-separator) > - "\n\\)") > - nil t) > + (regexp-quote mail-header-separator) > + "\n\\)") > + nil t) > (or (match-end 1) (match-beginning 2)) > (point-max))) > (goto-char (point-min))) > @@ -2502,22 +2502,22 @@ Point is left at the beginning of the > narrowed-to region." > "Say whether the current buffer contains a news message." > (and (not message-this-is-mail) > (or message-this-is-news > - (save-excursion > - (save-restriction > - (message-narrow-to-headers) > - (and (message-fetch-field "newsgroups") > - (not (message-fetch-field "posted-to")))))))) > + (save-excursion > + (save-restriction > + (message-narrow-to-headers) > + (and (message-fetch-field "newsgroups") > + (not (message-fetch-field "posted-to")))))))) > > (defun message-mail-p () > "Say whether the current buffer contains a mail message." > (and (not message-this-is-news) > (or message-this-is-mail > - (save-excursion > - (save-restriction > - (message-narrow-to-headers) > - (or (message-fetch-field "to") > - (message-fetch-field "cc") > - (message-fetch-field "bcc"))))))) > + (save-excursion > + (save-restriction > + (message-narrow-to-headers) > + (or (message-fetch-field "to") > + (message-fetch-field "cc") > + (message-fetch-field "bcc"))))))) > > (defun message-subscribed-p () > "Say whether we need to insert a MFT header." > @@ -2531,8 +2531,8 @@ Point is left at the beginning of the > narrowed-to region." > (beginning-of-line) > (or (eobp) (forward-char 1)) > (not (if (re-search-forward "^[^ \t]" nil t) > - (beginning-of-line) > - (goto-char (point-max))))) > + (beginning-of-line) > + (goto-char (point-max))))) > > (defun message-sort-headers-1 () > "Sort the buffer as headers using `message-rank' text props." > @@ -2546,7 +2546,7 @@ Point is left at the beginning of the > narrowed-to region." > (forward-char -1))) > (lambda () > (or (get-text-property (point) 'message-rank) > - 10000)))) > + 10000)))) > > (defun message-sort-headers () > "Sort the headers of the current message according to > `message-header-format-alist'." > @@ -2554,19 +2554,19 @@ Point is left at the beginning of the > narrowed-to region." > (save-excursion > (save-restriction > (let ((max (1+ (length message-header-format-alist))) > - rank) > - (message-narrow-to-headers) > - (while (re-search-forward "^[^ \n]+:" nil t) > - (put-text-property > - (match-beginning 0) (1+ (match-beginning 0)) > - 'message-rank > - (if (setq rank (length (memq (assq (intern (buffer-substring > - (match-beginning 0) > - (1- (match-end 0)))) > - message-header-format-alist) > - message-header-format-alist))) > - (- max rank) > - (1+ max))))) > + rank) > + (message-narrow-to-headers) > + (while (re-search-forward "^[^ \n]+:" nil t) > + (put-text-property > + (match-beginning 0) (1+ (match-beginning 0)) > + 'message-rank > + (if (setq rank (length (memq (assq (intern (buffer-substring > + (match-beginning 0) > + (1- (match-end 0)))) > + message-header-format-alist) > + message-header-format-alist))) > + (- max rank) > + (1+ max))))) > (message-sort-headers-1)))) > > (defun message-kill-address () > @@ -2588,15 +2588,15 @@ manual. With two > \\[universal-argument]'s, display the EasyPG or > PGG manual, depending on the value of `mml2015-use'." > (interactive "p") > (info (format "(%s)Top" > - (cond ((eq arg 16) > - (require 'mml2015) > - mml2015-use) > - ((eq arg 4) 'emacs-mime) > - ((and (not (booleanp arg)) > - (symbolp arg)) > - arg) > - (t > - 'message))))) > + (cond ((eq arg 16) > + (require 'mml2015) > + mml2015-use) > + ((eq arg 4) 'emacs-mime) > + ((and (not (booleanp arg)) > + (symbolp arg)) > + arg) > + (t > + 'message))))) > > (defun message-all-recipients () > "Return a list of all recipients in the message, looking at > TO, Cc and Bcc. > @@ -2828,8 +2828,8 @@ message composition doesn't break too > bad." > ;; property list (rather than a list of property symbols), to > ;; be > ;; directly useful for `remove-text-properties'. > '(field nil read-only nil invisible nil intangible nil > - mouse-face nil modification-hooks nil insert-in-front-hooks > nil > - insert-behind-hooks nil point-entered nil point-left nil) > + mouse-face nil modification-hooks nil insert-in-front-hooks > nil > + insert-behind-hooks nil point-entered nil point-left nil) > ;; Other special properties: > ;; category, face, display: probably doesn't do any harm. > ;; fontified: is used by font-lock. > @@ -2844,12 +2844,12 @@ It uses the properties `intangible', > `invisible', `modification-hooks' > and `read-only' when translating ascii or kana text to kanji > text. > These properties are essential to work, so we should never > strip them." > (not (and (boundp 'egg-modefull-mode) > - (symbol-value 'egg-modefull-mode) > - (or (memq (get-text-property pos 'intangible) > - '(its-part-1 its-part-2)) > - (get-text-property pos 'egg-end) > - (get-text-property pos 'egg-lang) > - (get-text-property pos 'egg-start))))) > + (symbol-value 'egg-modefull-mode) > + (or (memq (get-text-property pos 'intangible) > + '(its-part-1 its-part-2)) > + (get-text-property pos 'egg-end) > + (get-text-property pos 'egg-lang) > + (get-text-property pos 'egg-start))))) > > (defsubst message-mail-alias-type-p (type) > (if (atom message-mail-alias-type) > @@ -2861,10 +2861,10 @@ These properties are essential to work, > so we should never strip them." > This function is intended to be called from > `after-change-functions'. > See also `message-forbidden-properties'." > (when (and (message-mail-alias-type-p 'ecomplete) > - (memq this-command message-self-insert-commands)) > + (memq this-command message-self-insert-commands)) > (message-display-abbrev)) > (when (and message-strip-special-text-properties > - (message-tamago-not-in-use-p begin)) > + (message-tamago-not-in-use-p begin)) > (let ((inhibit-read-only t)) > (remove-text-properties begin end > message-forbidden-properties)))) > > @@ -2899,20 +2899,20 @@ Like Text Mode but with these additional > commands:\\ > C-c C-s `message-send' (send the message) C-c C-c > `message-send-and-exit' > C-c C-d Postpone sending the message C-c C-k Kill the message > C-c C-f move to a header field (and create it if there isn't): > - C-c C-f C-t move to To C-c C-f C-s move to Subject > - C-c C-f C-c move to Cc C-c C-f C-b move to Bcc > - C-c C-f C-w move to Fcc C-c C-f C-r move to Reply-To > - C-c C-f C-u move to Summary C-c C-f C-n move to Newsgroups > - C-c C-f C-k move to Keywords C-c C-f C-d move to Distribution > - C-c C-f C-o move to From (\"Originator\") > - C-c C-f C-f move to Followup-To > - C-c C-f C-m move to Mail-Followup-To > - C-c C-f C-e move to Expires > - C-c C-f C-i cycle through Importance values > - C-c C-f s change subject and append \"(was: )\" > - C-c C-f x crossposting with FollowUp-To header and note in > body > - C-c C-f t replace To: header with contents of Cc: or Bcc: > - C-c C-f a Insert X-No-Archive: header and a note in the body > + C-c C-f C-t move to To C-c C-f C-s move to Subject > + C-c C-f C-c move to Cc C-c C-f C-b move to Bcc > + C-c C-f C-w move to Fcc C-c C-f C-r move to Reply-To > + C-c C-f C-u move to Summary C-c C-f C-n move to Newsgroups > + C-c C-f C-k move to Keywords C-c C-f C-d move to Distribution > + C-c C-f C-o move to From (\"Originator\") > + C-c C-f C-f move to Followup-To > + C-c C-f C-m move to Mail-Followup-To > + C-c C-f C-e move to Expires > + C-c C-f C-i cycle through Importance values > + C-c C-f s change subject and append \"(was: )\" > + C-c C-f x crossposting with FollowUp-To header and note in > body > + C-c C-f t replace To: header with contents of Cc: or Bcc: > + C-c C-f a Insert X-No-Archive: header and a note in the body > C-c C-t `message-insert-to' (add a To header to a news > followup) > C-c C-l `message-to-list-only' (removes all but list address in > to/cc) > C-c C-n `message-insert-newsgroups' (add a Newsgroup header to > a news reply) > @@ -2942,11 +2942,11 @@ M-RET `message-newline-and-reformat' > (break the line and reformat)." > (setq buffer-offer-save t) > (set (make-local-variable 'facemenu-add-face-function) > (lambda (face end) > - (let ((face-fun (cdr (assq face message-face-alist)))) > - (if face-fun > - (funcall face-fun (point) end) > - (error "Face %s not configured for %s mode" face mode-name))) > - "")) > + (let ((face-fun (cdr (assq face message-face-alist)))) > + (if face-fun > + (funcall face-fun (point) end) > + (error "Face %s not configured for %s mode" face mode-name))) > + "")) > (set (make-local-variable 'facemenu-remove-face-function) t) > (set (make-local-variable 'message-reply-headers) nil) > (make-local-variable 'message-newsreader) > @@ -2964,7 +2964,7 @@ M-RET `message-newline-and-reformat' > (break the line and reformat)." > (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]*"))) > + (concat "^" (regexp-quote message-yank-prefix) "[ \t]*"))) > (set (make-local-variable 'font-lock-defaults) > '(message-font-lock-keywords t)) > (if (boundp 'tool-bar-map) > @@ -2973,7 +2973,7 @@ M-RET `message-newline-and-reformat' > (break the line and reformat)." > (easy-menu-add message-mode-field-menu message-mode-map) > ;; Mmmm... Forbidden properties... > (add-hook 'after-change-functions > #'message-strip-forbidden-properties > - nil 'local) > + nil 'local) > ;; Allow mail alias things. > (cond > ((message-mail-alias-type-p 'abbrev) > @@ -3007,26 +3007,26 @@ M-RET `message-newline-and-reformat' > (break the line and reformat)." > (make-local-variable 'adaptive-fill-regexp) > (make-local-variable 'adaptive-fill-first-line-regexp) > (let ((quote-prefix-regexp > - ;; User should change message-cite-prefix-regexp if > - ;; message-yank-prefix is set to an abnormal value. > - (concat "\\(" message-cite-prefix-regexp "\\)[ \t]*"))) > + ;; User should change message-cite-prefix-regexp if > + ;; message-yank-prefix is set to an abnormal value. > + (concat "\\(" message-cite-prefix-regexp "\\)[ \t]*"))) > (setq paragraph-start > - (concat > - (regexp-quote mail-header-separator) "$\\|" > - "[ \t]*$\\|" ; blank lines > - "-- $\\|" ; signature delimiter > - "---+$\\|" ; delimiters for forwarded messages > - page-delimiter "$\\|" ; spoiler warnings > - ".*wrote:$\\|" ; attribution lines > - quote-prefix-regexp "$\\|" ; empty lines in quoted text > - ; mml tags > - "<#!*/?\\(multipart\\|part\\|external\\|mml\\|secure\\)")) > + (concat > + (regexp-quote mail-header-separator) "$\\|" > + "[ \t]*$\\|" ; blank lines > + "-- $\\|" ; signature delimiter > + "---+$\\|" ; delimiters for forwarded messages > + page-delimiter "$\\|" ; spoiler warnings > + ".*wrote:$\\|" ; attribution lines > + quote-prefix-regexp "$\\|" ; empty lines in quoted text > + ; mml tags > + "<#!*/?\\(multipart\\|part\\|external\\|mml\\|secure\\)")) > (setq paragraph-separate paragraph-start) > (setq adaptive-fill-regexp > - (concat quote-prefix-regexp "\\|" adaptive-fill-regexp)) > + (concat quote-prefix-regexp "\\|" adaptive-fill-regexp)) > (setq adaptive-fill-first-line-regexp > - (concat quote-prefix-regexp "\\|" > - adaptive-fill-first-line-regexp))) > + (concat quote-prefix-regexp "\\|" > + adaptive-fill-first-line-regexp))) > (setq-local auto-fill-inhibit-regexp nil) > (setq-local normal-auto-fill-function 'message-do-auto-fill)) > > @@ -3130,20 +3130,20 @@ Returns point." > ;; If the message is mangled, find the end of the headers > ;; the > ;; hard way. > (progn > - ;; Skip past all headers and continuation lines. > - (while (looking-at "[^\t\n :]+:\\|[\t ]+[^\t\n ]") > - (forward-line 1)) > - ;; We're now at the first empty line, so perhaps move past it. > - (when (and (eolp) > - (not (eobp))) > - (forward-line 1)) > - (point)))) > + ;; Skip past all headers and continuation lines. > + (while (looking-at "[^\t\n :]+:\\|[\t ]+[^\t\n ]") > + (forward-line 1)) > + ;; We're now at the first empty line, so perhaps move past it. > + (when (and (eolp) > + (not (eobp))) > + (forward-line 1)) > + (point)))) > > (defun message-in-body-p () > "Return t if point is in the message body." > (>= (point) > (save-excursion > - (message-goto-body)))) > + (message-goto-body)))) > > (defun message-goto-eoh (&optional interactive) > "Move point to the end of the headers." > @@ -3181,8 +3181,8 @@ Cc: header are also put into the MFT." > (message-remove-header "Mail-Followup-To") > (setq cc (and include-cc (message-fetch-field "Cc"))) > (setq tos (if cc > - (concat (message-fetch-field "To") "," cc) > - (message-fetch-field "To")))) > + (concat (message-fetch-field "To") "," cc) > + (message-fetch-field "To")))) > (message-goto-mail-followup-to) > (insert (concat tos ", " user-mail-address)))) > > @@ -3194,16 +3194,16 @@ If the original author requested not to > be sent mail, don't insert unless the > prefix FORCE is given." > (interactive "P") > (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")))) > + (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"))) > + "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))) > @@ -3213,7 +3213,7 @@ prefix FORCE is given." > "Insert To and Cc headers as if you were doing a wide reply." > (interactive) > (let ((headers (message-with-reply-buffer > - (message-get-reply-headers t)))) > + (message-get-reply-headers t)))) > (message-carefully-insert-headers headers))) > > (defcustom message-header-synonyms > @@ -3238,46 +3238,46 @@ or in the synonym headers, defined by > `message-header-synonyms'." > ;; (mail-strip-quoted-names "Foo Bar , bla@fasel > ;; (Bla Fasel)") > (dolist (header headers) > (let* ((header-name (symbol-name (car header))) > - (new-header (cdr header)) > - (synonyms (cl-loop for synonym in message-header-synonyms > - when (memq (car header) synonym) return synonym)) > - (old-header > - (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))) > + (new-header (cdr header)) > + (synonyms (cl-loop for synonym in message-header-synonyms > + when (memq (car header) synonym) return synonym)) > + (old-header > + (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) > - (setq old-header (mail-fetch-field header-name)) > - (not (string-match "\\` *\\'" old-header))) > - (insert ", ")) > - (insert new-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." > (interactive) > (let ((follow-to > - (and (bufferp message-reply-buffer) > - (buffer-name message-reply-buffer) > - (with-current-buffer message-reply-buffer > - (message-get-reply-headers t))))) > + (and (bufferp message-reply-buffer) > + (buffer-name message-reply-buffer) > + (with-current-buffer message-reply-buffer > + (message-get-reply-headers t))))) > (save-excursion > (save-restriction > - (message-narrow-to-headers) > - (dolist (elem follow-to) > - (message-remove-header (symbol-name (car elem))) > - (goto-char (point-min)) > - (insert (symbol-name (car elem)) ": " > - (cdr elem) "\n")))))) > + (message-narrow-to-headers) > + (dolist (elem follow-to) > + (message-remove-header (symbol-name (car elem))) > + (goto-char (point-min)) > + (insert (symbol-name (car elem)) ": " > + (cdr elem) "\n")))))) > > (defun message-insert-newsgroups () > "Insert the Newsgroups header from the article being replied > to." > (interactive) > (let ((old-newsgroups (mail-fetch-field "newsgroups")) > - (new-newsgroups (message-fetch-reply-field "newsgroups")) > - (first t) > - insert-newsgroups) > + (new-newsgroups (message-fetch-reply-field "newsgroups")) > + (first t) > + insert-newsgroups) > (message-position-on-field "Newsgroups") > (cond > ((not new-newsgroups) > @@ -3286,21 +3286,21 @@ or in the synonym headers, defined by > `message-header-synonyms'." > (insert new-newsgroups)) > (t > (setq new-newsgroups (split-string new-newsgroups "[, > ]+") > - old-newsgroups (split-string old-newsgroups "[, ]+")) > + old-newsgroups (split-string old-newsgroups "[, ]+")) > (dolist (group new-newsgroups) > - (unless (member group old-newsgroups) > - (push group insert-newsgroups))) > + (unless (member group old-newsgroups) > + (push group insert-newsgroups))) > (if (null insert-newsgroups) > - (error "Newgroup%s already in the header" > - (if (> (length new-newsgroups) 1) > - "s" "")) > - (when old-newsgroups > - (setq first nil)) > - (dolist (group insert-newsgroups) > - (unless first > - (insert ",")) > - (setq first nil) > - (insert group))))))) > + (error "Newgroup%s already in the header" > + (if (> (length new-newsgroups) 1) > + "s" "")) > + (when old-newsgroups > + (setq first nil)) > + (dolist (group insert-newsgroups) > + (unless first > + (insert ",")) > + (setq first nil) > + (insert group))))))) > > > > @@ -3314,20 +3314,20 @@ or in the synonym headers, defined by > `message-header-synonyms'." > (goto-char beg) > ;; snarf citation prefix, if appropriate > (unless (eq (point) (progn (beginning-of-line) (point))) > - (when (looking-at message-cite-prefix-regexp) > - (setq citeprefix (match-string 0)))) > + (when (looking-at message-cite-prefix-regexp) > + (setq citeprefix (match-string 0)))) > (goto-char end) > (delete-region (point) (if (not (message-goto-signature)) > - (point) > - (forward-line -2) > - (point))) > + (point) > + (forward-line -2) > + (point))) > (insert "\n") > (goto-char beg) > (delete-region beg (progn (message-goto-body) > - (forward-line 2) > - (point))) > + (forward-line 2) > + (point))) > (when citeprefix > - (insert citeprefix)))) > + (insert citeprefix)))) > (when (message-goto-signature) > (forward-line -2))) > > @@ -3339,16 +3339,16 @@ of lines before the signature intact." > (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)) > - (unless (bolp) > - (insert "\n"))))))) > + (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)) > + (unless (bolp) > + (insert "\n"))))))) > > (defun message-newline-and-reformat (&optional arg not-break) > "Insert four newlines, and then reformat if inside quoted > text. > @@ -3363,10 +3363,10 @@ Prefix arg means justify as well." > (setq bolp (= beg point)) > ;; Find first line of the paragraph. > (if not-break > - (while (and (not (eobp)) > - (not (looking-at message-cite-prefix-regexp)) > - (looking-at paragraph-start)) > - (forward-line 1))) > + (while (and (not (eobp)) > + (not (looking-at message-cite-prefix-regexp)) > + (looking-at paragraph-start)) > + (forward-line 1))) > ;; Find the prefix > (when (looking-at message-cite-prefix-regexp) > (setq quoted (match-string 0)) > @@ -3374,70 +3374,70 @@ Prefix arg means justify as well." > (looking-at "[ \t]*") > (setq leading-space (match-string 0))) > (if (and quoted > - (not not-break) > - (not bolp) > - (< (- point beg) (length quoted))) > - ;; break inside the cite prefix. > - (setq quoted nil > - end nil)) > + (not not-break) > + (not bolp) > + (< (- point beg) (length quoted))) > + ;; break inside the cite prefix. > + (setq quoted nil > + end nil)) > (if quoted > - (progn > - (forward-line 1) > - (while (and (not (eobp)) > - (not (looking-at paragraph-separate)) > - (looking-at message-cite-prefix-regexp) > - (equal quoted (match-string 0))) > - (goto-char (match-end 0)) > - (looking-at "[ \t]*") > - (if (> (length leading-space) (length (match-string 0))) > - (setq leading-space (match-string 0))) > - (forward-line 1)) > - (setq end (point)) > - (goto-char beg) > - (while (and (if (bobp) nil (forward-line -1) t) > - (not (looking-at paragraph-start)) > - (looking-at message-cite-prefix-regexp) > - (equal quoted (match-string 0))) > - (setq beg (point)) > - (goto-char (match-end 0)) > - (looking-at "[ \t]*") > - (if (> (length leading-space) (length (match-string 0))) > - (setq leading-space (match-string 0))))) > + (progn > + (forward-line 1) > (while (and (not (eobp)) > - (not (looking-at paragraph-separate)) > - (not (looking-at message-cite-prefix-regexp))) > - (forward-line 1)) > + (not (looking-at paragraph-separate)) > + (looking-at message-cite-prefix-regexp) > + (equal quoted (match-string 0))) > + (goto-char (match-end 0)) > + (looking-at "[ \t]*") > + (if (> (length leading-space) (length (match-string 0))) > + (setq leading-space (match-string 0))) > + (forward-line 1)) > (setq end (point)) > (goto-char beg) > (while (and (if (bobp) nil (forward-line -1) t) > - (not (looking-at paragraph-start)) > - (not (looking-at message-cite-prefix-regexp))) > - (setq beg (point)))) > + (not (looking-at paragraph-start)) > + (looking-at message-cite-prefix-regexp) > + (equal quoted (match-string 0))) > + (setq beg (point)) > + (goto-char (match-end 0)) > + (looking-at "[ \t]*") > + (if (> (length leading-space) (length (match-string 0))) > + (setq leading-space (match-string 0))))) > + (while (and (not (eobp)) > + (not (looking-at paragraph-separate)) > + (not (looking-at message-cite-prefix-regexp))) > + (forward-line 1)) > + (setq end (point)) > + (goto-char beg) > + (while (and (if (bobp) nil (forward-line -1) t) > + (not (looking-at paragraph-start)) > + (not (looking-at message-cite-prefix-regexp))) > + (setq beg (point)))) > (goto-char point) > (save-restriction > (narrow-to-region beg end) > (if not-break > - (setq point nil) > - (if bolp > - (newline) > - (newline) > - (newline)) > - (setq point (point)) > - ;; (newline 2) doesn't mark both newline's as hard, so call > - ;; newline twice. -jas > - (newline) > - (newline) > - (delete-region (point) (re-search-forward "[ \t]*")) > - (when (and quoted (not bolp)) > - (insert quoted leading-space))) > + (setq point nil) > + (if bolp > + (newline) > + (newline) > + (newline)) > + (setq point (point)) > + ;; (newline 2) doesn't mark both newline's as hard, so call > + ;; newline twice. -jas > + (newline) > + (newline) > + (delete-region (point) (re-search-forward "[ \t]*")) > + (when (and quoted (not bolp)) > + (insert quoted leading-space))) > (undo-boundary) > (if quoted > - (let* ((adaptive-fill-regexp > - (regexp-quote (concat quoted leading-space))) > - (adaptive-fill-first-line-regexp > - adaptive-fill-regexp )) > - (fill-paragraph arg)) > - (fill-paragraph arg)) > + (let* ((adaptive-fill-regexp > + (regexp-quote (concat quoted leading-space))) > + (adaptive-fill-first-line-regexp > + adaptive-fill-regexp )) > + (fill-paragraph arg)) > + (fill-paragraph arg)) > (if point (goto-char point))))) > > (defun message-fill-paragraph (&optional arg) > @@ -3470,47 +3470,47 @@ Message buffers and is not meant to be > called directly." > "Insert a signature. See documentation for variable > `message-signature'." > (interactive (list 0)) > (let* ((signature > - (cond > - ((and (null message-signature) > - (eq force 0)) > - (save-excursion > - (goto-char (point-max)) > - (not (re-search-backward message-signature-separator nil t)))) > - ((and (null message-signature) > - force) > - t) > - ((functionp message-signature) > - (funcall message-signature)) > - ((listp message-signature) > - (eval message-signature)) > - (t message-signature))) > - signature-file) > + (cond > + ((and (null message-signature) > + (eq force 0)) > + (save-excursion > + (goto-char (point-max)) > + (not (re-search-backward message-signature-separator nil t)))) > + ((and (null message-signature) > + force) > + t) > + ((functionp message-signature) > + (funcall message-signature)) > + ((listp message-signature) > + (eval message-signature)) > + (t message-signature))) > + signature-file) > (setq signature > - (cond ((stringp signature) > - signature) > - ((and (eq t signature) message-signature-file) > - (setq signature-file > - (if (and message-signature-directory > - ;; don't actually use the signature directory > - ;; if message-signature-file contains a path. > - (not (file-name-directory > - message-signature-file))) > - (expand-file-name message-signature-file > - message-signature-directory) > - message-signature-file)) > - (file-exists-p signature-file)))) > + (cond ((stringp signature) > + signature) > + ((and (eq t signature) message-signature-file) > + (setq signature-file > + (if (and message-signature-directory > + ;; don't actually use the signature directory > + ;; if message-signature-file contains a path. > + (not (file-name-directory > + message-signature-file))) > + (expand-file-name message-signature-file > + message-signature-directory) > + message-signature-file)) > + (file-exists-p signature-file)))) > (when signature > (goto-char (point-max)) > ;; Insert the signature. > (unless (bolp) > - (newline)) > + (newline)) > (when message-signature-insert-empty-line > - (newline)) > + (newline)) > (insert "-- ") > (newline) > (if (eq signature t) > - (insert-file-contents signature-file) > - (insert signature)) > + (insert-file-contents signature-file) > + (insert signature)) > (goto-char (point-max)) > (or (bolp) (newline))))) > > @@ -3541,17 +3541,17 @@ and `low'." > (interactive) > (save-excursion > (let ((new "high") > - cur) > + cur) > (save-restriction > - (message-narrow-to-headers) > - (when (setq cur (message-fetch-field "Importance")) > - (message-remove-header "Importance") > - (setq new (cond ((string= cur "high") > - "low") > - ((string= cur "low") > - "normal") > - (t > - "high"))))) > + (message-narrow-to-headers) > + (when (setq cur (message-fetch-field "Importance")) > + (message-remove-header "Importance") > + (setq new (cond ((string= cur "high") > + "low") > + ((string= cur "low") > + "normal") > + (t > + "high"))))) > (message-goto-eoh) > (insert (format "Importance: %s\n" new))))) > > @@ -3565,9 +3565,9 @@ 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") > - (message-field-value "From") > - (message-make-from)))))) > + (or (message-field-value "Reply-To") > + (message-field-value "From") > + (message-make-from)))))) > > (defun message-elide-region (b e) > "Elide the text in the region. > @@ -3593,19 +3593,19 @@ text was killed." > (prefix-numeric-value current-prefix-arg)))) > > (setq n (if (numberp n) (mod n 26) 13)) ;canonize N > - (unless (or (zerop n) ; no action needed for a rot of 0 > - (= b e)) ; no region to rotate > + (unless (or (zerop n) ; no action needed for a rot of 0 > + (= b e)) ; no region to rotate > ;; We build the table, if necessary. > (when (or (not message-caesar-translation-table) > - (/= (aref message-caesar-translation-table ?a) (+ ?a n))) > + (/= (aref message-caesar-translation-table ?a) (+ ?a n))) > (setq message-caesar-translation-table > - (message-make-caesar-translation-table n))) > + (message-make-caesar-translation-table n))) > (translate-region b e message-caesar-translation-table))) > > (defun message-make-caesar-translation-table (n) > "Create a rot table with offset N." > (let ((i -1) > - (table (make-string 256 0))) > + (table (make-string 256 0))) > (while (< (cl-incf i) 256) > (aset table i i)) > (concat > @@ -3623,12 +3623,12 @@ Used to encode/decode possibly offensive > messages (commonly in rec.humor). > With prefix arg, specifies the number of places to rotate each > letter forward. > Mail and USENET news headers are not rotated unless WIDE is > non-nil." > (interactive (if current-prefix-arg > - (list (prefix-numeric-value current-prefix-arg)) > - (list nil))) > + (list (prefix-numeric-value current-prefix-arg)) > + (list nil))) > (save-excursion > (save-restriction > (when (and (not wide) (message-goto-body)) > - (narrow-to-region (point) (point-max))) > + (narrow-to-region (point) (point-max))) > (message-caesar-region (point-min) (point-max) rotnum)))) > > (defun message-pipe-buffer-body (program) > @@ -3636,7 +3636,7 @@ Mail and USENET news headers are not > rotated unless WIDE is non-nil." > (save-excursion > (save-restriction > (when (message-goto-body) > - (narrow-to-region (point) (point-max))) > + (narrow-to-region (point) (point-max))) > (shell-command-on-region > (point-min) (point-max) program nil t)))) > > @@ -3649,20 +3649,20 @@ name, rather than giving an automatic > name." > (save-restriction > (goto-char (point-min)) > (narrow-to-region (point) > - (search-forward mail-header-separator nil 'end)) > + (search-forward mail-header-separator nil 'end)) > (let* ((mail-to (or > - (if (message-news-p) (message-fetch-field "Newsgroups") > - (message-fetch-field "To")) > - "")) > - (mail-trimmed-to > - (if (string-match "," mail-to) > - (concat (substring mail-to 0 (match-beginning 0)) ", ...") > - mail-to)) > - (name-default (concat "*message* " mail-trimmed-to)) > - (name (if enter-string > - (read-string "New buffer name: " name-default) > - name-default))) > - (rename-buffer name t))))) > + (if (message-news-p) (message-fetch-field "Newsgroups") > + (message-fetch-field "To")) > + "")) > + (mail-trimmed-to > + (if (string-match "," mail-to) > + (concat (substring mail-to 0 (match-beginning 0)) ", ...") > + mail-to)) > + (name-default (concat "*message* " mail-trimmed-to)) > + (name (if enter-string > + (read-string "New buffer name: " name-default) > + name-default))) > + (rename-buffer name t))))) > > (defun message-fill-yanked-message (&optional justifyp) > "Fill the paragraphs of a message yanked into this one. > @@ -3686,30 +3686,30 @@ However, if `message-yank-prefix' is > non-nil, insert that prefix on each line." > ;; Remove unwanted headers. > (when message-ignored-cited-headers > (let (all-removed) > - (save-restriction > - (narrow-to-region > - (goto-char start) > - (if (search-forward "\n\n" nil t) > - (1- (point)) > - (point))) > - (message-remove-header message-ignored-cited-headers t) > - (when (= (point-min) (point-max)) > - (setq all-removed t)) > - (goto-char (point-max))) > - (if all-removed > - (goto-char start) > - (forward-line 1)))) > + (save-restriction > + (narrow-to-region > + (goto-char start) > + (if (search-forward "\n\n" nil t) > + (1- (point)) > + (point))) > + (message-remove-header message-ignored-cited-headers t) > + (when (= (point-min) (point-max)) > + (setq all-removed t)) > + (goto-char (point-max))) > + (if all-removed > + (goto-char start) > + (forward-line 1)))) > ;; Delete blank lines at the start of the buffer. > (while (and (point-min) > - (eolp) > - (not (eobp))) > + (eolp) > + (not (eobp))) > (message-delete-line)) > ;; Delete blank lines at the end of the buffer. > (goto-char (point-max)) > (unless (eq (preceding-char) ?\n) > (insert "\n")) > (while (and (zerop (forward-line -1)) > - (looking-at "$")) > + (looking-at "$")) > (message-delete-line))) > ;; Do the indentation. > (if (null message-yank-prefix) > @@ -3717,13 +3717,13 @@ However, if `message-yank-prefix' is > non-nil, insert that prefix on each line." > (save-excursion > (goto-char start) > (while (< (point) (or end (mark t))) > - (cond ((looking-at ">") > - (insert message-yank-cited-prefix)) > - ((looking-at "^$") > - (insert message-yank-empty-prefix)) > - (t > - (insert message-yank-prefix))) > - (forward-line 1)))) > + (cond ((looking-at ">") > + (insert message-yank-cited-prefix)) > + ((looking-at "^$") > + (insert message-yank-empty-prefix)) > + (t > + (insert message-yank-prefix))) > + (forward-line 1)))) > (goto-char start)) > > (defun message-remove-blank-cited-lines (&optional remove) > @@ -3734,57 +3734,57 @@ To use this automatically, you may add > this function to > `gnus-message-setup-hook'." > (interactive "P") > (let ((citexp (concat "^\\(" > - (concat message-yank-cited-prefix "\\|") > - message-yank-prefix > - "\\)+ *\n"))) > + (concat message-yank-cited-prefix "\\|") > + message-yank-prefix > + "\\)+ *\n"))) > (message "Removing `%s'" citexp) > (save-excursion > (message-goto-body) > (while (re-search-forward citexp nil t) > - (replace-match (if remove "" "\n")))))) > + (replace-match (if remove "" "\n")))))) > > (defun message--yank-original-internal (arg) > (let ((modified (buffer-modified-p)) > - body-text) > - (when (and message-reply-buffer > - message-cite-function) > - (when (equal message-cite-reply-position 'above) > - (save-excursion > - (setq body-text > - (buffer-substring (message-goto-body) > - (point-max))) > - (delete-region (message-goto-body) (point-max)))) > - (if (bufferp message-reply-buffer) > - (delete-windows-on message-reply-buffer t)) > - (push-mark (save-excursion > - (cond > - ((bufferp message-reply-buffer) > - (insert-buffer-substring message-reply-buffer)) > - ((and (consp message-reply-buffer) > - (functionp (car message-reply-buffer))) > - (apply (car message-reply-buffer) > - (cdr message-reply-buffer)))) > - (unless (bolp) > - (insert ?\n)) > - (point))) > - (unless arg > - (funcall message-cite-function) > - (unless (eq (char-before (mark t)) ?\n) > - (let ((pt (point))) > - (goto-char (mark t)) > - (insert-before-markers ?\n) > - (goto-char pt)))) > - (pcase message-cite-reply-position > - ('above > - (message-goto-body) > - (insert body-text) > - (insert (if (bolp) "\n" "\n\n")) > - (message-goto-body)) > - ('below > - (message-goto-signature))) > - ;; Add a `message-setup-very-last-hook' here? > - ;; Add `gnus-article-highlight-citation' here? > - (unless modified > + body-text) > + (when (and message-reply-buffer > + message-cite-function) > + (when (equal message-cite-reply-position 'above) > + (save-excursion > + (setq body-text > + (buffer-substring (message-goto-body) > + (point-max))) > + (delete-region (message-goto-body) (point-max)))) > + (if (bufferp message-reply-buffer) > + (delete-windows-on message-reply-buffer t)) > + (push-mark (save-excursion > + (cond > + ((bufferp message-reply-buffer) > + (insert-buffer-substring message-reply-buffer)) > + ((and (consp message-reply-buffer) > + (functionp (car message-reply-buffer))) > + (apply (car message-reply-buffer) > + (cdr message-reply-buffer)))) > + (unless (bolp) > + (insert ?\n)) > + (point))) > + (unless arg > + (funcall message-cite-function) > + (unless (eq (char-before (mark t)) ?\n) > + (let ((pt (point))) > + (goto-char (mark t)) > + (insert-before-markers ?\n) > + (goto-char pt)))) > + (pcase message-cite-reply-position > + ('above > + (message-goto-body) > + (insert body-text) > + (insert (if (bolp) "\n" "\n\n")) > + (message-goto-body)) > + ('below > + (message-goto-signature))) > + ;; Add a `message-setup-very-last-hook' here? > + ;; Add `gnus-article-highlight-citation' here? > + (unless modified > (setq message-checksum (message-checksum)))))) > > (defun message-yank-original (&optional arg) > @@ -3801,8 +3801,8 @@ prefix, and don't delete any headers." > ;; eval the let forms contained in message-cite-style > (eval > `(let ,(if (symbolp message-cite-style) > - (symbol-value message-cite-style) > - message-cite-style) > + (symbol-value message-cite-style) > + message-cite-style) > (message--yank-original-internal ',arg)))) > > (defun message-yank-buffer (buffer) > @@ -3817,10 +3817,10 @@ prefix, and don't delete any headers." > (let (buffers) > (save-current-buffer > (dolist (buffer (buffer-list t)) > - (set-buffer buffer) > - (when (and (derived-mode-p 'message-mode) > - (null message-sent-message-via)) > - (push (buffer-name buffer) buffers)))) > + (set-buffer buffer) > + (when (and (derived-mode-p 'message-mode) > + (null message-sent-message-via)) > + (push (buffer-name buffer) buffers)))) > (nreverse buffers))) > > (defun message-cite-original-1 (strip-signature) > @@ -3830,60 +3830,60 @@ original message. > > This function uses `mail-citation-hook' if that is non-nil." > (if (and (boundp 'mail-citation-hook) > - mail-citation-hook) > + mail-citation-hook) > (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) > - 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) > - (setq x-no-archive (message-fetch-field "x-no-archive")) > - (vector 0 > - (or (message-fetch-field "subject") "none") > - (or (message-fetch-field "from") "nobody") > - (message-fetch-field "date") > - (message-fetch-field "message-id" t) > - (message-fetch-field "references") > - 0 0 "")))) > + (end (mark t)) > + (x-no-archive nil) > + (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) > + (setq x-no-archive (message-fetch-field "x-no-archive")) > + (vector 0 > + (or (message-fetch-field "subject") "none") > + (or (message-fetch-field "from") "nobody") > + (message-fetch-field "date") > + (message-fetch-field "message-id" t) > + (message-fetch-field "references") > + 0 0 "")))) > (mml-quote-region start end) > (when strip-signature > - ;; Allow undoing. > - (undo-boundary) > - (goto-char end) > - (when (re-search-backward message-signature-separator start t) > - ;; Also peel off any blank lines before the signature. > - (forward-line -1) > - (while (looking-at "^[ \t]*$") > - (forward-line -1)) > - (forward-line 1) > - (delete-region (point) end) > - (unless (search-backward "\n\n" start t) > - ;; Insert a blank line if it is peeled off. > - (insert "\n")))) > + ;; Allow undoing. > + (undo-boundary) > + (goto-char end) > + (when (re-search-backward message-signature-separator start t) > + ;; Also peel off any blank lines before the signature. > + (forward-line -1) > + (while (looking-at "^[ \t]*$") > + (forward-line -1)) > + (forward-line 1) > + (delete-region (point) end) > + (unless (search-backward "\n\n" start t) > + ;; Insert a blank line if it is peeled off. > + (insert "\n")))) > (goto-char start) > (mapc 'funcall functions) > (when message-citation-line-function > - (unless (bolp) > - (insert "\n")) > - (funcall message-citation-line-function)) > + (unless (bolp) > + (insert "\n")) > + (funcall message-citation-line-function)) > (when (and x-no-archive > - (not 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") > - (push-mark) > - (forward-line -1))))) > + (not 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") > + (push-mark) > + (forward-line -1))))) > > (defun message-cite-original () > "Cite function in the standard Message manner." > @@ -3915,89 +3915,89 @@ See `message-citation-line-format'." > (unless from > (setq from (mail-header-from message-reply-headers))) > (let* ((data (condition-case () > - (funcall (if (boundp 'gnus-extract-address-components) > - gnus-extract-address-components > - 'mail-extract-address-components) > - from) > - (error nil))) > - (name (car data)) > - (fname name) > - (lname name) > - (net (car (cdr data))) > - (name-or-net (or (car data) > - (car (cdr data)) from)) > - (time > - (when (string-match "%[^fnNFL]" message-citation-line-format) > - (cond ((numberp (car-safe date)) date) ;; backward > compatibility > - (date (gnus-date-get-time date)) > - (t > - (gnus-date-get-time > - (setq date (mail-header-date message-reply-headers))))))) > - (tz (or tz > - (when (stringp date) > - (nth 8 (parse-time-string date))))) > - (flist > - (let ((i ?A) lst) > - (when (stringp name) > - ;; Guess first name and last name: > - (let* ((names (delq > - nil > - (mapcar > - (lambda (x) > - (if (string-match "\\`\\(\\w\\|[-.]\\)+\\'" > - x) > - x > - nil)) > - (split-string name "[ \t]+")))) > - (count (length names))) > - (cond ((= count 1) > - (setq fname (car names) > - lname "")) > - ((or (= count 2) (= count 3)) > - (setq fname (car names) > - lname (mapconcat 'identity (cdr names) " "))) > - ((> count 3) > - (setq fname (mapconcat 'identity > - (butlast names (- count 2)) > - " ") > - lname (mapconcat 'identity > - (nthcdr 2 names) > - " ")))) > + (funcall (if (boundp 'gnus-extract-address-components) > + gnus-extract-address-components > + 'mail-extract-address-components) > + from) > + (error nil))) > + (name (car data)) > + (fname name) > + (lname name) > + (net (car (cdr data))) > + (name-or-net (or (car data) > + (car (cdr data)) from)) > + (time > + (when (string-match "%[^fnNFL]" message-citation-line-format) > + (cond ((numberp (car-safe date)) date) ;; backward > compatibility > + (date (gnus-date-get-time date)) > + (t > + (gnus-date-get-time > + (setq date (mail-header-date message-reply-headers))))))) > + (tz (or tz > + (when (stringp date) > + (nth 8 (parse-time-string date))))) > + (flist > + (let ((i ?A) lst) > + (when (stringp name) > + ;; Guess first name and last name: > + (let* ((names (delq > + nil > + (mapcar > + (lambda (x) > + (if (string-match "\\`\\(\\w\\|[-.]\\)+\\'" > + x) > + x > + nil)) > + (split-string name "[ \t]+")))) > + (count (length names))) > + (cond ((= count 1) > + (setq fname (car names) > + lname "")) > + ((or (= count 2) (= count 3)) > + (setq fname (car names) > + lname (mapconcat 'identity (cdr names) " "))) > + ((> count 3) > + (setq fname (mapconcat 'identity > + (butlast names (- count 2)) > + " ") > + lname (mapconcat 'identity > + (nthcdr 2 names) > + " ")))) > (when (string-match "\\(.*\\),\\'" fname) > (let ((newlname (match-string 1 fname))) > (setq fname lname lname newlname))))) > - ;; The following letters are not used in `format-time-string': > - (push ?E lst) (push "" lst) > - (push ?F lst) (push (or fname name-or-net) lst) > - ;; We might want to use "" instead of "" later. > - (push ?J lst) (push "" lst) > - (push ?K lst) (push "" lst) > - (push ?L lst) (push lname lst) > - (push ?N lst) (push name-or-net lst) > - (push ?O lst) (push "" lst) > - (push ?P lst) (push "

" lst) > - (push ?Q lst) (push "" lst) > - (push ?f lst) (push from lst) > - (push ?i lst) (push "" lst) > - (push ?n lst) (push net lst) > - (push ?o lst) (push "" lst) > - (push ?q lst) (push "" lst) > - (push ?t lst) (push "" lst) > - (push ?v lst) (push "" lst) > - ;; Delegate the rest to `format-time-string': > - (while (<= i ?z) > - (when (and (not (memq i lst)) > - ;; Skip (Z,a) > - (or (<= i ?Z) > - (>= i ?a))) > - (push i lst) > - (push (condition-case nil > - (format-time-string (format "%%%c" i) time tz) > - (error (format ">%c<" i))) > - lst)) > - (setq i (1+ i))) > - (reverse lst))) > - (spec (apply 'format-spec-make flist))) > + ;; The following letters are not used in `format-time-string': > + (push ?E lst) (push "" lst) > + (push ?F lst) (push (or fname name-or-net) lst) > + ;; We might want to use "" instead of "" later. > + (push ?J lst) (push "" lst) > + (push ?K lst) (push "" lst) > + (push ?L lst) (push lname lst) > + (push ?N lst) (push name-or-net lst) > + (push ?O lst) (push "" lst) > + (push ?P lst) (push "

" lst) > + (push ?Q lst) (push "" lst) > + (push ?f lst) (push from lst) > + (push ?i lst) (push "" lst) > + (push ?n lst) (push net lst) > + (push ?o lst) (push "" lst) > + (push ?q lst) (push "" lst) > + (push ?t lst) (push "" lst) > + (push ?v lst) (push "" lst) > + ;; Delegate the rest to `format-time-string': > + (while (<= i ?z) > + (when (and (not (memq i lst)) > + ;; Skip (Z,a) > + (or (<= i ?Z) > + (>= i ?a))) > + (push i lst) > + (push (condition-case nil > + (format-time-string (format "%%%c" i) time tz) > + (error (format ">%c<" i))) > + lst)) > + (setq i (1+ i))) > + (reverse lst))) > + (spec (apply 'format-spec-make flist))) > (insert (format-spec message-citation-line-format spec))) > (newline))) > > @@ -4019,27 +4019,27 @@ This function strips off the signature > from the original message." > (narrow-to-region > (goto-char (point-min)) > (progn > - (re-search-forward > - (concat "^" (regexp-quote mail-header-separator) "$")) > - (match-beginning 0))) > + (re-search-forward > + (concat "^" (regexp-quote mail-header-separator) "$")) > + (match-beginning 0))) > (goto-char (point-min)) > (if (re-search-forward (concat "^" (regexp-quote header) > ":") nil t) > - (progn > - (re-search-forward "^[^ \t]" nil 'move) > - (beginning-of-line) > - (skip-chars-backward "\n") > - t) > - (while (and afters > - (not (re-search-forward > - (concat "^" (regexp-quote (car afters)) ":") > - nil t))) > - (pop afters)) > - (when afters > - (re-search-forward "^[^ \t]" nil 'move) > - (beginning-of-line)) > - (insert header ": \n") > - (forward-char -1) > - nil)))) > + (progn > + (re-search-forward "^[^ \t]" nil 'move) > + (beginning-of-line) > + (skip-chars-backward "\n") > + t) > + (while (and afters > + (not (re-search-forward > + (concat "^" (regexp-quote (car afters)) ":") > + nil t))) > + (pop afters)) > + (when afters > + (re-search-forward "^[^ \t]" nil 'move) > + (beginning-of-line)) > + (insert header ": \n") > + (forward-char -1) > + nil)))) > > > > @@ -4053,12 +4053,12 @@ The usage of ARG is defined by the > instance that called Message. > It should typically alter the sending method in some way or > other." > (interactive "P") > (let ((buf (current-buffer)) > - (actions message-exit-actions)) > + (actions message-exit-actions)) > (when (and (message-send arg) > - (buffer-name buf)) > + (buffer-name buf)) > (message-bury buf) > (if message-kill-buffer-on-exit > - (kill-buffer buf)) > + (kill-buffer buf)) > (message-do-actions actions) > t))) > > @@ -4076,32 +4076,32 @@ Instead, just auto-save the buffer and > then bury it." > "Kill the current buffer." > (interactive) > (when (or (not (buffer-modified-p)) > - (not message-kill-buffer-query) > - (yes-or-no-p "Message modified; kill anyway? ")) > + (not message-kill-buffer-query) > + (yes-or-no-p "Message modified; kill anyway? ")) > (let ((actions message-kill-actions) > - (draft-article message-draft-article) > - (auto-save-file-name buffer-auto-save-file-name) > - (file-name buffer-file-name) > - (modified (buffer-modified-p))) > + (draft-article message-draft-article) > + (auto-save-file-name buffer-auto-save-file-name) > + (file-name buffer-file-name) > + (modified (buffer-modified-p))) > (setq buffer-file-name nil) > (kill-buffer (current-buffer)) > - (when (and (or (and auto-save-file-name > - (file-exists-p auto-save-file-name)) > - (and file-name > - (file-exists-p file-name))) > - (progn > - ;; If the message buffer has lived in a dedicated window, > - ;; `kill-buffer' has killed the frame. Thus the > - ;; `yes-or-no-p' may show up in a lowered frame. Make sure > - ;; that the user can see the question by raising the > - ;; current frame: > - (raise-frame) > - (yes-or-no-p (format "Remove the backup file%s? " > - (if modified " too" ""))))) > - (ignore-errors > - (delete-file auto-save-file-name)) > - (let ((message-draft-article draft-article)) > - (message-disassociate-draft))) > + (when (and (and auto-save-file-name > + (file-exists-p auto-save-file-name)) > + (and file-name > + (file-exists-p file-name)) > + (progn > + ;; If the message buffer has lived in a dedicated window, > + ;; `kill-buffer' has killed the frame. Thus the > + ;; `yes-or-no-p' may show up in a lowered frame. Make sure > + ;; that the user can see the question by raising the > + ;; current frame: > + (raise-frame) > + (yes-or-no-p (format "Remove the backup file%s? " > + (if modified " too" ""))))) > + (ignore-errors > + (delete-file auto-save-file-name)) > + (let ((message-draft-article draft-article)) > + (message-disassociate-draft))) > (message-do-actions actions)))) > > (defun message-bury (buffer) > @@ -4133,52 +4133,52 @@ It should typically alter the sending > method in some way or other." > (mml-secure-bcc-is-safe) > (when message-confirm-send > (or (y-or-n-p "Send message? ") > - (keyboard-quit))) > + (keyboard-quit))) > (message message-sending-message) > (let ((alist message-send-method-alist) > - (success t) > - elem sent dont-barf-on-no-method > - (message-options message-options)) > + (success t) > + elem sent dont-barf-on-no-method > + (message-options message-options)) > (message-options-set-recipient) > (while (and success > - (setq elem (pop alist))) > + (setq elem (pop alist))) > (when (funcall (cadr elem)) > - (when (and (or (not (memq (car elem) > - message-sent-message-via)) > - (message-fetch-field "supersedes") > - (if (or (message-gnksa-enable-p 'multiple-copies) > - (not (eq (car elem) 'news))) > - (y-or-n-p > - (format > - "Already sent message via %s; resend? " > - (car elem))) > - (error "Denied posting -- multiple copies"))) > - (setq success (funcall (caddr elem) arg))) > - (setq sent t)))) > + (when (and (or (not (memq (car elem) > + message-sent-message-via)) > + (message-fetch-field "supersedes") > + (if (or (message-gnksa-enable-p 'multiple-copies) > + (not (eq (car elem) 'news))) > + (y-or-n-p > + (format > + "Already sent message via %s; resend? " > + (car elem))) > + (error "Denied posting -- multiple copies"))) > + (setq success (funcall (caddr elem) arg))) > + (setq sent t)))) > (unless (or sent > - (not success) > - (let ((fcc (message-fetch-field "Fcc")) > - (gcc (message-fetch-field "Gcc"))) > - (when (or fcc gcc) > - (or (eq message-allow-no-recipients 'always) > - (and (not (eq message-allow-no-recipients 'never)) > - (setq dont-barf-on-no-method > - (y-or-n-p > - (format "No receiver, perform %s anyway? " > - (cond ((and fcc gcc) "Fcc and Gcc") > - (fcc "Fcc") > - (t "Gcc")))))))))) > + (not success) > + (let ((fcc (message-fetch-field "Fcc")) > + (gcc (message-fetch-field "Gcc"))) > + (when (or fcc gcc) > + (or (eq message-allow-no-recipients 'always) > + (and (not (eq message-allow-no-recipients 'never)) > + (setq dont-barf-on-no-method > + (y-or-n-p > + (format "No receiver, perform %s anyway? " > + (cond ((and fcc gcc) "Fcc and Gcc") > + (fcc "Fcc") > + (t "Gcc")))))))))) > (error "No methods specified to send by")) > (when (or dont-barf-on-no-method > - (and success sent)) > + (and success sent)) > (message-do-fcc) > (save-excursion > - (run-hooks 'message-sent-hook)) > + (run-hooks 'message-sent-hook)) > (message "Sending...done") > ;; Do ecomplete address snarfing. > (when (and (message-mail-alias-type-p 'ecomplete) > - (not message-inhibit-ecomplete)) > - (message-put-addresses-in-ecomplete)) > + (not message-inhibit-ecomplete)) > + (message-put-addresses-in-ecomplete)) > ;; Mark the buffer as unmodified and delete auto-save. > (set-buffer-modified-p nil) > (delete-auto-save-file-if-necessary t) > @@ -4201,7 +4201,7 @@ It should typically alter the sending > method in some way or other." > "Eval FORMS if TYPE is to be checked." > `(or (message-check-element ,type) > (save-excursion > - ,@forms))) > + ,@forms))) > > (put 'message-check 'lisp-indent-function 1) > (put 'message-check 'edebug-form-spec '(form body)) > @@ -4217,19 +4217,19 @@ not have PROP." > (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 > + (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))) > + (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))) > > (defcustom message-bogus-addresses > @@ -4243,19 +4243,19 @@ conformance." > :version "26.1" ; @@ -> @.*@ > :group 'message-headers > :type '(choice > - (const :tag "None" nil) > - (list > - (set :inline t > - (const "noreply") > - (const "nospam") > - (const "invalid") > - (const :tag "duplicate @" "@.*@") > - (const :tag "non-ascii local part" "[^[:ascii:]].*@") > - (const :tag "`_' in domain part" "@.*_") > - (const :tag "whitespace" "[ \t]")) > - (repeat :inline t > - :tag "Other" > - (regexp))))) > + (const :tag "None" nil) > + (list > + (set :inline t > + (const "noreply") > + (const "nospam") > + (const "invalid") > + (const :tag "duplicate @" "@.*@") > + (const :tag "non-ascii local part" "[^[:ascii:]].*@") > + (const :tag "`_' in domain part" "@.*_") > + (const :tag "whitespace" "[ \t]")) > + (repeat :inline t > + :tag "Other" > + (regexp))))) > > (defun message-fix-before-sending () > "Do various things to make the message nice before sending > it." > @@ -4272,83 +4272,83 @@ conformance." > ;; is clobbered by an after-change hook anyhow. > (message-check 'invisible-text > (let ((regions (message-text-with-property 'invisible)) > - from to) > + from to) > (when regions > - (while regions > - (setq from (caar regions) > - to (cdar regions) > - regions (cdr regions)) > - (put-text-property from to 'invisible nil) > - (overlay-put (make-overlay from to) 'face 'highlight)) > - (unless (yes-or-no-p > - "Invisible text found and made visible; continue sending? ") > - (error "Invisible text found and made visible"))))) > + (while regions > + (setq from (caar regions) > + to (cdar regions) > + regions (cdr regions)) > + (put-text-property from to 'invisible nil) > + (overlay-put (make-overlay from to) 'face 'highlight)) > + (unless (yes-or-no-p > + "Invisible text found and made visible; continue sending? ") > + (error "Invisible text found and made visible"))))) > (message-check 'illegible-text > (let (char found choice nul-chars) > (message-goto-body) > (setq nul-chars (save-excursion > - (search-forward "\000" nil t))) > + (search-forward "\000" nil t))) > (while (progn > - (skip-chars-forward mm-7bit-chars) > - (when (get-text-property (point) 'no-illegible-text) > - ;; There is a signed or encrypted raw message part > - ;; that is considered to be safe. > - (goto-char (or (next-single-property-change > - (point) 'no-illegible-text) > - (point-max)))) > - (setq char (char-after))) > - (when (or (< char 128) > - (and enable-multibyte-characters > - (memq (char-charset char) > - '(eight-bit-control eight-bit-graphic > - ;; Emacs 23, Bug#1770: > - eight-bit > - control-1)) > - (not (get-text-property > - (point) 'untranslated-utf-8)))) > - (overlay-put (make-overlay (point) (1+ (point))) 'face > 'highlight) > - (setq found t)) > - (forward-char)) > + (skip-chars-forward mm-7bit-chars) > + (when (get-text-property (point) 'no-illegible-text) > + ;; There is a signed or encrypted raw message part > + ;; that is considered to be safe. > + (goto-char (or (next-single-property-change > + (point) 'no-illegible-text) > + (point-max)))) > + (setq char (char-after))) > + (when (or (< char 128) > + (and enable-multibyte-characters > + (memq (char-charset char) > + '(eight-bit-control eight-bit-graphic > + ;; Emacs 23, Bug#1770: > + eight-bit > + control-1)) > + (not (get-text-property > + (point) 'untranslated-utf-8)))) > + (overlay-put (make-overlay (point) (1+ (point))) 'face > 'highlight) > + (setq found t)) > + (forward-char)) > (when found > - (setq choice > - (car > - (read-multiple-choice > - (if nul-chars > - "NUL characters found, which may cause problems. Continue > sending?" > - "Non-printable characters found. Continue sending?") > - `((?d "delete" "Remove non-printable characters and send") > - (?r "replace" > - ,(format > - "Replace non-printable characters with \"%s\" and send" > - message-replacement-char)) > - (?s "send" "Send as is without removing anything") > - (?e "edit" "Continue editing"))))) > - (if (eq choice ?e) > - (error "Non-printable characters")) > - (message-goto-body) > - (skip-chars-forward mm-7bit-chars) > - (while (not (eobp)) > - (when (let ((char (char-after))) > - (or (< char 128) > - (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. > - ;; -- fx > - (memq (char-charset char) > - '(eight-bit-control eight-bit-graphic > - ;; Emacs 23, Bug#1770: > - eight-bit > - control-1)) > - (not (get-text-property > - (point) 'untranslated-utf-8))))) > - (if (eq choice ?i) > - (message-kill-all-overlays) > - (delete-char 1) > - (when (eq choice ?r) > - (insert message-replacement-char)))) > - (forward-char) > - (skip-chars-forward mm-7bit-chars))))) > + (setq choice > + (car > + (read-multiple-choice > + (if nul-chars > + "NUL characters found, which may cause problems. Continue > sending?" > + "Non-printable characters found. Continue sending?") > + `((?d "delete" "Remove non-printable characters and send") > + (?r "replace" > + ,(format > + "Replace non-printable characters with \"%s\" and send" > + message-replacement-char)) > + (?s "send" "Send as is without removing anything") > + (?e "edit" "Continue editing"))))) > + (if (eq choice ?e) > + (error "Non-printable characters")) > + (message-goto-body) > + (skip-chars-forward mm-7bit-chars) > + (while (not (eobp)) > + (when (let ((char (char-after))) > + (or (< char 128) > + (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. > + ;; -- fx > + (memq (char-charset char) > + '(eight-bit-control eight-bit-graphic > + ;; Emacs 23, Bug#1770: > + eight-bit > + control-1)) > + (not (get-text-property > + (point) 'untranslated-utf-8))))) > + (if (eq choice ?i) > + (message-kill-all-overlays) > + (delete-char 1) > + (when (eq choice ?r) > + (insert message-replacement-char)))) > + (forward-char) > + (skip-chars-forward mm-7bit-chars))))) > (message-check 'bogus-recipient > ;; Warn before sending a mail to an invalid address. > (message-check-recipients))) > @@ -4364,18 +4364,18 @@ An address might be bogus if there's a > matching entry in > ;; FIXME: How about "foo@subdomain", when the MTA adds > ;; ".domain.tld"? > (let (found) > (mapc (lambda (address) > - (setq address (or (cadr address) "")) > - (when (or (string= "" address) > - (and message-bogus-addresses > - (let ((re > - (if (listp message-bogus-addresses) > - (mapconcat 'identity > - message-bogus-addresses > - "\\|") > - message-bogus-addresses))) > - (string-match re address)))) > + (setq address (or (cadr address) "")) > + (when (or (string= "" address) > + (and message-bogus-addresses > + (let ((re > + (if (listp message-bogus-addresses) > + (mapconcat 'identity > + message-bogus-addresses > + "\\|") > + message-bogus-addresses))) > + (string-match re address)))) > (push address found))) > - (mail-extract-address-components recipients t)) > + (mail-extract-address-components recipients t)) > found)) > > (defun message-check-recipients () > @@ -4387,23 +4387,23 @@ This function could be useful in > `message-setup-hook'." > (message-narrow-to-headers) > (dolist (hdr '("To" "Cc" "Bcc")) > (let ((addr (message-fetch-field hdr))) > - (when (stringp addr) > - (dolist (bog (message-bogus-recipient-p addr)) > - (and bog > - (not (y-or-n-p > - (format-message > - "Address `%s'%s might be bogus. Continue? " > - bog > - ;; If the encoded version of the email address > - ;; is different from the unencoded version, > - ;; then we likely have invisible characters or > - ;; the like. Display the encoded version, > - ;; too. > - (let ((encoded (rfc2047-encode-string bog))) > - (if (string= encoded bog) > - "" > - (format " (%s)" encoded)))))) > - (user-error "Bogus address")))))))) > + (when (stringp addr) > + (dolist (bog (message-bogus-recipient-p addr)) > + (and bog > + (not (y-or-n-p > + (format-message > + "Address `%s'%s might be bogus. Continue? " > + bog > + ;; If the encoded version of the email address > + ;; is different from the unencoded version, > + ;; then we likely have invisible characters or > + ;; the like. Display the encoded version, > + ;; too. > + (let ((encoded (rfc2047-encode-string bog))) > + (if (string= encoded bog) > + "" > + (format " (%s)" encoded)))))) > + (user-error "Bogus address")))))))) > > (custom-add-option 'message-setup-hook > 'message-check-recipients) > > @@ -4411,14 +4411,14 @@ This function could be useful in > `message-setup-hook'." > "Add ACTION to be performed when doing an exit of type > TYPES." > (while types > (add-to-list (intern (format "message-%s-actions" (pop > types))) > - action))) > + action))) > > (defun message-delete-action (action &rest types) > "Delete ACTION from lists of actions performed when doing an > exit of type TYPES." > (let (var) > (while types > (set (setq var (intern (format "message-%s-actions" (pop > types)))) > - (delq action (symbol-value var)))))) > + (delq action (symbol-value var)))))) > > (defun message-do-actions (actions) > "Perform all actions in ACTIONS." > @@ -4428,10 +4428,10 @@ This function could be useful in > `message-setup-hook'." > (cond > ;; A simple function. > ((functionp action) > - (funcall action)) > + (funcall action)) > ;; Something to be evalled. > (t > - (eval action)))))) > + (eval action)))))) > > (defun message-send-mail-partially () > "Send mail as message/partial." > @@ -4442,66 +4442,66 @@ This function could be useful in > `message-setup-hook'." > (replace-match "\n") > (run-hooks 'message-send-mail-hook) > (let ((p (goto-char (point-min))) > - (tembuf (message-generate-new-buffer-clone-locals " message > temp")) > - (curbuf (current-buffer)) > - (id (message-make-message-id)) (n 1) > + (tembuf (message-generate-new-buffer-clone-locals " message > temp")) > + (curbuf (current-buffer)) > + (id (message-make-message-id)) (n 1) > plist total header) > (while (not (eobp)) > (if (< (point-max) (+ p > message-send-mail-partially-limit)) > - (goto-char (point-max)) > - (goto-char (+ p message-send-mail-partially-limit)) > - (beginning-of-line) > - (if (<= (point) p) (forward-line 1))) ;; In case of bad > message. > + (goto-char (point-max)) > + (goto-char (+ p message-send-mail-partially-limit)) > + (beginning-of-line) > + (if (<= (point) p) (forward-line 1))) ;; In case of bad > message. > (push p plist) > (setq p (point))) > (setq total (length plist)) > (push (point-max) plist) > (setq plist (nreverse plist)) > (unwind-protect > - (save-excursion > - (setq p (pop plist)) > - (while plist > - (set-buffer curbuf) > - (copy-to-buffer tembuf p (car plist)) > - (set-buffer tembuf) > - (goto-char (point-min)) > - (if header > - (progn > - (goto-char (point-min)) > - (narrow-to-region (point) (point)) > - (insert header)) > - (message-goto-eoh) > - (setq header (buffer-substring (point-min) (point))) > - (goto-char (point-min)) > - (narrow-to-region (point) (point)) > - (insert header) > - (message-remove-header "Mime-Version") > - (message-remove-header "Content-Type") > - (message-remove-header "Content-Transfer-Encoding") > - (message-remove-header "Message-ID") > - (message-remove-header "Lines") > - (goto-char (point-max)) > - (insert "Mime-Version: 1.0\n") > - (setq header (buffer-string))) > - (goto-char (point-max)) > - (insert (format "Content-Type: message/partial; id=\"%s\"; > number=%d; total=%d\n\n" > - id n total)) > - (forward-char -1) > - (let ((mail-header-separator "")) > - (when (memq 'Message-ID message-required-mail-headers) > - (insert "Message-ID: " (message-make-message-id) "\n")) > - (when (memq 'Lines message-required-mail-headers) > - (insert "Lines: " (message-make-lines) "\n")) > - (message-goto-subject) > - (end-of-line) > - (insert (format " (%d/%d)" n total)) > - (widen) > - (if message-send-mail-real-function > - (funcall message-send-mail-real-function) > - (message-multi-smtp-send-mail))) > - (setq n (+ n 1)) > - (setq p (pop plist)) > - (erase-buffer))) > + (save-excursion > + (setq p (pop plist)) > + (while plist > + (set-buffer curbuf) > + (copy-to-buffer tembuf p (car plist)) > + (set-buffer tembuf) > + (goto-char (point-min)) > + (if header > + (progn > + (goto-char (point-min)) > + (narrow-to-region (point) (point)) > + (insert header)) > + (message-goto-eoh) > + (setq header (buffer-substring (point-min) (point))) > + (goto-char (point-min)) > + (narrow-to-region (point) (point)) > + (insert header) > + (message-remove-header "Mime-Version") > + (message-remove-header "Content-Type") > + (message-remove-header "Content-Transfer-Encoding") > + (message-remove-header "Message-ID") > + (message-remove-header "Lines") > + (goto-char (point-max)) > + (insert "Mime-Version: 1.0\n") > + (setq header (buffer-string))) > + (goto-char (point-max)) > + (insert (format "Content-Type: message/partial; id=\"%s\"; > number=%d; total=%d\n\n" > + id n total)) > + (forward-char -1) > + (let ((mail-header-separator "")) > + (when (memq 'Message-ID message-required-mail-headers) > + (insert "Message-ID: " (message-make-message-id) "\n")) > + (when (memq 'Lines message-required-mail-headers) > + (insert "Lines: " (message-make-lines) "\n")) > + (message-goto-subject) > + (end-of-line) > + (insert (format " (%d/%d)" n total)) > + (widen) > + (if message-send-mail-real-function > + (funcall message-send-mail-real-function) > + (message-multi-smtp-send-mail))) > + (setq n (+ n 1)) > + (setq p (pop plist)) > + (erase-buffer))) > (kill-buffer tembuf)))) > > (declare-function hashcash-wait-async "hashcash" (&optional > buffer)) > @@ -4509,29 +4509,29 @@ This function could be useful in > `message-setup-hook'." > (defun message-send-mail (&optional _) > (require 'mail-utils) > (let* ((tembuf (message-generate-new-buffer-clone-locals " > message temp")) > - (case-fold-search nil) > - (news (message-news-p)) > - (mailbuf (current-buffer)) > - (message-this-is-mail t) > - ;; gnus-setup-posting-charset is autoloaded in mml.el (FIXME > - ;; maybe it should not be), which this file requires. Hence > - ;; the fboundp test is always true. Loading it from gnus-msg > - ;; loads many Gnus files (Bug#5642). If > - ;; gnus-group-posting-charset-alist hasn't been customized, > - ;; this is just going to return nil anyway. FIXME it would > - ;; be good to improve this further, because even if g-g-p-c-a > - ;; has been customized, that is likely to just be for news. > - ;; Eg either move the definition from gnus-msg, or separate > ;; out > - ;; the mail and news parts. > - (message-posting-charset > - (if (and (fboundp 'gnus-setup-posting-charset) > - (boundp 'gnus-group-posting-charset-alist)) > - (gnus-setup-posting-charset nil) > - message-posting-charset)) > - (headers message-required-mail-headers) > - options) > + (case-fold-search nil) > + (news (message-news-p)) > + (mailbuf (current-buffer)) > + (message-this-is-mail t) > + ;; gnus-setup-posting-charset is autoloaded in mml.el (FIXME > + ;; maybe it should not be), which this file requires. Hence > + ;; the fboundp test is always true. Loading it from gnus-msg > + ;; loads many Gnus files (Bug#5642). If > + ;; gnus-group-posting-charset-alist hasn't been customized, > + ;; this is just going to return nil anyway. FIXME it would > + ;; be good to improve this further, because even if g-g-p-c-a > + ;; has been customized, that is likely to just be for news. > + ;; Eg either move the definition from gnus-msg, or separate > ;; out > + ;; the mail and news parts. > + (message-posting-charset > + (if (and (fboundp 'gnus-setup-posting-charset) > + (boundp 'gnus-group-posting-charset-alist)) > + (gnus-setup-posting-charset nil) > + message-posting-charset)) > + (headers message-required-mail-headers) > + options) > (when (and message-generate-hashcash > - (not (eq message-generate-hashcash 'opportunistic))) > + (not (eq message-generate-hashcash 'opportunistic))) > (message "Generating hashcash...") > (require 'hashcash) > ;; Wait for calculations already started to finish... > @@ -4544,28 +4544,28 @@ This function could be useful in > `message-setup-hook'." > (message-narrow-to-headers) > ;; Generate the Mail-Followup-To header if the header is > ;; not there... > (if (and (message-subscribed-p) > - (not (mail-fetch-field "mail-followup-to"))) > - (setq headers > - (cons > - (cons "Mail-Followup-To" (message-make-mail-followup-to)) > - message-required-mail-headers)) > - ;; otherwise, delete the MFT header if the field is empty > - (when (equal "" (mail-fetch-field "mail-followup-to")) > - (message-remove-header "^Mail-Followup-To:"))) > + (not (mail-fetch-field "mail-followup-to"))) > + (setq headers > + (cons > + (cons "Mail-Followup-To" (message-make-mail-followup-to)) > + message-required-mail-headers)) > + ;; otherwise, delete the MFT header if the field is empty > + (when (equal "" (mail-fetch-field "mail-followup-to")) > + (message-remove-header "^Mail-Followup-To:"))) > ;; Insert some headers. > (let ((message-deletable-headers > - (if news nil message-deletable-headers))) > - (message-generate-headers headers)) > + (if news nil message-deletable-headers))) > + (message-generate-headers headers)) > ;; Check continuation headers. > (message-check 'continuation-headers > - (goto-char (point-min)) > - (while (re-search-forward "^[^ \t\n][^ \t\n:]*[ \t\n]" nil t) > - (goto-char (match-beginning 0)) > - (if (y-or-n-p "Fix continuation lines? ") > - (insert " ") > - (forward-line 1) > - (unless (y-or-n-p "Send anyway? ") > - (error "Failed to send the message"))))) > + (goto-char (point-min)) > + (while (re-search-forward "^[^ \t\n][^ \t\n:]*[ \t\n]" nil t) > + (goto-char (match-beginning 0)) > + (if (y-or-n-p "Fix continuation lines? ") > + (insert " ") > + (forward-line 1) > + (unless (y-or-n-p "Send anyway? ") > + (error "Failed to send the message"))))) > ;; Fold too-long header lines. They should be no longer > ;; than > ;; 998 octets long. > (message--fold-long-headers) > @@ -4573,76 +4573,76 @@ This function could be useful in > `message-setup-hook'." > (run-hooks 'message-header-hook)) > (setq options message-options) > (unwind-protect > - (with-current-buffer tembuf > - (erase-buffer) > - (setq message-options options) > - ;; Avoid copying text props (except hard newlines). > - (insert (with-current-buffer mailbuf > - (mml-buffer-substring-no-properties-except-some > - (point-min) (point-max)))) > - ;; Remove some headers. > - (message-encode-message-body) > - (save-restriction > - (message-narrow-to-headers) > - ;; We (re)generate the Lines header. > - (when (memq 'Lines message-required-mail-headers) > - (message-generate-headers '(Lines))) > - ;; Remove some headers. > - (message-remove-header message-ignored-mail-headers t) > - (let ((mail-parse-charset message-default-charset)) > - (mail-encode-encoded-word-buffer))) > - (goto-char (point-max)) > - ;; require one newline at the end. > - (or (= (preceding-char) ?\n) > - (insert ?\n)) > - (message-cleanup-headers) > - ;; FIXME: we're inserting the courtesy copy after encoding. > - ;; This is wrong if the courtesy copy string contains > - ;; non-ASCII characters. -- jh > - (when > - (save-restriction > - (message-narrow-to-headers) > - (and news > - (not (message-fetch-field "List-Post")) > - (not (message-fetch-field "List-ID")) > - (or (message-fetch-field "cc") > - (message-fetch-field "bcc") > - (message-fetch-field "to")) > - (let ((content-type (message-fetch-field > - "content-type"))) > - (and > - (or > - (not content-type) > - (string= "text/plain" > - (car > - (mail-header-parse-content-type > - content-type)))) > - (not > - (string= "base64" > - (message-fetch-field > - "content-transfer-encoding"))))))) > - (message-insert-courtesy-copy > - (with-current-buffer mailbuf > - message-courtesy-message))) > + (with-current-buffer tembuf > + (erase-buffer) > + (setq message-options options) > + ;; Avoid copying text props (except hard newlines). > + (insert (with-current-buffer mailbuf > + (mml-buffer-substring-no-properties-except-some > + (point-min) (point-max)))) > + ;; Remove some headers. > + (message-encode-message-body) > + (save-restriction > + (message-narrow-to-headers) > + ;; We (re)generate the Lines header. > + (when (memq 'Lines message-required-mail-headers) > + (message-generate-headers '(Lines))) > + ;; Remove some headers. > + (message-remove-header message-ignored-mail-headers t) > + (let ((mail-parse-charset message-default-charset)) > + (mail-encode-encoded-word-buffer))) > + (goto-char (point-max)) > + ;; require one newline at the end. > + (or (= (preceding-char) ?\n) > + (insert ?\n)) > + (message-cleanup-headers) > + ;; FIXME: we're inserting the courtesy copy after encoding. > + ;; This is wrong if the courtesy copy string contains > + ;; non-ASCII characters. -- jh > + (when > + (save-restriction > + (message-narrow-to-headers) > + (and news > + (not (message-fetch-field "List-Post")) > + (not (message-fetch-field "List-ID")) > + (or (message-fetch-field "cc") > + (message-fetch-field "bcc") > + (message-fetch-field "to")) > + (let ((content-type (message-fetch-field > + "content-type"))) > + (and > + (or > + (not content-type) > + (string= "text/plain" > + (car > + (mail-header-parse-content-type > + content-type)))) > + (not > + (string= "base64" > + (message-fetch-field > + "content-transfer-encoding"))))))) > + (message-insert-courtesy-copy > + (with-current-buffer mailbuf > + message-courtesy-message))) > ;; Let's make sure we encoded all the body. > (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) > - (not (message-y-or-n-p > - "The message size is too large, split? " > - t > - "\ > + (if (or (not message-send-mail-partially-limit) > + (< (buffer-size) message-send-mail-partially-limit) > + (not (message-y-or-n-p > + "The message size is too large, split? " > + t > + "\ > The message size, " > - (/ (buffer-size) 1000) "KB, is too large. > + (/ (buffer-size) 1000) "KB, is too large. > > Some mail gateways (MTA's) bounce large messages. To avoid the > problem, answer `y', and the message will be split into several > smaller pieces, the size of each is about " > - (/ message-send-mail-partially-limit 1000) > - "KB except the last > + (/ message-send-mail-partially-limit 1000) > + "KB except the last > one. > > However, some mail readers (MUA's) can't read split messages, > i.e., > @@ -4653,13 +4653,13 @@ The size limit is controlled by > `message-send-mail-partially-limit'. > If you always want Gnus to send messages in one piece, set > `message-send-mail-partially-limit' to nil. > "))) > - (progn > - (message "Sending via mail...") > - (if message-send-mail-real-function > - (funcall message-send-mail-real-function) > - (message-multi-smtp-send-mail))) > - (message-send-mail-partially)) > - (setq options message-options)) > + (progn > + (message "Sending via mail...") > + (if message-send-mail-real-function > + (funcall message-send-mail-real-function) > + (message-multi-smtp-send-mail))) > + (message-send-mail-partially)) > + (setq options message-options)) > (kill-buffer tembuf)) > (set-buffer mailbuf) > (setq message-options options) > @@ -4669,7 +4669,7 @@ If you always want Gnus to send messages > in one piece, set > (goto-char (point-min)) > (while (not (eobp)) > (when (and (looking-at "[^:]+:") > - (> (- (line-end-position) (point)) 998)) > + (> (- (line-end-position) (point)) 998)) > (mail-header-fold-field)) > (forward-line 1))) > > @@ -4684,93 +4684,93 @@ Or, if there's a header that specifies a > different method, use > that instead." > (let ((method (message-field-value "X-Message-SMTP-Method"))) > (if (not method) > - (funcall message-send-mail-function) > + (funcall message-send-mail-function) > (message-remove-header "X-Message-SMTP-Method") > (setq method (split-string method)) > (cond > ((equal (car method) "sendmail") > - (message-send-mail-with-sendmail)) > + (message-send-mail-with-sendmail)) > ((equal (car method) "smtp") > - (require 'smtpmail) > - (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))) > + (require 'smtpmail) > + (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)))))) > + (error "Unknown method %s" method)))))) > > (defun message-send-mail-with-sendmail () > "Send off the prepared buffer with sendmail." > (require 'sendmail) > (let ((errbuf (if message-interactive > - (message-generate-new-buffer-clone-locals > - " sendmail errors") > - 0)) > - resend-to-addresses delimline) > + (message-generate-new-buffer-clone-locals > + " sendmail errors") > + 0)) > + resend-to-addresses delimline) > (unwind-protect > - (progn > - (let ((case-fold-search t)) > - (save-restriction > - (message-narrow-to-headers) > - (setq resend-to-addresses (message-fetch-field "resent-to"))) > - ;; Change header-delimiter to be what sendmail expects. > - (goto-char (point-min)) > - (re-search-forward > - (concat "^" (regexp-quote mail-header-separator) "\n")) > - (replace-match "\n") > - (backward-char 1) > - (setq delimline (point-marker)) > - (run-hooks 'message-send-mail-hook) > - ;; Insert an extra newline if we need it to work around > - ;; Sun's bug that swallows newlines. > - (goto-char (1+ delimline)) > - (when (eval message-mailer-swallows-blank-line) > - (newline)) > - (when message-interactive > - (with-current-buffer errbuf > - (erase-buffer)))) > - (let* ((default-directory "/") > - (coding-system-for-write message-send-coding-system) > - (cpr (apply > - 'call-process-region > - (append > - (list (point-min) (point-max) sendmail-program > - nil errbuf nil "-oi") > - message-sendmail-extra-arguments > - ;; Always specify who from, > - ;; since some systems have broken sendmails. > - ;; But some systems are more broken with -f, so > - ;; we'll let users override this. > - (and (null message-sendmail-f-is-evil) > - (list "-f" (message-sendmail-envelope-from))) > - ;; These mean "report errors by mail" > - ;; and "deliver in background". > - (if (null message-interactive) '("-oem" "-odb")) > - ;; Get the addresses from the message > - ;; unless this is a resend. > - ;; We must not do that for a resend > - ;; because we would find the original addresses. > - ;; For a resend, include the specific addresses. > - (if resend-to-addresses > - (list resend-to-addresses) > - '("-t")))))) > - (unless (or (null cpr) (and (numberp cpr) (zerop cpr))) > - (when errbuf > - (pop-to-buffer errbuf) > - (setq errbuf nil)) > - (error "Sending...failed with exit value %d" cpr))) > - (when message-interactive > - (with-current-buffer errbuf > - (goto-char (point-min)) > - (while (re-search-forward "\n+ *" nil t) > - (replace-match "; ")) > - (if (not (zerop (buffer-size))) > - (error "Sending...failed to %s" > - (buffer-string)))))) > + (progn > + (let ((case-fold-search t)) > + (save-restriction > + (message-narrow-to-headers) > + (setq resend-to-addresses (message-fetch-field "resent-to"))) > + ;; Change header-delimiter to be what sendmail expects. > + (goto-char (point-min)) > + (re-search-forward > + (concat "^" (regexp-quote mail-header-separator) "\n")) > + (replace-match "\n") > + (backward-char 1) > + (setq delimline (point-marker)) > + (run-hooks 'message-send-mail-hook) > + ;; Insert an extra newline if we need it to work around > + ;; Sun's bug that swallows newlines. > + (goto-char (1+ delimline)) > + (when (eval message-mailer-swallows-blank-line) > + (newline)) > + (when message-interactive > + (with-current-buffer errbuf > + (erase-buffer)))) > + (let* ((default-directory "/") > + (coding-system-for-write message-send-coding-system) > + (cpr (apply > + 'call-process-region > + (append > + (list (point-min) (point-max) sendmail-program > + nil errbuf nil "-oi") > + message-sendmail-extra-arguments > + ;; Always specify who from, > + ;; since some systems have broken sendmails. > + ;; But some systems are more broken with -f, so > + ;; we'll let users override this. > + (and (null message-sendmail-f-is-evil) > + (list "-f" (message-sendmail-envelope-from))) > + ;; These mean "report errors by mail" > + ;; and "deliver in background". > + (if (null message-interactive) '("-oem" "-odb")) > + ;; Get the addresses from the message > + ;; unless this is a resend. > + ;; We must not do that for a resend > + ;; because we would find the original addresses. > + ;; For a resend, include the specific addresses. > + (if resend-to-addresses > + (list resend-to-addresses) > + '("-t")))))) > + (unless (or (null cpr) (and (numberp cpr) (zerop cpr))) > + (when errbuf > + (pop-to-buffer errbuf) > + (setq errbuf nil)) > + (error "Sending...failed with exit value %d" cpr))) > + (when message-interactive > + (with-current-buffer errbuf > + (goto-char (point-min)) > + (while (re-search-forward "\n+ *" nil t) > + (replace-match "; ")) > + (if (not (zerop (buffer-size))) > + (error "Sending...failed to %s" > + (buffer-string)))))) > (when (bufferp errbuf) > - (kill-buffer errbuf))))) > + (kill-buffer errbuf))))) > > (defun message-send-mail-with-qmail () > "Pass the prepared message buffer to qmail-inject. > @@ -4785,29 +4785,29 @@ to find out how to use this." > ;; send the message > (pcase > (let ((coding-system-for-write > message-send-coding-system)) > - (apply > - 'call-process-region (point-min) (point-max) > - message-qmail-inject-program nil nil nil > - ;; qmail-inject's default behavior 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 its kin. > - ;; > - ;; in general, ALL of qmail-inject's defaults are perfect for > ;; simply > - ;; reading a formatted (i. e., at least a To: or Resent-To > ;; header) > - ;; message from stdin. > - ;; > - ;; qmail also has the advantage of not having been raped by > - ;; various vendors, so we don't have to allow for that, either > ;; -- > - ;; compare this with message-send-mail-with-sendmail and weep > - ;; for sendmail's lost innocence. > - ;; > - ;; all this is way cool coz it lets us keep the arguments > ;; entirely > - ;; free for -inject-arguments -- a big win for the user and > ;; for us > - ;; since we don't have to play that double-guessing game and > ;; the user > - ;; gets full control (no gestapo'ish -f's, for instance). --sj > - (if (functionp message-qmail-inject-args) > - (funcall message-qmail-inject-args) > - message-qmail-inject-args))) > + (apply > + 'call-process-region (point-min) (point-max) > + message-qmail-inject-program nil nil nil > + ;; qmail-inject's default behavior 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 its kin. > + ;; > + ;; in general, ALL of qmail-inject's defaults are perfect for > ;; simply > + ;; reading a formatted (i. e., at least a To: or Resent-To > ;; header) > + ;; message from stdin. > + ;; > + ;; qmail also has the advantage of not having been raped by > + ;; various vendors, so we don't have to allow for that, either > ;; -- > + ;; compare this with message-send-mail-with-sendmail and weep > + ;; for sendmail's lost innocence. > + ;; > + ;; all this is way cool coz it lets us keep the arguments > ;; entirely > + ;; free for -inject-arguments -- a big win for the user and > ;; for us > + ;; since we don't have to play that double-guessing game and > ;; the user > + ;; gets full control (no gestapo'ish -f's, for instance). --sj > + (if (functionp message-qmail-inject-args) > + (funcall message-qmail-inject-args) > + message-qmail-inject-args))) > ;; qmail-inject doesn't say anything on its stdout/stderr, > ;; we have to look at the retval instead > (0 nil) > @@ -4821,17 +4821,17 @@ to find out how to use this." > (defun message-send-mail-with-mh () > "Send the prepared message buffer with mh." > (let ((mh-previous-window-config nil) > - (name (mh-new-draft-name))) > + (name (mh-new-draft-name))) > (setq buffer-file-name name) > ;; MH wants to generate these headers itself. > (when message-mh-deletable-headers > (let ((headers message-mh-deletable-headers)) > - (while headers > - (goto-char (point-min)) > - (and (re-search-forward > - (concat "^" (symbol-name (car headers)) ": *") nil t) > - (message-delete-line)) > - (pop headers)))) > + (while headers > + (goto-char (point-min)) > + (and (re-search-forward > + (concat "^" (symbol-name (car headers)) ": *") nil t) > + (message-delete-line)) > + (pop headers)))) > (run-hooks 'message-send-mail-hook) > ;; Pass it on to mh. > (mh-send-letter))) > @@ -4846,7 +4846,7 @@ authentication. See the Gnus manual for > details." > ;; Change header-delimiter to be what smtpmail expects. > (goto-char (point-min)) > (when (re-search-forward > - (concat "^" (regexp-quote mail-header-separator) "\n")) > + (concat "^" (regexp-quote mail-header-separator) "\n")) > (replace-match "\n")) > (smtpmail-send-it)) > > @@ -4890,104 +4890,104 @@ Otherwise, generate and save a value > for `canlock-password' first." > (defun message-send-news (&optional arg) > (require 'gnus-msg) > (let* ((tembuf (message-generate-new-buffer-clone-locals " > *message temp*")) > - (case-fold-search nil) > - (method (if (functionp message-post-method) > - (funcall message-post-method arg) > - message-post-method)) > - (newsgroups-field (save-restriction > - (message-narrow-to-headers-or-head) > - (message-fetch-field "Newsgroups"))) > - (followup-field (save-restriction > - (message-narrow-to-headers-or-head) > - (message-fetch-field "Followup-To"))) > - ;; BUG: We really need to get the charset for each name in the > - ;; Newsgroups and Followup-To lines to allow crossposting > - ;; between group names with incompatible character sets. > - ;; -- Per Abrahamsen 2001-10-08. > - (group-field-charset > - (gnus-group-name-charset method newsgroups-field)) > - (followup-field-charset > - (gnus-group-name-charset method (or followup-field ""))) > - (rfc2047-header-encoding-alist > - (append (when group-field-charset > - (list (cons "Newsgroups" group-field-charset))) > - (when followup-field-charset > - (list (cons "Followup-To" followup-field-charset))) > - rfc2047-header-encoding-alist)) > - (messbuf (current-buffer)) > - (message-syntax-checks > - (if (and arg > - (listp message-syntax-checks)) > - (cons '(existing-newsgroups . disabled) > - message-syntax-checks) > - message-syntax-checks)) > - (message-this-is-news t) > - (message-posting-charset > - (gnus-setup-posting-charset newsgroups-field)) > - result) > + (case-fold-search nil) > + (method (if (functionp message-post-method) > + (funcall message-post-method arg) > + message-post-method)) > + (newsgroups-field (save-restriction > + (message-narrow-to-headers-or-head) > + (message-fetch-field "Newsgroups"))) > + (followup-field (save-restriction > + (message-narrow-to-headers-or-head) > + (message-fetch-field "Followup-To"))) > + ;; BUG: We really need to get the charset for each name in the > + ;; Newsgroups and Followup-To lines to allow crossposting > + ;; between group names with incompatible character sets. > + ;; -- Per Abrahamsen 2001-10-08. > + (group-field-charset > + (gnus-group-name-charset method newsgroups-field)) > + (followup-field-charset > + (gnus-group-name-charset method (or followup-field ""))) > + (rfc2047-header-encoding-alist > + (append (when group-field-charset > + (list (cons "Newsgroups" group-field-charset))) > + (when followup-field-charset > + (list (cons "Followup-To" followup-field-charset))) > + rfc2047-header-encoding-alist)) > + (messbuf (current-buffer)) > + (message-syntax-checks > + (if (and arg > + (listp message-syntax-checks)) > + (cons '(existing-newsgroups . disabled) > + message-syntax-checks) > + message-syntax-checks)) > + (message-this-is-news t) > + (message-posting-charset > + (gnus-setup-posting-charset newsgroups-field)) > + result) > (if (not (message-check-news-body-syntax)) > - nil > + nil > (save-restriction > - (message-narrow-to-headers) > - ;; Insert some headers. > - (message-generate-headers message-required-news-headers) > - (message-insert-canlock) > - ;; Let the user do all of the above. > - (run-hooks 'message-header-hook)) > + (message-narrow-to-headers) > + ;; Insert some headers. > + (message-generate-headers message-required-news-headers) > + (message-insert-canlock) > + ;; Let the user do all of the above. > + (run-hooks 'message-header-hook)) > ;; Note: This check will be disabled by the ".*" default > ;; value for > ;; gnus-group-name-charset-group-alist. -- Pa 2001-10-07. > (when (and group-field-charset > - (listp message-syntax-checks)) > - (setq message-syntax-checks > - (cons '(valid-newsgroups . disabled) > - message-syntax-checks))) > + (listp message-syntax-checks)) > + (setq message-syntax-checks > + (cons '(valid-newsgroups . disabled) > + message-syntax-checks))) > (message-cleanup-headers) > (if (not (let ((message-post-method method)) > - (message-check-news-syntax))) > - nil > - (unwind-protect > - (with-current-buffer tembuf > - (buffer-disable-undo) > - (erase-buffer) > - ;; Avoid copying text props (except hard newlines). > - (insert > - (with-current-buffer messbuf > - (mml-buffer-substring-no-properties-except-some > - (point-min) (point-max)))) > - (message-encode-message-body) > - ;; Remove some headers. > - (save-restriction > - (message-narrow-to-headers) > - ;; We (re)generate the Lines header. > - (when (memq 'Lines message-required-mail-headers) > - (message-generate-headers '(Lines))) > - ;; Remove some headers. > - (message-remove-header message-ignored-news-headers t) > - (let ((mail-parse-charset message-default-charset)) > - (mail-encode-encoded-word-buffer))) > - (goto-char (point-max)) > - ;; require one newline at the end. > - (or (= (preceding-char) ?\n) > - (insert ?\n)) > - (let ((case-fold-search t)) > - ;; Remove the delimiter. > - (goto-char (point-min)) > - (re-search-forward > - (concat "^" (regexp-quote mail-header-separator) "\n")) > - (replace-match "\n") > - (backward-char 1)) > - (run-hooks 'message-send-news-hook) > - (gnus-open-server method) > - (message "Sending news via %s..." (gnus-server-string method)) > - (setq result (let ((mail-header-separator "")) > - (gnus-request-post method)))) > - (kill-buffer tembuf)) > - (set-buffer messbuf) > - (if result > - (push 'news message-sent-message-via) > - (message "Couldn't send message via news: %s" > - (nnheader-get-report (car method))) > - nil))))) > + (message-check-news-syntax))) > + nil > + (unwind-protect > + (with-current-buffer tembuf > + (buffer-disable-undo) > + (erase-buffer) > + ;; Avoid copying text props (except hard newlines). > + (insert > + (with-current-buffer messbuf > + (mml-buffer-substring-no-properties-except-some > + (point-min) (point-max)))) > + (message-encode-message-body) > + ;; Remove some headers. > + (save-restriction > + (message-narrow-to-headers) > + ;; We (re)generate the Lines header. > + (when (memq 'Lines message-required-mail-headers) > + (message-generate-headers '(Lines))) > + ;; Remove some headers. > + (message-remove-header message-ignored-news-headers t) > + (let ((mail-parse-charset message-default-charset)) > + (mail-encode-encoded-word-buffer))) > + (goto-char (point-max)) > + ;; require one newline at the end. > + (or (= (preceding-char) ?\n) > + (insert ?\n)) > + (let ((case-fold-search t)) > + ;; Remove the delimiter. > + (goto-char (point-min)) > + (re-search-forward > + (concat "^" (regexp-quote mail-header-separator) "\n")) > + (replace-match "\n") > + (backward-char 1)) > + (run-hooks 'message-send-news-hook) > + (gnus-open-server method) > + (message "Sending news via %s..." (gnus-server-string method)) > + (setq result (let ((mail-header-separator "")) > + (gnus-request-post method)))) > + (kill-buffer tembuf)) > + (set-buffer messbuf) > + (if result > + (push 'news message-sent-message-via) > + (message "Couldn't send message via news: %s" > + (nnheader-get-report (car method))) > + nil))))) > > ;;; > ;;; Header generation & syntax checking. > @@ -4999,7 +4999,7 @@ Otherwise, generate and save a value for > `canlock-password' first." > t > (let ((able (assq type message-syntax-checks))) > (and (consp able) > - (eq (cdr able) 'disabled))))) > + (eq (cdr able) 'disabled))))) > > (defun message-check-news-syntax () > "Check the syntax of the message." > @@ -5008,9 +5008,9 @@ Otherwise, generate and save a value for > `canlock-password' first." > (widen) > ;; We narrow to the headers and check them first. > (save-excursion > - (save-restriction > - (message-narrow-to-headers) > - (message-check-news-header-syntax)))))) > + (save-restriction > + (message-narrow-to-headers) > + (message-check-news-header-syntax)))))) > > (defun message-check-news-header-syntax () > (and > @@ -5018,287 +5018,287 @@ Otherwise, generate and save a value > for `canlock-password' first." > (message-check 'newsgroups > (let ((group (message-fetch-field "newsgroups"))) > (or > - (and group > - (not (string-match "\\`[ \t]*\\'" group))) > - (ignore > - (message > - "The newsgroups field is empty or missing. Posting is > denied."))))) > + (and group > + (not (string-match "\\`[ \t]*\\'" group))) > + (ignore > + (message > + "The newsgroups field is empty or missing. Posting is > denied."))))) > ;; Check the Subject header. > (message-check 'subject > (let* ((case-fold-search t) > - (subject (message-fetch-field "subject"))) > + (subject (message-fetch-field "subject"))) > (or > - (and subject > - (not (string-match "\\`[ \t]*\\'" subject))) > - (ignore > - (message > - "The subject field is empty or missing. Posting is > denied."))))) > + (and subject > + (not (string-match "\\`[ \t]*\\'" subject))) > + (ignore > + (message > + "The subject field is empty or missing. Posting is > denied."))))) > ;; Check for commands in Subject. > (message-check 'subject-cmsg > (if (string-match "^cmsg " (message-fetch-field > "subject")) > - (y-or-n-p > - "The control code \"cmsg\" is in the subject. Really post? ") > + (y-or-n-p > + "The control code \"cmsg\" is in the subject. Really post? ") > t)) > ;; Check long header lines. > (message-check 'long-header-lines > (let ((header nil) > - (length 0) > - found) > + (length 0) > + found) > (while (and (not found) > - (re-search-forward "^\\([^ \t:]+\\): " nil t)) > - (if (> (- (point) (match-beginning 0)) 998) > - (setq found t > - length (- (point) (match-beginning 0))) > - (setq header (match-string-no-properties 1))) > - (forward-line 1)) > + (re-search-forward "^\\([^ \t:]+\\): " nil t)) > + (if (> (- (point) (match-beginning 0)) 998) > + (setq found t > + length (- (point) (match-beginning 0))) > + (setq header (match-string-no-properties 1))) > + (forward-line 1)) > (if found > - (y-or-n-p (format "Your %s header is too long (%d). Really > post? " > - header length)) > - t))) > + (y-or-n-p (format "Your %s header is too long (%d). Really > post? " > + header length)) > + t))) > ;; Check for multiple identical headers. > (message-check 'multiple-headers > (let (found) > (while (and (not found) > - (re-search-forward "^[^ \t:]+: " nil t)) > - (save-excursion > - (or (re-search-forward > - (concat "^" > - (regexp-quote > - (setq found > - (buffer-substring > - (match-beginning 0) (- (match-end 0) 2)))) > - ":") > - nil t) > - (setq found nil)))) > + (re-search-forward "^[^ \t:]+: " nil t)) > + (save-excursion > + (or (re-search-forward > + (concat "^" > + (regexp-quote > + (setq found > + (buffer-substring > + (match-beginning 0) (- (match-end 0) 2)))) > + ":") > + nil t) > + (setq found nil)))) > (if found > - (y-or-n-p (format "Multiple %s headers. Really post? " found)) > - t))) > + (y-or-n-p (format "Multiple %s headers. Really post? " found)) > + t))) > ;; Check for Version and Sendsys. > (message-check 'sendsys > (if (re-search-forward "^Sendsys:\\|^Version:" nil t) > - (y-or-n-p > - (format "The article contains a %s command. Really post? " > - (buffer-substring (match-beginning 0) > - (1- (match-end 0))))) > + (y-or-n-p > + (format "The article contains a %s command. Really post? " > + (buffer-substring (match-beginning 0) > + (1- (match-end 0))))) > t)) > ;; See whether we can shorten Followup-To. > (message-check 'shorten-followup-to > (let ((newsgroups (message-fetch-field "newsgroups")) > - (followup-to (message-fetch-field "followup-to")) > - to) > + (followup-to (message-fetch-field "followup-to")) > + to) > (when (and newsgroups > - (string-match "," newsgroups) > - (not followup-to) > - (not > - (zerop > - (length > - (setq to (completing-read > - "Followups to (default no Followup-To header): " > - (mapcar #'list > - (cons "poster" > - (message-tokenize-header > - newsgroups))))))))) > - (goto-char (point-min)) > - (insert "Followup-To: " to "\n")) > + (string-match "," newsgroups) > + (not followup-to) > + (not > + (zerop > + (length > + (setq to (completing-read > + "Followups to (default no Followup-To header): " > + (mapcar #'list > + (cons "poster" > + (message-tokenize-header > + newsgroups))))))))) > + (goto-char (point-min)) > + (insert "Followup-To: " to "\n")) > t)) > ;; Check "Shoot me". > (message-check 'shoot > (if (re-search-forward > - "Message-ID.*.i-did-not-set--mail-host-address--so-tickle-me" > nil t) > - (y-or-n-p "You appear to have a misconfigured system. Really > post? ") > + "Message-ID.*.i-did-not-set--mail-host-address--so-tickle-me" > nil t) > + (y-or-n-p "You appear to have a misconfigured system. Really > post? ") > t)) > ;; Check for Approved. > (message-check 'approved > (if (re-search-forward "^Approved:" nil t) > - (y-or-n-p "The article contains an Approved header. Really > post? ") > + (y-or-n-p "The article contains an Approved header. Really > post? ") > t)) > ;; Check the Message-ID header. > (message-check 'message-id > (let* ((case-fold-search t) > - (message-id (message-fetch-field "message-id" t))) > + (message-id (message-fetch-field "message-id" t))) > (or (not message-id) > - ;; Is there an @ in the ID? > - (and (string-match "@" message-id) > - ;; Is there a dot in the ID? > - (string-match "@[^.]*\\." message-id) > - ;; Does the ID end with a dot? > - (not (string-match "\\.>" message-id))) > - (y-or-n-p > - (format "The Message-ID looks strange: \"%s\". Really post? " > - message-id))))) > + ;; Is there an @ in the ID? > + (and (string-match "@" message-id) > + ;; Is there a dot in the ID? > + (string-match "@[^.]*\\." message-id) > + ;; Does the ID end with a dot? > + (not (string-match "\\.>" message-id))) > + (y-or-n-p > + (format "The Message-ID looks strange: \"%s\". Really post? " > + message-id))))) > ;; Check the Newsgroups & Followup-To headers. > (message-check 'existing-newsgroups > (let* ((case-fold-search t) > - (newsgroups (message-fetch-field "newsgroups")) > - (followup-to (message-fetch-field "followup-to")) > - (groups (message-tokenize-header > - (if followup-to > - (concat newsgroups "," followup-to) > - newsgroups))) > - (post-method (if (functionp message-post-method) > - (funcall message-post-method) > - message-post-method)) > - ;; KLUDGE to handle nnvirtual groups. Doing this right > - ;; would probably involve a new nnoo function. > - ;; -- Per Abrahamsen , 2001-10-17. > - (method (if (and (consp post-method) > - (eq (car post-method) 'nnvirtual) > - gnus-message-group-art) > - (let ((group (car (nnvirtual-find-group-art > - (car gnus-message-group-art) > - (cdr gnus-message-group-art))))) > - (gnus-find-method-for-group group)) > - post-method)) > - (known-groups > - (mapcar (lambda (n) > - (gnus-group-name-decode > - (gnus-group-real-name n) > - (gnus-group-name-charset method n))) > - (gnus-groups-from-server method))) > - errors) > + (newsgroups (message-fetch-field "newsgroups")) > + (followup-to (message-fetch-field "followup-to")) > + (groups (message-tokenize-header > + (if followup-to > + (concat newsgroups "," followup-to) > + newsgroups))) > + (post-method (if (functionp message-post-method) > + (funcall message-post-method) > + message-post-method)) > + ;; KLUDGE to handle nnvirtual groups. Doing this right > + ;; would probably involve a new nnoo function. > + ;; -- Per Abrahamsen , 2001-10-17. > + (method (if (and (consp post-method) > + (eq (car post-method) 'nnvirtual) > + gnus-message-group-art) > + (let ((group (car (nnvirtual-find-group-art > + (car gnus-message-group-art) > + (cdr gnus-message-group-art))))) > + (gnus-find-method-for-group group)) > + post-method)) > + (known-groups > + (mapcar (lambda (n) > + (gnus-group-name-decode > + (gnus-group-real-name n) > + (gnus-group-name-charset method n))) > + (gnus-groups-from-server method))) > + errors) > (while groups > - (when (and (not (equal (car groups) "poster")) > - (not (member (car groups) known-groups)) > - (not (member (car groups) errors))) > - (push (car groups) errors)) > - (pop groups)) > + (when (and (not (equal (car groups) "poster")) > + (not (member (car groups) known-groups)) > + (not (member (car groups) errors))) > + (push (car groups) errors)) > + (pop groups)) > (cond > - ;; Gnus is not running. > - ((or (not (and (boundp 'gnus-active-hashtb) > - gnus-active-hashtb)) > - (not (boundp 'gnus-read-active-file))) > - t) > - ;; We don't have all the group names. > - ((and (or (not gnus-read-active-file) > - (eq gnus-read-active-file 'some)) > - errors) > - (y-or-n-p > - (format > - "Really use %s possibly unknown group%s: %s? " > - (if (= (length errors) 1) "this" "these") > - (if (= (length errors) 1) "" "s") > - (mapconcat 'identity errors ", ")))) > - ;; There were no errors. > - ((not errors) > - t) > - ;; There are unknown groups. > - (t > - (y-or-n-p > - (format > - "Really post to %s unknown group%s: %s? " > - (if (= (length errors) 1) "this" "these") > - (if (= (length errors) 1) "" "s") > - (mapconcat 'identity errors ", "))))))) > + ;; Gnus is not running. > + ((or (not (and (boundp 'gnus-active-hashtb) > + gnus-active-hashtb)) > + (not (boundp 'gnus-read-active-file))) > + t) > + ;; We don't have all the group names. > + ((and (or (not gnus-read-active-file) > + (eq gnus-read-active-file 'some)) > + errors) > + (y-or-n-p > + (format > + "Really use %s possibly unknown group%s: %s? " > + (if (= (length errors) 1) "this" "these") > + (if (= (length errors) 1) "" "s") > + (mapconcat 'identity errors ", ")))) > + ;; There were no errors. > + ((not errors) > + t) > + ;; There are unknown groups. > + (t > + (y-or-n-p > + (format > + "Really post to %s unknown group%s: %s? " > + (if (= (length errors) 1) "this" "these") > + (if (= (length errors) 1) "" "s") > + (mapconcat 'identity errors ", "))))))) > ;; Check continuation headers. > (message-check 'continuation-headers > (goto-char (point-min)) > (let ((do-posting t)) > (while (re-search-forward "^[^ \t\n][^ \t\n:]*[ \t\n]" > nil t) > - (goto-char (match-beginning 0)) > - (if (y-or-n-p "Fix continuation lines? ") > - (insert " ") > - (forward-line 1) > - (unless (y-or-n-p "Send anyway? ") > - (setq do-posting nil)))) > + (goto-char (match-beginning 0)) > + (if (y-or-n-p "Fix continuation lines? ") > + (insert " ") > + (forward-line 1) > + (unless (y-or-n-p "Send anyway? ") > + (setq do-posting nil)))) > do-posting)) > ;; Check the Newsgroups & Followup-To headers for syntax > ;; errors. > (message-check 'valid-newsgroups > (let ((case-fold-search t) > - (headers '("Newsgroups" "Followup-To")) > - header error) > + (headers '("Newsgroups" "Followup-To")) > + header error) > (while (and headers (not error)) > - (when (setq header (mail-fetch-field (car headers))) > - (if (or > - (not > - (string-match > - "\\`\\([-+_&.a-zA-Z0-9]+\\)?\\(,[-+_&.a-zA-Z0-9]+\\)*\\'" > - header)) > - (memq > - nil (mapcar > - (lambda (g) > - (not (string-match "\\.\\'\\|\\.\\." g))) > - (message-tokenize-header header ",")))) > - (setq error t))) > - (unless error > - (pop headers))) > + (when (setq header (mail-fetch-field (car headers))) > + (if (or > + (not > + (string-match > + "\\`\\([-+_&.a-zA-Z0-9]+\\)?\\(,[-+_&.a-zA-Z0-9]+\\)*\\'" > + header)) > + (memq > + nil (mapcar > + (lambda (g) > + (not (string-match "\\.\\'\\|\\.\\." g))) > + (message-tokenize-header header ",")))) > + (setq error t))) > + (unless error > + (pop headers))) > (if (not error) > - t > - (y-or-n-p > - (format "The %s header looks odd: \"%s\". Really post? " > - (car headers) header))))) > + t > + (y-or-n-p > + (format "The %s header looks odd: \"%s\". Really post? " > + (car headers) header))))) > (message-check 'repeated-newsgroups > (let ((case-fold-search t) > - (headers '("Newsgroups" "Followup-To")) > - header error groups group) > + (headers '("Newsgroups" "Followup-To")) > + header error groups group) > (while (and headers > - (not error)) > - (when (setq header (mail-fetch-field (pop headers))) > - (setq groups (message-tokenize-header header ",")) > - (while (setq group (pop groups)) > - (when (member group groups) > - (setq error group > - groups nil))))) > + (not error)) > + (when (setq header (mail-fetch-field (pop headers))) > + (setq groups (message-tokenize-header header ",")) > + (while (setq group (pop groups)) > + (when (member group groups) > + (setq error group > + groups nil))))) > (if (not error) > - t > - (y-or-n-p > - (format "Group %s is repeated in headers. Really post? " > error))))) > + t > + (y-or-n-p > + (format "Group %s is repeated in headers. Really post? " > error))))) > ;; Check the From header. > (message-check 'from > (let* ((case-fold-search t) > - (from (message-fetch-field "from")) > - ad) > + (from (message-fetch-field "from")) > + ad) > (cond > - ((not from) > - (message "There is no From line. Posting is denied.") > - nil) > - ((or (not (string-match > - "@[^\\.]*\\." > - (setq ad (nth 1 (mail-extract-address-components > - from))))) ;larsi@ifi > - (string-match "\\.\\." ad) ;larsi@ifi..uio > - (string-match "@\\." ad) ;larsi@.ifi.uio > - (string-match "\\.$" ad) ;larsi@ifi.uio. > - (not (string-match "^[^@]+@[^@]+$" ad)) ;larsi.ifi.uio > - (string-match "(.*).*(.*)" from)) ;(lars) (lars) > - (message > - "Denied posting -- the From looks strange: \"%s\"." from) > - nil) > - ((let ((addresses (rfc822-addresses from))) > - ;; `rfc822-addresses' returns a string if parsing fails. > - (while (and (consp addresses) > - (not (eq (string-to-char (car addresses)) ?\())) > - (setq addresses (cdr addresses))) > - addresses) > - (message > - "Denied posting -- bad From address: \"%s\"." from) > - nil) > - (t t)))) > + ((not from) > + (message "There is no From line. Posting is denied.") > + nil) > + ((or (not (string-match > + "@[^\\.]*\\." > + (setq ad (nth 1 (mail-extract-address-components > + from))))) ;larsi@ifi > + (string-match "\\.\\." ad) ;larsi@ifi..uio > + (string-match "@\\." ad) ;larsi@.ifi.uio > + (string-match "\\.$" ad) ;larsi@ifi.uio. > + (not (string-match "^[^@]+@[^@]+$" ad)) ;larsi.ifi.uio > + (string-match "(.*).*(.*)" from)) ;(lars) (lars) > + (message > + "Denied posting -- the From looks strange: \"%s\"." from) > + nil) > + ((let ((addresses (rfc822-addresses from))) > + ;; `rfc822-addresses' returns a string if parsing fails. > + (while (and (consp addresses) > + (not (eq (string-to-char (car addresses)) ?\())) > + (setq addresses (cdr addresses))) > + addresses) > + (message > + "Denied posting -- bad From address: \"%s\"." from) > + nil) > + (t t)))) > ;; Check the Reply-To header. > (message-check 'reply-to > (let* ((case-fold-search t) > - (reply-to (message-fetch-field "reply-to")) > - ad) > + (reply-to (message-fetch-field "reply-to")) > + ad) > (cond > - ((not reply-to) > - t) > - ((string-match "," reply-to) > - (y-or-n-p > - (format "Multiple Reply-To addresses: \"%s\". Really post? " > - reply-to))) > - ((or (not (string-match > - "@[^\\.]*\\." > - (setq ad (nth 1 (mail-extract-address-components > - reply-to))))) ;larsi@ifi > - (string-match "\\.\\." ad) ;larsi@ifi..uio > - (string-match "@\\." ad) ;larsi@.ifi.uio > - (string-match "\\.$" ad) ;larsi@ifi.uio. > - (not (string-match "^[^@]+@[^@]+$" ad)) ;larsi.ifi.uio > - (string-match "(.*).*(.*)" reply-to)) ;(lars) (lars) > - (y-or-n-p > - (format > - "The Reply-To looks strange: \"%s\". Really post? " > - reply-to))) > - (t t)))))) > + ((not reply-to) > + t) > + ((string-match "," reply-to) > + (y-or-n-p > + (format "Multiple Reply-To addresses: \"%s\". Really post? " > + reply-to))) > + ((or (not (string-match > + "@[^\\.]*\\." > + (setq ad (nth 1 (mail-extract-address-components > + reply-to))))) ;larsi@ifi > + (string-match "\\.\\." ad) ;larsi@ifi..uio > + (string-match "@\\." ad) ;larsi@.ifi.uio > + (string-match "\\.$" ad) ;larsi@ifi.uio. > + (not (string-match "^[^@]+@[^@]+$" ad)) ;larsi.ifi.uio > + (string-match "(.*).*(.*)" reply-to)) ;(lars) (lars) > + (y-or-n-p > + (format > + "The Reply-To looks strange: \"%s\". Really post? " > + reply-to))) > + (t t)))))) > > (defun message-check-news-body-syntax () > (and > @@ -5309,16 +5309,16 @@ Otherwise, generate and save a value for > `canlock-password' first." > (concat "^" (regexp-quote mail-header-separator) "$")) > (forward-line 1) > (while (and > - (or (looking-at > - "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)") > - (let ((p (point))) > - (end-of-line) > - (< (- (point) p) 80))) > - (zerop (forward-line 1)))) > + (or (looking-at > + "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)") > + (let ((p (point))) > + (end-of-line) > + (< (- (point) p) 80))) > + (zerop (forward-line 1)))) > (or (bolp) > - (eobp) > - (y-or-n-p > - "You have lines longer than 79 characters. Really post? "))) > + (eobp) > + (y-or-n-p > + "You have lines longer than 79 characters. Really post? "))) > ;; Check whether the article is empty. > (message-check 'empty > (goto-char (point-min)) > @@ -5330,26 +5330,26 @@ Otherwise, generate and save a value for > `canlock-password' first." > (re-search-backward message-signature-separator nil t) > (beginning-of-line) > (or (re-search-backward "[^ \n\t]" b t) > - (if (message-gnksa-enable-p 'empty-article) > - (y-or-n-p "Empty article. Really post? ") > - (message "Denied posting -- Empty article.") > - nil)))) > + (if (message-gnksa-enable-p 'empty-article) > + (y-or-n-p "Empty article. Really post? ") > + (message "Denied posting -- Empty article.") > + nil)))) > ;; Check for control characters. > (message-check 'control-chars > (if (re-search-forward > - (eval-when-compile > + (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? ") > + nil t) > + (y-or-n-p > + "The article contains control characters. Really post? ") > t)) > ;; Check excessive size. > (message-check 'size > (if (> (buffer-size) 60000) > - (y-or-n-p > - (format "The article is %d octets long. Really post? " > - (buffer-size))) > + (y-or-n-p > + (format "The article is %d octets long. Really post? " > + (buffer-size))) > t)) > ;; Check whether any new text has been added. > (message-check 'new-text > @@ -5357,48 +5357,48 @@ Otherwise, generate and save a value for > `canlock-password' first." > (not message-checksum) > (not (eq (message-checksum) message-checksum)) > (if (message-gnksa-enable-p 'quoted-text-only) > - (y-or-n-p > - "It looks like no new text has been added. Really post? ") > - (message "Denied posting -- no new text has been added.") > - nil))) > + (y-or-n-p > + "It looks like no new text has been added. Really post? ") > + (message "Denied posting -- no new text has been added.") > + nil))) > ;; Check the length of the signature. > (message-check 'signature > (let (sig-start sig-end) > (goto-char (point-max)) > (if (not (re-search-backward message-signature-separator > nil t)) > - t > - (setq sig-start (1+ (point-at-eol))) > - (setq sig-end > - (if (re-search-forward > - "<#/?\\(multipart\\|part\\|external\\|mml\\)" nil t) > - (- (point-at-bol) 1) > - (point-max))) > - (if (>= (count-lines sig-start sig-end) 5) > - (if (message-gnksa-enable-p 'signature) > - (y-or-n-p > - (format "Signature is excessively long (%d lines). Really > post? " > - (count-lines sig-start sig-end))) > - (message "Denied posting -- Excessive signature.") > - nil) > - t)))) > + t > + (setq sig-start (1+ (point-at-eol))) > + (setq sig-end > + (if (re-search-forward > + "<#/?\\(multipart\\|part\\|external\\|mml\\)" nil t) > + (- (point-at-bol) 1) > + (point-max))) > + (if (>= (count-lines sig-start sig-end) 5) > + (if (message-gnksa-enable-p 'signature) > + (y-or-n-p > + (format "Signature is excessively long (%d lines). Really > post? " > + (count-lines sig-start sig-end))) > + (message "Denied posting -- Excessive signature.") > + nil) > + t)))) > ;; Ensure that text follows last quoted portion. > (message-check 'quoting-style > (goto-char (point-max)) > (let ((no-problem t)) > (when (search-backward-regexp "^>[^\n]*\n" nil t) > - (setq no-problem (search-forward-regexp "^[ \t]*[^>\n]" nil > t))) > + (setq no-problem (search-forward-regexp "^[ \t]*[^>\n]" nil > t))) > (if no-problem > - t > - (if (message-gnksa-enable-p 'quoted-text-only) > - (y-or-n-p "Your text should follow quoted text. Really post? > ") > - ;; Ensure that > - (goto-char (point-min)) > - (re-search-forward > - (concat "^" (regexp-quote mail-header-separator) "$")) > - (if (search-forward-regexp "^[ \t]*[^>\n]" nil t) > - (y-or-n-p "Your text should follow quoted text. Really post? > ") > - (message "Denied posting -- only quoted text.") > - nil))))))) > + t > + (if (message-gnksa-enable-p 'quoted-text-only) > + (y-or-n-p "Your text should follow quoted text. Really post? > ") > + ;; Ensure that > + (goto-char (point-min)) > + (re-search-forward > + (concat "^" (regexp-quote mail-header-separator) "$")) > + (if (search-forward-regexp "^[ \t]*[^>\n]" nil t) > + (y-or-n-p "Your text should follow quoted text. Really post? > ") > + (message "Denied posting -- only quoted text.") > + nil))))))) > > (defun message-checksum () > "Return a \"checksum\" for the current buffer." > @@ -5408,74 +5408,74 @@ Otherwise, generate and save a value for > `canlock-password' first." > (re-search-forward > (concat "^" (regexp-quote mail-header-separator) "$")) > (while (not (eobp)) > - (when (not (looking-at "[ \t\n]")) > - (setq sum (logxor (ash sum 1) (if (natnump sum) 0 1) > - (char-after)))) > - (forward-char 1))) > + (when (not (looking-at "[ \t\n]")) > + (setq sum (logxor (ash sum 1) (if (natnump sum) 0 1) > + (char-after)))) > + (forward-char 1))) > sum)) > > (defun message-do-fcc () > "Process Fcc headers in the current buffer." > (let ((case-fold-search t) > - (buf (current-buffer)) > - (mml-externalize-attachments > message-fcc-externalize-attachments) > - (file (message-field-value "fcc" t)) > - list) > + (buf (current-buffer)) > + (mml-externalize-attachments > message-fcc-externalize-attachments) > + (file (message-field-value "fcc" t)) > + list) > (when file > (with-temp-buffer > - (insert-buffer-substring buf) > - (message-clone-locals buf) > - (message-encode-message-body) > - (save-restriction > - (message-narrow-to-headers) > - (while (setq file (message-fetch-field "fcc" t)) > - (push file list) > - (message-remove-header "fcc" nil t)) > - (let ((mail-parse-charset message-default-charset) > - (rfc2047-header-encoding-alist > - (cons '("Newsgroups" . default) > - rfc2047-header-encoding-alist))) > - (mail-encode-encoded-word-buffer))) > - (goto-char (point-min)) > - (when (re-search-forward > - (concat "^" (regexp-quote mail-header-separator) "$") > - nil t) > - (replace-match "" t t )) > - ;; Process Fcc operations. > - (while list > - (setq file (pop list)) > - (if (string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" file) > - ;; Pipe the article to the program in question. > - (call-shell-region (point-min) (point-max) (match-string 1 > file)) > - ;; Save the article. > - (setq file (expand-file-name file)) > - (unless (file-exists-p (file-name-directory file)) > - (make-directory (file-name-directory file) t)) > - (if (and message-fcc-handler-function > - (not (eq message-fcc-handler-function 'rmail-output))) > - (funcall message-fcc-handler-function file) > - ;; FIXME this option, rmail-output (also used if > - ;; message-fcc-handler-function is nil) is not > - ;; documented anywhere AFAICS. It should work in Emacs > - ;; 23; I suspect it does not work in Emacs 22. > - ;; FIXME I don't see the need for the two different cases > ;; here. > - ;; mail-use-rfc822 makes no difference (in Emacs 23),and > - ;; the third argument just controls \"Wrote file\" message. > - (if (and (file-readable-p file) (mail-file-babyl-p file)) > - (rmail-output file 1 nil t) > - (let ((mail-use-rfc822 t)) > - (rmail-output file 1 t t)))))))))) > + (insert-buffer-substring buf) > + (message-clone-locals buf) > + (message-encode-message-body) > + (save-restriction > + (message-narrow-to-headers) > + (while (setq file (message-fetch-field "fcc" t)) > + (push file list) > + (message-remove-header "fcc" nil t)) > + (let ((mail-parse-charset message-default-charset) > + (rfc2047-header-encoding-alist > + (cons '("Newsgroups" . default) > + rfc2047-header-encoding-alist))) > + (mail-encode-encoded-word-buffer))) > + (goto-char (point-min)) > + (when (re-search-forward > + (concat "^" (regexp-quote mail-header-separator) "$") > + nil t) > + (replace-match "" t t )) > + ;; Process Fcc operations. > + (while list > + (setq file (pop list)) > + (if (string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" file) > + ;; Pipe the article to the program in question. > + (call-shell-region (point-min) (point-max) (match-string 1 > file)) > + ;; Save the article. > + (setq file (expand-file-name file)) > + (unless (file-exists-p (file-name-directory file)) > + (make-directory (file-name-directory file) t)) > + (if (and message-fcc-handler-function > + (not (eq message-fcc-handler-function 'rmail-output))) > + (funcall message-fcc-handler-function file) > + ;; FIXME this option, rmail-output (also used if > + ;; message-fcc-handler-function is nil) is not > + ;; documented anywhere AFAICS. It should work in Emacs > + ;; 23; I suspect it does not work in Emacs 22. > + ;; FIXME I don't see the need for the two different cases > ;; here. > + ;; mail-use-rfc822 makes no difference (in Emacs 23),and > + ;; the third argument just controls \"Wrote file\" message. > + (if (and (file-readable-p file) (mail-file-babyl-p file)) > + (rmail-output file 1 nil t) > + (let ((mail-use-rfc822 t)) > + (rmail-output file 1 t t)))))))))) > > (defun message-output (filename) > "Append this article to Unix/babyl mail file FILENAME." > (if (or (and (file-readable-p filename) > - (mail-file-babyl-p filename)) > - ;; gnus-output-to-mail does the wrong thing with live, mbox > - ;; Rmail buffers in Emacs 23. > - ;; http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=597255 > - (let ((buff (find-buffer-visiting filename))) > - (and buff (with-current-buffer buff > - (eq major-mode 'rmail-mode))))) > + (mail-file-babyl-p filename)) > + ;; gnus-output-to-mail does the wrong thing with live, mbox > + ;; Rmail buffers in Emacs 23. > + ;; http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=597255 > + (let ((buff (find-buffer-visiting filename))) > + (and buff (with-current-buffer buff > + (eq major-mode 'rmail-mode))))) > (gnus-output-to-rmail filename t) > (gnus-output-to-mail filename t))) > > @@ -5494,22 +5494,22 @@ Otherwise, generate and save a value for > `canlock-password' first." > (goto-char (point-min)) > (while (re-search-forward "^\\(Newsgroups\\|Followup-To\\): > +" nil t) > (save-restriction > - (narrow-to-region > - (point) > - (if (re-search-forward "^[^ \t]" nil t) > - (match-beginning 0) > - (forward-line 1) > - (point))) > - (goto-char (point-min)) > - (while (re-search-forward "\n[ \t]+" nil t) > - (replace-match " " t t)) ;No line breaks (too confusing) > - (goto-char (point-min)) > - (while (re-search-forward "[ \t\n]*,[ \t\n]*\\|[ \t]+" nil t) > - (replace-match "," t t)) > - (goto-char (point-min)) > - ;; Remove trailing commas. > - (when (re-search-forward ",+$" nil t) > - (replace-match "" t t)))))) > + (narrow-to-region > + (point) > + (if (re-search-forward "^[^ \t]" nil t) > + (match-beginning 0) > + (forward-line 1) > + (point))) > + (goto-char (point-min)) > + (while (re-search-forward "\n[ \t]+" nil t) > + (replace-match " " t t)) ;No line breaks (too confusing) > + (goto-char (point-min)) > + (while (re-search-forward "[ \t\n]*,[ \t\n]*\\|[ \t]+" nil t) > + (replace-match "," t t)) > + (goto-char (point-min)) > + ;; Remove trailing commas. > + (when (re-search-forward ",+$" nil t) > + (replace-match "" t t)))))) > > (defun message-make-date (&optional now) > "Make a valid data header. > @@ -5529,29 +5529,29 @@ If NOW, use that time instead." > > In posting styles use `(\"Expires\" (make-expires-date 30))'." > (let* ((cur (decode-time)) > - (nday (+ days (nth 3 cur)))) > + (nday (+ days (nth 3 cur)))) > (setf (nth 3 cur) nday) > (message-make-date (apply 'encode-time cur)))) > > (defun message-make-message-id () > "Make a unique Message-ID." > (concat "<" (message-unique-id) > - (let ((psubject (save-excursion (message-fetch-field > "subject"))) > - (psupersedes > - (save-excursion (message-fetch-field "supersedes")))) > - (if (or > - (and message-reply-headers > - (mail-header-references message-reply-headers) > - (mail-header-subject message-reply-headers) > - psubject > - (not (string= > - (message-strip-subject-re > - (mail-header-subject message-reply-headers)) > - (message-strip-subject-re psubject)))) > - (and psupersedes > - (string-match "_-_@" psupersedes))) > - "_-_" "")) > - "@" (message-make-fqdn) ">")) > + (let ((psubject (save-excursion (message-fetch-field > "subject"))) > + (psupersedes > + (save-excursion (message-fetch-field "supersedes")))) > + (if (or > + (and message-reply-headers > + (mail-header-references message-reply-headers) > + (mail-header-subject message-reply-headers) > + psubject > + (not (string= > + (message-strip-subject-re > + (mail-header-subject message-reply-headers)) > + (message-strip-subject-re psubject)))) > + (and psupersedes > + (string-match "_-_@" psupersedes))) > + "_-_" "")) > + "@" (message-make-fqdn) ">")) > > (defvar message-unique-id-char nil) > > @@ -5563,25 +5563,25 @@ In posting styles use `(\"Expires\" > (make-expires-date 30))'." > ;; Don't use microseconds from (current-time), they may be > ;; unsupported. > ;; 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))))) > - ;; (current-time) returns 16-bit ints, > - ;; and 2^16*25 just fits into 4 digits i base 36. > - (* 25 25))) > + (% (1+ (or message-unique-id-char > + (logand (random most-positive-fixnum) (1- (lsh 1 20))))) > + ;; (current-time) returns 16-bit ints, > + ;; and 2^16*25 just fits into 4 digits i base 36. > + (* 25 25))) > (let ((tm (current-time))) > (concat > (if (or (eq system-type 'ms-dos) > - ;; message-number-base36 doesn't handle bigints. > - (floatp (user-uid))) > - (let ((user (downcase (user-login-name)))) > - (while (string-match "[^a-z0-9_]" user) > - (aset user (match-beginning 0) ?_)) > - user) > + ;; message-number-base36 doesn't handle bigints. > + (floatp (user-uid))) > + (let ((user (downcase (user-login-name)))) > + (while (string-match "[^a-z0-9_]" user) > + (aset user (match-beginning 0) ?_)) > + user) > (message-number-base36 (user-uid) -1)) > (message-number-base36 (+ (car tm) > - (lsh (% message-unique-id-char 25) 16)) 4) > + (lsh (% message-unique-id-char 25) 16)) 4) > (message-number-base36 (+ (nth 1 tm) > - (lsh (/ message-unique-id-char 25) 16)) 4) > + (lsh (/ 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. > @@ -5589,33 +5589,33 @@ In posting styles use `(\"Expires\" > (make-expires-date 30))'." > > (defun message-number-base36 (num len) > (if (if (< len 0) > - (<= num 0) > - (= len 0)) > + (<= num 0) > + (= len 0)) > "" > (concat (message-number-base36 (/ num 36) (1- len)) > - (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210" > - (% num 36)))))) > + (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210" > + (% num 36)))))) > > (defun message-make-organization () > "Make an Organization header." > (let* ((organization > - (when message-user-organization > - (if (functionp message-user-organization) > - (funcall message-user-organization) > - message-user-organization)))) > + (when message-user-organization > + (if (functionp message-user-organization) > + (funcall message-user-organization) > + message-user-organization)))) > (with-temp-buffer > (mm-enable-multibyte) > (cond ((stringp organization) > - (insert organization)) > - ((and (eq t organization) > - message-user-organization-file > - (file-exists-p message-user-organization-file)) > - (insert-file-contents message-user-organization-file))) > + (insert organization)) > + ((and (eq t organization) > + message-user-organization-file > + (file-exists-p message-user-organization-file)) > + (insert-file-contents message-user-organization-file))) > (goto-char (point-min)) > (while (re-search-forward "[\t\n]+" nil t) > - (replace-match "" t t)) > + (replace-match "" t t)) > (unless (zerop (buffer-size)) > - (buffer-string))))) > + (buffer-string))))) > > (defun message-make-lines () > "Count the number of lines and return numeric string." > @@ -5629,27 +5629,27 @@ In posting styles use `(\"Expires\" > (make-expires-date 30))'." > "Return the References header for this message." > (when message-reply-headers > (let ((message-id (mail-header-id message-reply-headers)) > - (references (mail-header-references message-reply-headers))) > + (references (mail-header-references message-reply-headers))) > (if (or references message-id) > - (concat (or references "") (and references " ") > - (or message-id "")) > - nil)))) > + (concat (or references "") (and references " ") > + (or message-id "")) > + nil)))) > > (defun message-make-in-reply-to () > "Return the In-Reply-To header for this message." > (when message-reply-headers > (let ((from (mail-header-from message-reply-headers)) > - (date (mail-header-date message-reply-headers)) > - (msg-id (mail-header-id message-reply-headers))) > + (date (mail-header-date message-reply-headers)) > + (msg-id (mail-header-id message-reply-headers))) > (when from > - (let ((name (mail-extract-address-components from))) > - (concat > - msg-id (if msg-id " (") > - (if (car name) > - (if (string-match "[^\000-\177]" (car name)) > - ;; Quote a string containing non-ASCII characters. > - ;; It will make the RFC2047 encoder cause an error > - ;; if there are special characters. > + (let ((name (mail-extract-address-components from))) > + (concat > + msg-id (if msg-id " (") > + (if (car name) > + (if (string-match "[^\000-\177]" (car name)) > + ;; Quote a string containing non-ASCII characters. > + ;; It will make the RFC2047 encoder cause an error > + ;; if there are special characters. > (mm-with-multibyte-buffer > (insert (car name)) > (goto-char (point-min)) > @@ -5662,24 +5662,24 @@ In posting styles use `(\"Expires\" > (make-expires-date 30))'." > (forward-char)) > ;; Those quotes will be removed by the > ;; RFC2047 encoder. > (concat "\"" (buffer-string) "\"")) > - (car name)) > - (nth 1 name)) > - "'s message of \"" > - (if (or (not date) (string= date "")) > - "(unknown date)" date) > - "\"" (if msg-id ")"))))))) > + (car name)) > + (nth 1 name)) > + "'s message of \"" > + (if (or (not date) (string= date "")) > + "(unknown date)" date) > + "\"" (if msg-id ")"))))))) > > (defun message-make-distribution () > "Make a Distribution header." > (let ((orig-distribution (message-fetch-reply-field > "distribution"))) > (cond ((functionp message-distribution-function) > - (funcall message-distribution-function)) > - (t orig-distribution)))) > + (funcall message-distribution-function)) > + (t orig-distribution)))) > > (defun message-make-expires () > "Return an Expires header based on `message-expires'." > (let ((current (current-time)) > - (future (* 1.0 message-expires 60 60 24))) > + (future (* 1.0 message-expires 60 60 24))) > ;; Add the future to current. > (setcar current (+ (car current) (round (/ future (expt 2 > 16))))) > (setcar (cdr current) (+ (nth 1 current) (% (round future) > (expt 2 16)))) > @@ -5689,66 +5689,66 @@ In posting styles use `(\"Expires\" > (make-expires-date 30))'." > "Return uucp path." > (let ((login-name (user-login-name))) > (cond ((null message-user-path) > - (concat (system-name) "!" login-name)) > - ((stringp message-user-path) > - ;; Support GENERICPATH. Suggested by vixie@decwrl.dec.com. > - (concat message-user-path "!" login-name)) > - (t login-name)))) > + (concat (system-name) "!" login-name)) > + ((stringp message-user-path) > + ;; Support GENERICPATH. Suggested by vixie@decwrl.dec.com. > + (concat message-user-path "!" login-name)) > + (t login-name)))) > > (defun message-make-from (&optional name address) > "Make a From header." > (let* ((style message-from-style) > - (login (or address (message-make-address))) > - (fullname (or name user-full-name (user-full-name)))) > + (login (or address (message-make-address))) > + (fullname (or name user-full-name (user-full-name)))) > (when (string= fullname "&") > (setq fullname (user-login-name))) > (with-temp-buffer > (mm-enable-multibyte) > (cond > ((or (null style) > - (equal fullname "")) > - (insert login)) > + (equal fullname "")) > + (insert login)) > ((or (eq style 'angles) > - (and (not (eq style 'parens)) > - ;; Use angles if no quoting is needed, or if parens would > - ;; need quoting too. > - (or (not (string-match "[^- !#-'*+/-9=?A-Z^-~]" fullname)) > - (let ((tmp (concat fullname nil))) > - (while (string-match "([^()]*)" tmp) > - (aset tmp (match-beginning 0) ?-) > - (aset tmp (1- (match-end 0)) ?-)) > - (string-match "[\\()]" tmp))))) > - (insert fullname) > - (goto-char (point-min)) > - ;; Look for a character that cannot appear unquoted > - ;; according to RFC 822. > - (when (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" nil 1) > - ;; Quote fullname, escaping specials. > - (goto-char (point-min)) > - (insert "\"") > - (while (re-search-forward "[\"\\]" nil 1) > - (replace-match "\\\\\\&" t)) > - (insert "\"")) > - (insert " <" login ">")) > + (and (not (eq style 'parens)) > + ;; Use angles if no quoting is needed, or if parens would > + ;; need quoting too. > + (or (not (string-match "[^- !#-'*+/-9=?A-Z^-~]" fullname)) > + (let ((tmp (concat fullname nil))) > + (while (string-match "([^()]*)" tmp) > + (aset tmp (match-beginning 0) ?-) > + (aset tmp (1- (match-end 0)) ?-)) > + (string-match "[\\()]" tmp))))) > + (insert fullname) > + (goto-char (point-min)) > + ;; Look for a character that cannot appear unquoted > + ;; according to RFC 822. > + (when (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" nil 1) > + ;; Quote fullname, escaping specials. > + (goto-char (point-min)) > + (insert "\"") > + (while (re-search-forward "[\"\\]" nil 1) > + (replace-match "\\\\\\&" t)) > + (insert "\"")) > + (insert " <" login ">")) > (t ; 'parens or default > - (insert login " (") > - (let ((fullname-start (point))) > - (insert fullname) > - (goto-char fullname-start) > - ;; RFC 822 says \ and nonmatching parentheses > - ;; must be escaped in comments. > - ;; Escape every instance of ()\ ... > - (while (re-search-forward "[()\\]" nil 1) > - (replace-match "\\\\\\&" t)) > - ;; ... then undo escaping of matching parentheses, > - ;; including matching nested parentheses. > - (goto-char fullname-start) > - (while (re-search-forward > - > "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)" > - nil 1) > - (replace-match "\\1(\\3)" t) > - (goto-char fullname-start))) > - (insert ")"))) > + (insert login " (") > + (let ((fullname-start (point))) > + (insert fullname) > + (goto-char fullname-start) > + ;; RFC 822 says \ and nonmatching parentheses > + ;; must be escaped in comments. > + ;; Escape every instance of ()\ ... > + (while (re-search-forward "[()\\]" nil 1) > + (replace-match "\\\\\\&" t)) > + ;; ... then undo escaping of matching parentheses, > + ;; including matching nested parentheses. > + (goto-char fullname-start) > + (while (re-search-forward > + > "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)" > + nil 1) > + (replace-match "\\1(\\3)" t) > + (goto-char fullname-start))) > + (insert ")"))) > (buffer-string)))) > > (defun message-make-sender () > @@ -5765,55 +5765,55 @@ give as trustworthy answer as possible." > (defun message-user-mail-address () > "Return the pertinent part of `user-mail-address'." > (when (and user-mail-address > - (string-match "@.*\\." user-mail-address)) > + (string-match "@.*\\." user-mail-address)) > (if (string-match " " user-mail-address) > - (nth 1 (mail-extract-address-components user-mail-address)) > + (nth 1 (mail-extract-address-components user-mail-address)) > user-mail-address))) > > (defun message-sendmail-envelope-from () > "Return the envelope from." > (cond ((eq message-sendmail-envelope-from 'header) > - (nth 1 (mail-extract-address-components > - (message-fetch-field "from")))) > - ((stringp message-sendmail-envelope-from) > - message-sendmail-envelope-from) > - (t > - (message-make-address)))) > + (nth 1 (mail-extract-address-components > + (message-fetch-field "from")))) > + ((stringp message-sendmail-envelope-from) > + message-sendmail-envelope-from) > + (t > + (message-make-address)))) > > (defun message-make-fqdn () > "Return user's fully qualified domain name." > (let* ((sysname (system-name)) > - (user-mail (message-user-mail-address)) > - (user-domain > - (if (and user-mail > - (string-match "@\\(.*\\)\\'" user-mail)) > - (match-string 1 user-mail))) > - (case-fold-search t)) > + (user-mail (message-user-mail-address)) > + (user-domain > + (if (and user-mail > + (string-match "@\\(.*\\)\\'" user-mail)) > + (match-string 1 user-mail))) > + (case-fold-search t)) > (cond > ((and message-user-fqdn > - (stringp message-user-fqdn) > - (not (string-match message-bogus-system-names > message-user-fqdn))) > + (stringp message-user-fqdn) > + (not (string-match message-bogus-system-names > message-user-fqdn))) > ;; `message-user-fqdn' seems to be valid > message-user-fqdn) > ;; A system name without any dots is unlikely to be a good > ;; fully > ;; qualified domain name. > ((and (string-match "[.]" sysname) > - (not (string-match message-bogus-system-names sysname))) > + (not (string-match message-bogus-system-names sysname))) > ;; `system-name' returned the right result. > sysname) > ;; Try `mail-host-address'. > ((and (stringp mail-host-address) > - (not (string-match message-bogus-system-names > mail-host-address))) > + (not (string-match message-bogus-system-names > mail-host-address))) > mail-host-address) > ;; We try `user-mail-address' as a backup. > ((and user-domain > - (stringp user-domain) > - (not (string-match message-bogus-system-names user-domain))) > + (stringp user-domain) > + (not (string-match message-bogus-system-names user-domain))) > user-domain) > ;; Default to this bogus thing. > (t > (concat sysname > - ".i-did-not-set--mail-host-address--so-tickle-me"))))) > + ".i-did-not-set--mail-host-address--so-tickle-me"))))) > > (defun message-make-domain () > "Return the domain name." > @@ -5827,53 +5827,53 @@ Remove all addresses but the list > address from To and Cc headers." > (let ((listaddr (message-make-mail-followup-to t))) > (when listaddr > (save-excursion > - (message-remove-header "to") > - (message-remove-header "cc") > - (message-position-on-field "To" "X-Draft-From") > - (insert listaddr))))) > + (message-remove-header "to") > + (message-remove-header "cc") > + (message-position-on-field "To" "X-Draft-From") > + (insert listaddr))))) > > (defun message-make-mail-followup-to (&optional > only-show-subscribed) > "Return the Mail-Followup-To header. > If passed the optional argument ONLY-SHOW-SUBSCRIBED only > return the > subscribed address (and not the additional To and Cc header > contents)." > (let* ((case-fold-search t) > - (to (message-fetch-field "To")) > - (cc (message-fetch-field "cc")) > - (msg-recipients (concat to (and to cc ", ") cc)) > - (recipients > - (mapcar 'mail-strip-quoted-names > - (message-tokenize-header msg-recipients))) > - (file-regexps > - (if message-subscribed-address-file > - (let (begin end item re) > - (save-excursion > - (with-temp-buffer > - (insert-file-contents message-subscribed-address-file) > - (while (not (eobp)) > - (setq begin (point)) > - (forward-line 1) > - (setq end (point)) > - (if (bolp) (setq end (1- end))) > - (setq item (regexp-quote (buffer-substring begin end))) > - (if re (setq re (concat re "\\|" item)) > - (setq re (concat "\\`\\(" item)))) > - (and re (list (concat re "\\)\\'")))))))) > - (mft-regexps (apply 'append message-subscribed-regexps > - (mapcar 'regexp-quote > - message-subscribed-addresses) > - file-regexps > - (mapcar 'funcall > - message-subscribed-address-functions)))) > + (to (message-fetch-field "To")) > + (cc (message-fetch-field "cc")) > + (msg-recipients (concat to (and to cc ", ") cc)) > + (recipients > + (mapcar 'mail-strip-quoted-names > + (message-tokenize-header msg-recipients))) > + (file-regexps > + (if message-subscribed-address-file > + (let (begin end item re) > + (save-excursion > + (with-temp-buffer > + (insert-file-contents message-subscribed-address-file) > + (while (not (eobp)) > + (setq begin (point)) > + (forward-line 1) > + (setq end (point)) > + (if (bolp) (setq end (1- end))) > + (setq item (regexp-quote (buffer-substring begin end))) > + (if re (setq re (concat re "\\|" item)) > + (setq re (concat "\\`\\(" item)))) > + (and re (list (concat re "\\)\\'")))))))) > + (mft-regexps (apply 'append message-subscribed-regexps > + (mapcar 'regexp-quote > + message-subscribed-addresses) > + file-regexps > + (mapcar 'funcall > + message-subscribed-address-functions)))) > (save-match-data > (let ((list > - (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 > - msg-recipients)))))) > + (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 > + msg-recipients)))))) > > (defun message-idna-to-ascii-rhs-1 (header) > "Interactively potentially IDNA encode domain names in > HEADER." > @@ -5881,30 +5881,30 @@ subscribed address (and not the > additional To and Cc header contents)." > ace) > (when field > (dolist (rhs > - (delete-dups > - (mapcar (lambda (rhs) (or (cadr (split-string rhs "@")) "")) > - (mapcar 'downcase > - (mapcar > - (lambda (elem) > - (or (cadr elem) > - "")) > - (mail-extract-address-components field t)))))) > - ;; Note that `rhs' will be "" if the address does not have > - ;; the domain part, i.e., if it is a local user's address. > - (setq ace (if (string-match "\\`[[:ascii:]]*\\'" rhs) > - rhs > - (downcase (puny-encode-domain rhs)))) > - (when (and (not (equal rhs ace)) > - (or (not (eq message-use-idna 'ask)) > - (y-or-n-p (format "Replace %s with %s in %s:? " > - rhs ace header)))) > - (goto-char (point-min)) > - (while (re-search-forward (concat "^" header ":") nil t) > - (message-narrow-to-field) > - (while (search-forward (concat "@" rhs) nil t) > - (replace-match (concat "@" ace) t t)) > - (goto-char (point-max)) > - (widen))))))) > + (delete-dups > + (mapcar (lambda (rhs) (or (cadr (split-string rhs "@")) "")) > + (mapcar 'downcase > + (mapcar > + (lambda (elem) > + (or (cadr elem) > + "")) > + (mail-extract-address-components field t)))))) > + ;; Note that `rhs' will be "" if the address does not have > + ;; the domain part, i.e., if it is a local user's address. > + (setq ace (if (string-match "\\`[[:ascii:]]*\\'" rhs) > + rhs > + (downcase (puny-encode-domain rhs)))) > + (when (and (not (equal rhs ace)) > + (or (not (eq message-use-idna 'ask)) > + (y-or-n-p (format "Replace %s with %s in %s:? " > + rhs ace header)))) > + (goto-char (point-min)) > + (while (re-search-forward (concat "^" header ":") nil t) > + (message-narrow-to-field) > + (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. > @@ -5913,19 +5913,19 @@ See `message-idna-encode'." > (when message-use-idna > (save-excursion > (save-restriction > - ;; `message-narrow-to-head' that recognizes only the first > ;; empty > - ;; line as the message header separator used to be used here. > - ;; However, since there is the "--text follows this line--" > ;; line > - ;; normally, it failed in narrowing to the headers and > ;; potentially > - ;; caused the IDNA encoding on lines that look like headers in > - ;; the message body. > - (message-narrow-to-headers-or-head) > - (message-idna-to-ascii-rhs-1 "From") > - (message-idna-to-ascii-rhs-1 "To") > - (message-idna-to-ascii-rhs-1 "Reply-To") > - (message-idna-to-ascii-rhs-1 "Mail-Reply-To") > - (message-idna-to-ascii-rhs-1 "Mail-Followup-To") > - (message-idna-to-ascii-rhs-1 "Cc"))))) > + ;; `message-narrow-to-head' that recognizes only the first > ;; empty > + ;; line as the message header separator used to be used here. > + ;; However, since there is the "--text follows this line--" > ;; line > + ;; normally, it failed in narrowing to the headers and > ;; potentially > + ;; caused the IDNA encoding on lines that look like headers in > + ;; the message body. > + (message-narrow-to-headers-or-head) > + (message-idna-to-ascii-rhs-1 "From") > + (message-idna-to-ascii-rhs-1 "To") > + (message-idna-to-ascii-rhs-1 "Reply-To") > + (message-idna-to-ascii-rhs-1 "Mail-Reply-To") > + (message-idna-to-ascii-rhs-1 "Mail-Followup-To") > + (message-idna-to-ascii-rhs-1 "Cc"))))) > > (defun message-generate-headers (headers) > "Prepare article HEADERS. > @@ -5934,155 +5934,155 @@ Headers already prepared in the buffer > are not modified." > (save-restriction > (message-narrow-to-headers) > (let* ((header-values > - (list 'Date (message-make-date) > - 'Message-ID (message-make-message-id) > - 'Organization (message-make-organization) > - 'From (message-make-from) > - 'Path (message-make-path) > - 'Subject nil > - 'Newsgroups nil > - 'In-Reply-To (message-make-in-reply-to) > - 'References (message-make-references) > - 'To nil > - 'Distribution (message-make-distribution) > - 'Lines (message-make-lines) > - 'User-Agent message-newsreader > - 'Expires (message-make-expires))) > - (case-fold-search t) > - (optionalp nil) > - header value elem header-string) > + (list 'Date (message-make-date) > + 'Message-ID (message-make-message-id) > + 'Organization (message-make-organization) > + 'From (message-make-from) > + 'Path (message-make-path) > + 'Subject nil > + 'Newsgroups nil > + 'In-Reply-To (message-make-in-reply-to) > + 'References (message-make-references) > + 'To nil > + 'Distribution (message-make-distribution) > + 'Lines (message-make-lines) > + 'User-Agent message-newsreader > + 'Expires (message-make-expires))) > + (case-fold-search t) > + (optionalp nil) > + header value elem header-string) > ;; First we remove any old generated headers. > (let ((headers message-deletable-headers)) > - (unless (buffer-modified-p) > - (setq headers (delq 'Message-ID (copy-sequence headers)))) > - (while headers > - (goto-char (point-min)) > - (and (re-search-forward > - (concat "^" (symbol-name (car headers)) ": *") nil t) > - (get-text-property (1+ (match-beginning 0)) > 'message-deletable) > - (message-delete-line)) > - (pop headers))) > + (unless (buffer-modified-p) > + (setq headers (delq 'Message-ID (copy-sequence headers)))) > + (while headers > + (goto-char (point-min)) > + (and (re-search-forward > + (concat "^" (symbol-name (car headers)) ": *") nil t) > + (get-text-property (1+ (match-beginning 0)) > 'message-deletable) > + (message-delete-line)) > + (pop headers))) > ;; Go through all the required headers and see if they > ;; are in the > ;; articles already. If they are not, or are empty, they > ;; are > ;; inserted automatically - except for Subject, > ;; Newsgroups and > ;; Distribution. > (while headers > - (goto-char (point-min)) > - (setq elem (pop headers)) > - (if (consp elem) > - (if (eq (car elem) 'optional) > - (setq header (cdr elem) > - optionalp t) > - (setq header (car elem))) > - (setq header elem)) > - (setq header-string (if (stringp header) > - header > - (symbol-name header))) > - (when (or (not (re-search-forward > - (concat "^" > - (regexp-quote (downcase header-string)) > - ":") > - nil t)) > - (progn > - ;; The header was found. We insert a space after the > - ;; colon, if there is none. > - (if (/= (char-after) ? ) (insert " ") (forward-char 1)) > - ;; Find out whether the header is empty. > - (looking-at "[ \t]*\n[^ \t]"))) > - ;; So we find out what value we should insert. > - (setq value > - (cond > - ((and (consp elem) > - (eq (car elem) 'optional) > - (not (member header-string message-inserted-headers))) > - ;; This is an optional header. If the cdr of this > - ;; is something that is nil, then we do not insert > - ;; this header. > - (setq header (cdr elem)) > - (or (and (functionp (cdr elem)) > - (funcall (cdr elem))) > - (and (symbolp (cdr elem)) > - (plist-get header-values (cdr elem))))) > - ((consp elem) > - ;; The element is a cons. Either the cdr is a > - ;; string to be inserted verbatim, or it is a > - ;; function, and we insert the value returned from > - ;; this function. > - (or (and (stringp (cdr elem)) > - (cdr elem)) > - (and (functionp (cdr elem)) > - (funcall (cdr elem))))) > - ((and (symbolp header) > - (plist-member header-values header)) > - ;; The element is a symbol. We insert the value of > - ;; this symbol, if any. > - (plist-get header-values header)) > - ((not (message-check-element > - (intern (downcase (symbol-name header))))) > - ;; We couldn't generate a value for this header, > - ;; so we just ask the user. > - (read-from-minibuffer > - (format "Empty header for %s; enter value: " header))))) > - ;; Finally insert the header. > - (when (and value > - (not (equal value ""))) > - (save-excursion > - (if (bolp) > - (progn > - ;; This header didn't exist, so we insert it. > - (goto-char (point-max)) > - (let ((formatter > - (cdr (assq header message-header-format-alist)))) > - (if formatter > - (funcall formatter header value) > - (insert header-string ": " value)) > - (push header-string message-inserted-headers) > - (goto-char (message-fill-field)) > - ;; We check whether the value was ended by a > - ;; 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) (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) > - (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 "[^:]+: ")) > - (add-text-properties > - (point) (match-end 0) > - '(message-deletable t face italic) (current-buffer))))))) > + (goto-char (point-min)) > + (setq elem (pop headers)) > + (if (consp elem) > + (if (eq (car elem) 'optional) > + (setq header (cdr elem) > + optionalp t) > + (setq header (car elem))) > + (setq header elem)) > + (setq header-string (if (stringp header) > + header > + (symbol-name header))) > + (when (or (not (re-search-forward > + (concat "^" > + (regexp-quote (downcase header-string)) > + ":") > + nil t)) > + (progn > + ;; The header was found. We insert a space after the > + ;; colon, if there is none. > + (if (/= (char-after) ? ) (insert " ") (forward-char 1)) > + ;; Find out whether the header is empty. > + (looking-at "[ \t]*\n[^ \t]"))) > + ;; So we find out what value we should insert. > + (setq value > + (cond > + ((and (consp elem) > + (eq (car elem) 'optional) > + (not (member header-string message-inserted-headers))) > + ;; This is an optional header. If the cdr of this > + ;; is something that is nil, then we do not insert > + ;; this header. > + (setq header (cdr elem)) > + (or (and (functionp (cdr elem)) > + (funcall (cdr elem))) > + (and (symbolp (cdr elem)) > + (plist-get header-values (cdr elem))))) > + ((consp elem) > + ;; The element is a cons. Either the cdr is a > + ;; string to be inserted verbatim, or it is a > + ;; function, and we insert the value returned from > + ;; this function. > + (or (and (stringp (cdr elem)) > + (cdr elem)) > + (and (functionp (cdr elem)) > + (funcall (cdr elem))))) > + ((and (symbolp header) > + (plist-member header-values header)) > + ;; The element is a symbol. We insert the value of > + ;; this symbol, if any. > + (plist-get header-values header)) > + ((not (message-check-element > + (intern (downcase (symbol-name header))))) > + ;; We couldn't generate a value for this header, > + ;; so we just ask the user. > + (read-from-minibuffer > + (format "Empty header for %s; enter value: " header))))) > + ;; Finally insert the header. > + (when (and value > + (not (equal value ""))) > + (save-excursion > + (if (bolp) > + (progn > + ;; This header didn't exist, so we insert it. > + (goto-char (point-max)) > + (let ((formatter > + (cdr (assq header message-header-format-alist)))) > + (if formatter > + (funcall formatter header value) > + (insert header-string ": " value)) > + (push header-string message-inserted-headers) > + (goto-char (message-fill-field)) > + ;; We check whether the value was ended by a > + ;; 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) (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) > + (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 "[^:]+: ")) > + (add-text-properties > + (point) (match-end 0) > + '(message-deletable t face italic) (current-buffer))))))) > ;; Insert new Sender if the From is strange. > (let ((from (message-fetch-field "from")) > - (sender (message-fetch-field "sender")) > - (secure-sender (message-make-sender))) > - (when (and from > - (not (message-check-element 'sender)) > - (not (string= > - (downcase > - (cadr (mail-extract-address-components from))) > - (downcase secure-sender))) > - (or (null sender) > - (not > - (string= > - (downcase > - (cadr (mail-extract-address-components sender))) > - (downcase secure-sender))))) > - (goto-char (point-min)) > - ;; Rename any old Sender headers to Original-Sender. > - (when (re-search-forward "^\\(Original-\\)*Sender:" nil t) > - (beginning-of-line) > - (insert "Original-") > - (beginning-of-line)) > - (when (or (message-news-p) > - (string-match "@.+\\.." secure-sender)) > - (insert "Sender: " secure-sender "\n")))) > + (sender (message-fetch-field "sender")) > + (secure-sender (message-make-sender))) > + (when (and from > + (not (message-check-element 'sender)) > + (not (string= > + (downcase > + (cadr (mail-extract-address-components from))) > + (downcase secure-sender))) > + (or (null sender) > + (not > + (string= > + (downcase > + (cadr (mail-extract-address-components sender))) > + (downcase secure-sender))))) > + (goto-char (point-min)) > + ;; Rename any old Sender headers to Original-Sender. > + (when (re-search-forward "^\\(Original-\\)*Sender:" nil t) > + (beginning-of-line) > + (insert "Original-") > + (beginning-of-line)) > + (when (or (message-news-p) > + (string-match "@.+\\.." secure-sender)) > + (insert "Sender: " secure-sender "\n")))) > ;; Check for IDNA > (message-idna-to-ascii-rhs)))) > > @@ -6091,17 +6091,17 @@ Headers already prepared in the buffer > are not modified." > (let (newsgroups) > (save-excursion > (save-restriction > - (message-narrow-to-headers) > - (when (setq newsgroups (message-fetch-field "newsgroups")) > - (goto-char (point-max)) > - (insert "Posted-To: " newsgroups "\n"))) > + (message-narrow-to-headers) > + (when (setq newsgroups (message-fetch-field "newsgroups")) > + (goto-char (point-max)) > + (insert "Posted-To: " newsgroups "\n"))) > (forward-line 1) > (when message > - (cond > - ((string-match "%s" message) > - (insert (format message newsgroups))) > - (t > - (insert message))))))) > + (cond > + ((string-match "%s" message) > + (insert (format message newsgroups))) > + (t > + (insert message))))))) > > ;;; > ;;; Setting up a message buffer > @@ -6109,19 +6109,19 @@ Headers already prepared in the buffer > are not modified." > > (defun message-skip-to-next-address () > (let ((end (save-excursion > - (message-next-header) > - (point))) > - quoted char) > + (message-next-header) > + (point))) > + quoted char) > (when (looking-at ",") > (forward-char 1)) > (while (and (not (= (point) end)) > - (or (not (eq char ?,)) > - quoted)) > + (or (not (eq char ?,)) > + quoted)) > (skip-chars-forward "^,\"" end) > (when (eq (setq char (following-char)) ?\") > - (setq quoted (not quoted))) > + (setq quoted (not quoted))) > (unless (= (point) end) > - (forward-char 1))) > + (forward-char 1))) > (skip-chars-forward " \t\n"))) > > (defun message-split-line () > @@ -6132,8 +6132,8 @@ If the current line has > `message-yank-prefix', insert it on the new line." > > (defun message-insert-header (header value) > (insert (capitalize (symbol-name header)) > - ": " > - (if (consp value) (car value) value))) > + ": " > + (if (consp value) (car value) value))) > > (defun message-field-name () > (save-excursion > @@ -6146,8 +6146,8 @@ If the current line has > `message-yank-prefix', insert it on the new line." > (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))) > + (funcall (or (cadr (assq field-name message-field-fillers)) > + 'message-fill-field-general))) > (point-max)))) > > (defun message-fill-field-address () > @@ -6155,25 +6155,25 @@ If the current line has > `message-yank-prefix', insert it on the new line." > (while (not end) > (message-skip-to-next-address) > (cond ((bolp) > - (end-of-line 0) > - (setq end 1)) > - ((eobp) > - (setq end 0))) > + (end-of-line 0) > + (setq end 1)) > + ((eobp) > + (setq end 0))) > (when (and (> (current-column) 78) > - last) > - (save-excursion > - (goto-char last) > - (delete-char (- (skip-chars-backward " \t"))) > - (insert "\n\t"))) > + last) > + (save-excursion > + (goto-char last) > + (delete-char (- (skip-chars-backward " \t"))) > + (insert "\n\t"))) > (setq last (point))) > (forward-line end))) > > (defun message-fill-field-general () > (let ((begin (point)) > - (fill-column 78) > - (fill-prefix "\t")) > + (fill-column 78) > + (fill-prefix "\t")) > (while (and (search-forward "\n" nil t) > - (not (eobp))) > + (not (eobp))) > (replace-match " " t t)) > (fill-region-as-paragraph begin (point-max)) > ;; Tapdance around looong Message-IDs. > @@ -6189,7 +6189,7 @@ If the current line has > `message-yank-prefix', insert it on the new line." > (defun message-shorten-1 (list cut surplus) > "Cut SURPLUS elements out of LIST, beginning with CUTth one." > (setcdr (nthcdr (- cut 2) list) > - (nthcdr (+ (- cut 2) surplus 1) list))) > + (nthcdr (+ (- cut 2) surplus 1) list))) > > (defun message-shorten-references (header references) > "Trim REFERENCES to be 21 Message-ID long or less, and fold > them. > @@ -6198,9 +6198,9 @@ than 988 characters long, and if they are > not, trim them until > they are." > ;; 21 is the number suggested by USAGE. > (let ((maxcount 21) > - (count 0) > - (cut 2) > - refs) > + (count 0) > + (cut 2) > + refs) > (with-temp-buffer > (insert references) > (goto-char (point-min)) > @@ -6208,17 +6208,17 @@ they are." > ;; with whitespace or missing brackets (7.a "Does not > ;; propagate broken > ;; Message-IDs in original References"). > (while (re-search-forward "<[^ <]+@[^ <]+>" nil t) > - (push (match-string 0) refs)) > + (push (match-string 0) refs)) > (setq refs (nreverse refs) > - count (length refs))) > + count (length refs))) > > ;; If the list has more than MAXCOUNT elements, trim it by > ;; removing the CUTth element and the required number of > ;; elements that follow. > (when (> count maxcount) > (let ((surplus (- count maxcount))) > - (message-shorten-1 refs cut surplus) > - (cl-decf count surplus))) > + (message-shorten-1 refs cut 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 > @@ -6232,11 +6232,11 @@ they are." > ;; 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))) > + (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. > (message-insert-header header (mapconcat #'identity refs " > ")))) > @@ -6250,7 +6250,7 @@ they are." > (widen) > (forward-char 1) > (if (eq (char-after) ? ) > - (forward-char 1) > + (forward-char 1) > (insert " "))) > (t > (goto-char (point-max)) > @@ -6346,13 +6346,13 @@ moved to the beginning " > ((memq message-generate-new-buffers '(unique t)) > (generate-new-buffer-name > (concat "*" type > - (if to > - (concat " to " > - (or (car (mail-extract-address-components to)) > - to) "") > - "") > - (if (and group (not (string= group ""))) (concat " on " group) > "") > - "*"))) > + (if to > + (concat " to " > + (or (car (mail-extract-address-components to)) > + to) "") > + "") > + (if (and group (not (string= group ""))) (concat " on " group) > "") > + "*"))) > ;; Check whether `message-generate-new-buffers' is a > ;; function, > ;; and if so, call it. > ((functionp message-generate-new-buffers) > @@ -6360,62 +6360,62 @@ moved to the beginning " > ((eq message-generate-new-buffers 'unsent) > (generate-new-buffer-name > (concat "*unsent " type > - (if to > - (concat " to " > - (or (car (mail-extract-address-components to)) > - to) "") > - "") > - (if (and group (not (string= group ""))) (concat " on " group) > "") > - "*"))) > + (if to > + (concat " to " > + (or (car (mail-extract-address-components to)) > + to) "") > + "") > + (if (and group (not (string= group ""))) (concat " on " group) > "") > + "*"))) > ;; Search for the existing message buffer with the specified > ;; name. > (t > (let* ((new (if (eq message-generate-new-buffers 'standard) > - (generate-new-buffer-name (concat "*" type " message*")) > - (let ((message-generate-new-buffers 'unique)) > - (message-buffer-name type to group)))) > - (regexp (concat "\\`" > - (regexp-quote > - (if (string-match "<[0-9]+>\\'" new) > - (substring new 0 (match-beginning 0)) > - new)) > - "\\(?:<\\([0-9]+\\)>\\)?\\'")) > - (case-fold-search nil)) > + (generate-new-buffer-name (concat "*" type " message*")) > + (let ((message-generate-new-buffers 'unique)) > + (message-buffer-name type to group)))) > + (regexp (concat "\\`" > + (regexp-quote > + (if (string-match "<[0-9]+>\\'" new) > + (substring new 0 (match-beginning 0)) > + new)) > + "\\(?:<\\([0-9]+\\)>\\)?\\'")) > + (case-fold-search nil)) > (or (cdar > - (last > - (sort > - (delq nil > - (mapcar > - (lambda (b) > - (when (and (string-match regexp (setq b (buffer-name b))) > - (eq (with-current-buffer b major-mode) > - 'message-mode)) > - (cons (string-to-number (or (match-string 1 b) "1")) > - b))) > - (buffer-list))) > - 'car-less-than-car))) > - new))))) > + (last > + (sort > + (delq nil > + (mapcar > + (lambda (b) > + (when (and (string-match regexp (setq b (buffer-name b))) > + (eq (with-current-buffer b major-mode) > + 'message-mode)) > + (cons (string-to-number (or (match-string 1 b) "1")) > + b))) > + (buffer-list))) > + 'car-less-than-car))) > + new))))) > > (defun message-pop-to-buffer (name &optional switch-function) > "Pop to buffer NAME, and warn if it already exists and is > modified." > (let ((buffer (get-buffer name))) > (if (and buffer > - (buffer-name buffer)) > - (let ((window (get-buffer-window buffer 0))) > - (if window > - ;; Raise the frame already displaying the message buffer. > - (progn > - (select-frame-set-input-focus (window-frame window)) > - (select-window window)) > - (funcall (or switch-function #'pop-to-buffer) buffer) > - (set-buffer buffer)) > - (when (and (buffer-modified-p) > - (not (prog1 > - (y-or-n-p > - "Message already being composed; erase? ") > - (message nil)))) > - (error "Message being composed"))) > + (buffer-name buffer)) > + (let ((window (get-buffer-window buffer 0))) > + (if window > + ;; Raise the frame already displaying the message buffer. > + (progn > + (select-frame-set-input-focus (window-frame window)) > + (select-window window)) > + (funcall (or switch-function #'pop-to-buffer) buffer) > + (set-buffer buffer)) > + (when (and (buffer-modified-p) > + (not (prog1 > + (y-or-n-p > + "Message already being composed; erase? ") > + (message nil)))) > + (error "Message being composed"))) > (funcall (or switch-function 'pop-to-buffer-same-window) > - name) > + name) > (set-buffer name)) > (erase-buffer) > (message-mode))) > @@ -6426,13 +6426,13 @@ moved to the beginning " > ;; list of buffers. > (setq message-buffer-list (delq (current-buffer) > message-buffer-list)) > (while (and message-max-buffers > - message-buffer-list > - (>= (length message-buffer-list) message-max-buffers)) > + message-buffer-list > + (>= (length message-buffer-list) message-max-buffers)) > ;; Kill the oldest buffer -- unless it has been changed. > (let ((buffer (pop message-buffer-list))) > (when (and (buffer-name buffer) > - (not (buffer-modified-p buffer))) > - (kill-buffer buffer)))) > + (not (buffer-modified-p buffer))) > + (kill-buffer buffer)))) > ;; Rename the buffer. > (if message-send-rename-function > (funcall message-send-rename-function) > @@ -6440,72 +6440,72 @@ moved to the beginning " > ;; Push the current buffer onto the list. > (when message-max-buffers > (setq message-buffer-list > - (nconc message-buffer-list (list (current-buffer)))))) > + (nconc message-buffer-list (list (current-buffer)))))) > > (defun message-default-send-rename-function () > ;; Note: mail-abbrevs of XEmacs renames buffer name behind > ;; Gnus. > (when (string-match > - "\\`\\*\\(sent \\|unsent \\)?\\(.+\\)\\*[^\\*]*\\|\\`mail to " > - (buffer-name)) > + "\\`\\*\\(sent \\|unsent \\)?\\(.+\\)\\*[^\\*]*\\|\\`mail to " > + (buffer-name)) > (let ((name (match-string 2 (buffer-name))) > - to group) > + to group) > (if (not (or (null name) > - (string-equal name "mail") > - (string-equal name "posting"))) > - (setq name (concat "*sent " name "*")) > - (message-narrow-to-headers) > - (setq to (message-fetch-field "to")) > - (setq group (message-fetch-field "newsgroups")) > - (widen) > - (setq name > - (cond > - (to (concat "*sent mail to " > - (or (car (mail-extract-address-components to)) > - to) "*")) > - ((and group (not (string= group ""))) > - (concat "*sent posting on " group "*")) > - (t "*sent mail*")))) > + (string-equal name "mail") > + (string-equal name "posting"))) > + (setq name (concat "*sent " name "*")) > + (message-narrow-to-headers) > + (setq to (message-fetch-field "to")) > + (setq group (message-fetch-field "newsgroups")) > + (widen) > + (setq name > + (cond > + (to (concat "*sent mail to " > + (or (car (mail-extract-address-components to)) > + to) "*")) > + ((and group (not (string= group ""))) > + (concat "*sent posting on " group "*")) > + (t "*sent mail*")))) > (unless (string-equal name (buffer-name)) > - (rename-buffer name t))))) > + (rename-buffer name t))))) > > (defun message-mail-user-agent () > (let ((mua (cond > - ((not message-mail-user-agent) nil) > - ((eq message-mail-user-agent t) mail-user-agent) > - (t message-mail-user-agent)))) > + ((not message-mail-user-agent) nil) > + ((eq message-mail-user-agent t) mail-user-agent) > + (t message-mail-user-agent)))) > (if (memq mua '(message-user-agent gnus-user-agent)) > - nil > + nil > mua))) > > ;; YANK-ACTION, if non-nil, can be a buffer or a yank action of > ;; the > ;; form (FUNCTION . ARGS). > (defun message-setup (headers &optional yank-action actions > - continue switch-function return-action) > + continue switch-function return-action) > (let ((mua (message-mail-user-agent)) > - subject to field) > + subject to field) > (if (not (and message-this-is-mail mua)) > - (message-setup-1 headers yank-action actions return-action) > + (message-setup-1 headers yank-action actions return-action) > (setq headers (copy-sequence headers)) > (setq field (assq 'Subject headers)) > (when field > - (setq subject (cdr field)) > - (setq headers (delq field headers))) > + (setq subject (cdr field)) > + (setq headers (delq field headers))) > (setq field (assq 'To headers)) > (when field > - (setq to (cdr field)) > - (setq headers (delq field headers))) > + (setq to (cdr field)) > + (setq headers (delq field headers))) > (let ((mail-user-agent mua)) > - (compose-mail to subject > - (mapcar (lambda (item) > - (cons > - (format "%s" (car item)) > - (cdr item))) > - headers) > - continue switch-function > - (if (bufferp yank-action) > - (list 'insert-buffer yank-action) > - yank-action) > - actions))))) > + (compose-mail to subject > + (mapcar (lambda (item) > + (cons > + (format "%s" (car item)) > + (cdr item))) > + headers) > + continue switch-function > + (if (bufferp yank-action) > + (list 'insert-buffer yank-action) > + yank-action) > + actions))))) > > (defun message-headers-to-generate (headers included-headers > excluded-headers) > "Return a list that includes all headers from HEADERS. > @@ -6513,44 +6513,44 @@ If INCLUDED-HEADERS is a list, just > include those headers. If it is > t, include all headers. In any case, headers from > EXCLUDED-HEADERS > are not included." > (let ((result nil) > - header-name) > + header-name) > (dolist (header headers) > (setq header-name (cond > - ((and (consp header) > - (eq (car header) 'optional)) > - ;; On the form (optional . Header) > - (cdr header)) > - ((consp header) > - ;; On the form (Header . function) > - (car header)) > - (t > - ;; Just a Header. > - header))) > + ((and (consp header) > + (eq (car header) 'optional)) > + ;; On the form (optional . Header) > + (cdr header)) > + ((consp header) > + ;; On the form (Header . function) > + (car header)) > + (t > + ;; Just a Header. > + header))) > (when (and (not (memq header-name excluded-headers)) > - (or (eq included-headers t) > - (memq header-name included-headers))) > - (push header result))) > + (or (eq included-headers t) > + (memq header-name included-headers))) > + (push header result))) > (nreverse result))) > > (defun message-setup-1 (headers &optional yank-action actions > return-action) > (dolist (action actions) > (condition-case nil > - (add-to-list 'message-send-actions > - `(apply ',(car action) ',(cdr action))))) > + (add-to-list 'message-send-actions > + `(apply ',(car action) ',(cdr action))))) > (setq message-return-action return-action) > (setq message-reply-buffer > - (if (and (consp yank-action) > - (eq (car yank-action) 'insert-buffer)) > - (nth 1 yank-action) > - yank-action)) > + (if (and (consp yank-action) > + (eq (car yank-action) 'insert-buffer)) > + (nth 1 yank-action) > + yank-action)) > (goto-char (point-min)) > ;; Insert all the headers. > (mail-header-format > (let ((h headers) > - (alist message-header-format-alist)) > + (alist message-header-format-alist)) > (while h > (unless (assq (caar h) message-header-format-alist) > - (push (list (caar h)) alist)) > + (push (list (caar h)) alist)) > (pop h)) > alist) > headers) > @@ -6607,7 +6607,7 @@ are not included." > (save-restriction > (message-narrow-to-headers) > (if message-alternative-emails > - (message-use-alternative-email-as-from)))) > + (message-use-alternative-email-as-from)))) > (message-position-point) > ;; Allow correct handling of `message-checksum' in > ;; `message-yank-original': > (set-buffer-modified-p nil) > @@ -6619,11 +6619,11 @@ are not included." > "Associate the message buffer with a file in the drafts > directory." > (when message-auto-save-directory > (unless (file-directory-p > - (directory-file-name message-auto-save-directory)) > + (directory-file-name message-auto-save-directory)) > (make-directory message-auto-save-directory t)) > (if (gnus-alive-p) > - (setq message-draft-article > - (nndraft-request-associate-buffer "drafts")) > + (setq message-draft-article > + (nndraft-request-associate-buffer "drafts")) > > ;; If Gnus were alive, draft messages would be saved in > ;; the drafts folder. > ;; But Gnus is not alive, so arrange to save the draft > ;; message in a > @@ -6632,13 +6632,13 @@ are not included." > ;; simultaneously without overwriting each other (which > ;; mimics the > ;; functionality of the Gnus drafts folder). > (setq buffer-file-name (expand-file-name > - (concat > - (if (memq system-type > - '(ms-dos windows-nt cygwin)) > - "message" > - "*message*") > - (format-time-string "-%Y%m%d-%H%M%S")) > - message-auto-save-directory)) > + (concat > + (if (memq system-type > + '(ms-dos windows-nt cygwin)) > + "message" > + "*message*") > + (format-time-string "-%Y%m%d-%H%M%S")) > + message-auto-save-directory)) > (setq buffer-auto-save-file-name > (make-auto-save-file-name))) > (clear-visited-file-modtime) > (setq buffer-file-coding-system > message-draft-coding-system))) > @@ -6656,15 +6656,15 @@ are not included." > (save-restriction > (message-narrow-to-headers) > (when (message-news-p) > - (message-generate-headers > - (delq 'Lines > - (delq 'Subject > - (copy-sequence message-required-news-headers))))) > + (message-generate-headers > + (delq 'Lines > + (delq 'Subject > + (copy-sequence message-required-news-headers))))) > (when (message-mail-p) > - (message-generate-headers > - (delq 'Lines > - (delq 'Subject > - (copy-sequence message-required-mail-headers)))))))) > + (message-generate-headers > + (delq 'Lines > + (delq 'Subject > + (copy-sequence message-required-mail-headers)))))))) > > > > @@ -6674,32 +6674,32 @@ are not included." > > ;;;###autoload > (defun message-mail (&optional to subject other-headers > continue > - switch-function yank-action send-actions > - return-action &rest ignored) > + switch-function yank-action send-actions > + return-action &rest ignored) > "Start editing a mail message to be sent. > OTHER-HEADERS is an alist of header/value pairs. CONTINUE says > whether > to continue editing a message already being composed. > SWITCH-FUNCTION > is a function used to switch to and display the mail buffer." > (interactive) > (let ((message-this-is-mail t) > - message-buffers) > + message-buffers) > ;; Search for the existing message buffer if `continue' is > ;; non-nil. > (if (and continue > - (setq message-buffers (message-buffers))) > - (pop-to-buffer (car message-buffers)) > + (setq message-buffers (message-buffers))) > + (pop-to-buffer (car message-buffers)) > ;; Start a new buffer. > (unless (message-mail-user-agent) > - (message-pop-to-buffer (message-buffer-name "mail" to) > switch-function)) > + (message-pop-to-buffer (message-buffer-name "mail" to) > switch-function)) > (message-setup > (nconc > - `((To . ,(or to "")) (Subject . ,(or subject ""))) > - ;; C-h f compose-mail says that headers should be specified as > - ;; (string . value); however all the rest of message expects > - ;; headers to be symbols, not strings (eg > ;; message-header-format-alist). > - ;; https://lists.gnu.org/r/emacs-devel/2011-01/msg00337.html > - ;; We need to convert any string input, eg from > ;; rmail-start-mail. > - (dolist (h other-headers other-headers) > - (if (stringp (car h)) (setcar h (intern (capitalize (car > h))))))) > + `((To . ,(or to "")) (Subject . ,(or subject ""))) > + ;; C-h f compose-mail says that headers should be specified as > + ;; (string . value); however all the rest of message expects > + ;; headers to be symbols, not strings (eg > ;; message-header-format-alist). > + ;; https://lists.gnu.org/r/emacs-devel/2011-01/msg00337.html > + ;; We need to convert any string input, eg from > ;; rmail-start-mail. > + (dolist (h other-headers other-headers) > + (if (stringp (car h)) (setcar h (intern (capitalize (car > h))))))) > yank-action send-actions continue switch-function > return-action)))) > > @@ -6710,7 +6710,7 @@ is a function used to switch to and > display the mail buffer." > (let ((message-this-is-news t)) > (message-pop-to-buffer (message-buffer-name "posting" nil > newsgroups)) > (message-setup `((Newsgroups . ,(or newsgroups "")) > - (Subject . ,(or subject "")))))) > + (Subject . ,(or subject "")))))) > > (defun message-alter-recipients-discard-bogus-full-name > (addrcell) > "Discard mail address in full names. > @@ -6719,8 +6719,8 @@ address (e.g. \"foo@bar \"), > discard full name. > ADDRCELL is a cons cell where the car is the mail address and > the > cdr is the complete address (full name and mail address)." > (if (string-match (concat (regexp-quote (car addrcell)) ".*" > - (regexp-quote (car addrcell))) > - (cdr addrcell)) > + (regexp-quote (car addrcell))) > + (cdr addrcell)) > (cons (car addrcell) (car addrcell)) > addrcell)) > > @@ -6729,9 +6729,9 @@ cdr is the complete address (full name and > mail address)." > It is called in `message-get-reply-headers' for each recipient. > The function is called with one parameter, a cons cell ..." > :type '(choice (const :tag "None" nil) > - (const :tag "Discard bogus full name" > - message-alter-recipients-discard-bogus-full-name) > - function) > + (const :tag "Discard bogus full name" > + message-alter-recipients-discard-bogus-full-name) > + function) > :version "23.1" ;; No Gnus > :group 'message-headers) > > @@ -6743,65 +6743,65 @@ 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 (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 > - (mapconcat 'identity > - (mapcar 'message-fetch-field > - message-extra-wide-headers) > - ", ")) > - mct (message-fetch-field "mail-copies-to") > - author (or (message-fetch-field "mail-reply-to") > - (message-fetch-field "reply-to")) > - mft (and message-use-mail-followup-to > - (message-fetch-field "mail-followup-to"))) > + (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 > + (mapconcat 'identity > + (mapcar 'message-fetch-field > + message-extra-wide-headers) > + ", ")) > + mct (message-fetch-field "mail-copies-to") > + author (or (message-fetch-field "mail-reply-to") > + (message-fetch-field "reply-to")) > + mft (and message-use-mail-followup-to > + (message-fetch-field "mail-followup-to"))) > ;; Make sure this message goes to the author if this is a > ;; wide > ;; reply, since Reply-To address may be a list address a > ;; mailing > ;; list server added. > (when (and wide author) > - (setq cc (concat author ", " cc))) > + (setq cc (concat author ", " cc))) > (when (or wide (not author)) > - (setq author (or (message-fetch-field "from") "")))) > + (setq author (or (message-fetch-field "from") "")))) > > ;; Handle special values of Mail-Copies-To. > (when mct > (cond ((or (equal (downcase mct) "never") > - (equal (downcase mct) "nobody")) > - (setq never-mct t) > - (setq mct nil)) > - ((or (equal (downcase mct) "always") > - (equal (downcase mct) "poster")) > - (setq mct author)))) > + (equal (downcase mct) "nobody")) > + (setq never-mct t) > + (setq mct nil)) > + ((or (equal (downcase mct) "always") > + (equal (downcase mct) "poster")) > + (setq mct author)))) > > (save-match-data > ;; Build (textual) list of new recipient addresses. > (cond > (to-address > - (setq recipients (concat ", " to-address)) > - ;; If the author explicitly asked for a copy, we don't deny it > ;; to them. > - (if mct (setq recipients (concat recipients ", " mct)))) > + (setq recipients (concat ", " to-address)) > + ;; If the author explicitly asked for a copy, we don't deny it > ;; to them. > + (if mct (setq recipients (concat recipients ", " mct)))) > ((not wide) > - (setq recipients (concat ", " author))) > + (setq recipients (concat ", " author))) > (address-headers > - (dolist (header address-headers) > - (let ((value (message-fetch-field header))) > - (when value > - (setq recipients (concat recipients ", " value)))))) > + (dolist (header address-headers) > + (let ((value (message-fetch-field header))) > + (when value > + (setq recipients (concat recipients ", " value)))))) > ((and mft > - (string-match "[^ \t,]" mft) > - (or (not (eq message-use-mail-followup-to 'ask)) > - (message-y-or-n-p "Obey Mail-Followup-To? " t "\ > + (string-match "[^ \t,]" mft) > + (or (not (eq message-use-mail-followup-to 'ask)) > + (message-y-or-n-p "Obey Mail-Followup-To? " t "\ > You should normally obey the Mail-Followup-To: header. In this > article, it has the value of > > " mft " > > which directs your response to " (if (string-match "," mft) > - "the specified addresses" > - "that address only") ". > + "the specified addresses" > + "that address only") ". > > Most commonly, Mail-Followup-To is used by a mailing list > poster to > express that responses should be sent to just the list, and not > the > @@ -6817,19 +6817,19 @@ responses here are directed to other > addresses. > > You may customize the variable `message-use-mail-followup-to', > if you > want to get rid of this query permanently."))) > - (setq recipients (concat ", " mft))) > + (setq recipients (concat ", " mft))) > (t > - (setq recipients (if never-mct "" (concat ", " author))) > - (if to (setq recipients (concat recipients ", " to))) > - (if cc (setq recipients (concat recipients ", " cc))) > - (if extra (setq recipients (concat recipients ", " extra))) > - (if mct (setq recipients (concat recipients ", " mct))))) > + (setq recipients (if never-mct "" (concat ", " author))) > + (if to (setq recipients (concat recipients ", " to))) > + (if cc (setq recipients (concat recipients ", " cc))) > + (if extra (setq recipients (concat recipients ", " extra))) > + (if mct (setq recipients (concat recipients ", " mct))))) > (if (>= (length recipients) 2) > - ;; Strip the leading ", ". > - (setq recipients (substring recipients 2))) > + ;; Strip the leading ", ". > + (setq recipients (substring recipients 2))) > ;; Squeeze whitespace. > (while (string-match "[ \t][ \t]+" recipients) > - (setq recipients (replace-match " " t t recipients))) > + (setq recipients (replace-match " " t t recipients))) > ;; Remove addresses that match > ;; `message-dont-reply-to-names'. > (setq recipients > (cond ((functionp message-dont-reply-to-names) > @@ -6846,74 +6846,74 @@ want to get rid of this query > permanently."))) > (mail-dont-reply-to recipients))))) > ;; Perhaps "Mail-Copies-To: never" removed the only > ;; address? > (if (string-equal recipients "") > - (setq recipients author)) > + (setq recipients author)) > ;; Convert string to a list of (("foo@bar" . "Name > ;; ") ...). > (setq recipients > - (mapcar > - (lambda (addr) > - (if message-alter-recipients-function > - (funcall message-alter-recipients-function > - (cons (downcase (mail-strip-quoted-names addr)) > - addr)) > - (cons (downcase (mail-strip-quoted-names addr)) addr))) > - (message-tokenize-header recipients))) > + (mapcar > + (lambda (addr) > + (if message-alter-recipients-function > + (funcall message-alter-recipients-function > + (cons (downcase (mail-strip-quoted-names addr)) > + addr)) > + (cons (downcase (mail-strip-quoted-names addr)) addr))) > + (message-tokenize-header recipients))) > ;; Remove all duplicates. > (let ((s recipients)) > - (while s > - (let ((address (car (pop s)))) > - (while (assoc address s) > - (setq recipients (delq (assoc address s) recipients) > - s (delq (assoc address s) s)))))) > + (while s > + (let ((address (car (pop s)))) > + (while (assoc address s) > + (setq recipients (delq (assoc address s) recipients) > + s (delq (assoc address s) s)))))) > > ;; Remove hierarchical lists that are contained within > ;; each other, > ;; if message-hierarchical-addresses is defined. > (when message-hierarchical-addresses > - (let ((plain-addrs (mapcar 'car recipients)) > - subaddrs recip) > - (while plain-addrs > - (setq subaddrs (assoc (car plain-addrs) > - message-hierarchical-addresses) > - plain-addrs (cdr plain-addrs)) > - (when subaddrs > - (setq subaddrs (cdr subaddrs)) > - (while subaddrs > - (setq recip (assoc (car subaddrs) recipients) > - subaddrs (cdr subaddrs)) > - (if recip > - (setq recipients (delq recip recipients)))))))) > + (let ((plain-addrs (mapcar 'car recipients)) > + subaddrs recip) > + (while plain-addrs > + (setq subaddrs (assoc (car plain-addrs) > + message-hierarchical-addresses) > + plain-addrs (cdr plain-addrs)) > + (when subaddrs > + (setq subaddrs (cdr subaddrs)) > + (while subaddrs > + (setq recip (assoc (car subaddrs) recipients) > + subaddrs (cdr subaddrs)) > + (if recip > + (setq recipients (delq recip recipients)))))))) > > (setq recipients (message-prune-recipients recipients)) > (setq recipients > - (cl-loop for (id . address) in recipients > - collect (cons id (message--alter-repeat-address address)))) > + (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. > (setq follow-to (list (cons 'To (cdr (pop recipients))))) > (when (and recipients > - (or (not message-wide-reply-confirm-recipients) > - (y-or-n-p "Reply to all recipients? "))) > - (setq recipients (mapconcat > - (lambda (addr) (cdr addr)) recipients ", ")) > - (if (string-match "^ +" recipients) > - (setq recipients (substring recipients (match-end 0)))) > - (push (cons 'Cc recipients) follow-to))) > + (or (not message-wide-reply-confirm-recipients) > + (y-or-n-p "Reply to all recipients? "))) > + (setq recipients (mapconcat > + (lambda (addr) (cdr addr)) recipients ", ")) > + (if (string-match "^ +" recipients) > + (setq recipients (substring recipients (match-end 0)))) > + (push (cons 'Cc recipients) follow-to))) > follow-to)) > > (defun message-prune-recipients (recipients) > (dolist (rule message-prune-recipient-rules) > (let ((match (car rule)) > - dup-match > - address) > + dup-match > + address) > + (dolist (recipient recipients) > + (setq address (car recipient)) > + (when (string-match match address) > + (setq dup-match (replace-match (cadr rule) nil nil address)) > (dolist (recipient recipients) > - (setq address (car recipient)) > - (when (string-match match address) > - (setq dup-match (replace-match (cadr rule) nil nil address)) > - (dolist (recipient recipients) > - ;; Don't delete the address that triggered this. > - (when (and (not (eq address (car recipient))) > - (string-match dup-match (car recipient))) > - (setq recipients (delq recipient recipients)))))))) > + ;; Don't delete the address that triggered this. > + (when (and (not (eq address (car recipient))) > + (string-match dup-match (car recipient))) > + (setq recipients (delq recipient recipients)))))))) > recipients) > > (defun message--alter-repeat-address (address) > @@ -6921,7 +6921,7 @@ want to get rid of this query > permanently."))) > 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) > + (car bits) > ;; Return the original address if we don't have > ;; repetition. > address))) > > @@ -6947,12 +6947,12 @@ Useful functions to put in this list > include: > ;; Simplify fully: > (setq functions message-simplify-subject-functions)) > (when (and (memq 'message-strip-list-identifiers functions) > - gnus-list-identifiers) > + gnus-list-identifiers) > (setq subject (message-strip-list-identifiers subject))) > (when (memq 'message-strip-subject-re functions) > (setq subject (concat "Re: " (message-strip-subject-re > subject)))) > (when (and (memq 'message-strip-subject-trailing-was > functions) > - message-subject-trailing-was-query) > + message-subject-trailing-was-query) > (setq subject (message-strip-subject-trailing-was > subject))) > (when (memq 'message-strip-subject-encoded-words functions) > (setq subject (message-strip-subject-encoded-words > subject))) > @@ -6964,52 +6964,52 @@ Useful functions to put in this list > include: > (interactive) > (require 'gnus-sum) ; for gnus-list-identifiers > (let ((cur (current-buffer)) > - from subject date > - references message-id follow-to > - (inhibit-point-motion-hooks t) > - (message-this-is-mail t) > - gnus-warning) > + from subject date > + references message-id follow-to > + (inhibit-point-motion-hooks t) > + (message-this-is-mail t) > + gnus-warning) > (save-restriction > (message-narrow-to-head-1) > ;; Allow customizations to have their say. > (if (not wide) > - ;; This is a regular reply. > - (when (functionp message-reply-to-function) > - (save-excursion > - (setq follow-to (funcall message-reply-to-function)))) > - ;; This is a followup. > - (when (functionp message-wide-reply-to-function) > - (save-excursion > - (setq follow-to > - (funcall message-wide-reply-to-function))))) > + ;; This is a regular reply. > + (when (functionp message-reply-to-function) > + (save-excursion > + (setq follow-to (funcall message-reply-to-function)))) > + ;; This is a followup. > + (when (functionp message-wide-reply-to-function) > + (save-excursion > + (setq follow-to > + (funcall message-wide-reply-to-function))))) > (setq message-id (message-fetch-field "message-id" t) > - references (message-fetch-field "references") > - date (message-fetch-field "date") > - from (or (message-fetch-field "from") "nobody") > - subject (or (message-fetch-field "subject") "none")) > + references (message-fetch-field "references") > + date (message-fetch-field "date") > + from (or (message-fetch-field "from") "nobody") > + subject (or (message-fetch-field "subject") "none")) > > ;; Strip list identifiers, "Re: ", and "was:" > (setq subject (message-simplify-subject subject)) > > (when (and (setq gnus-warning (message-fetch-field > "gnus-warning")) > - (string-match "<[^>]+>" gnus-warning)) > - (setq message-id (match-string 0 gnus-warning))) > + (string-match "<[^>]+>" gnus-warning)) > + (setq message-id (match-string 0 gnus-warning))) > > (unless follow-to > - (setq follow-to (message-get-reply-headers wide to-address)))) > + (setq follow-to (message-get-reply-headers wide to-address)))) > > (let ((headers > - `((Subject . ,subject) > - ,@follow-to))) > + `((Subject . ,subject) > + ,@follow-to))) > (unless (message-mail-user-agent) > - (message-pop-to-buffer > - (message-buffer-name > - (if wide "wide reply" "reply") from > - (if wide to-address nil)) > - switch-function)) > + (message-pop-to-buffer > + (message-buffer-name > + (if wide "wide reply" "reply") from > + (if wide to-address nil)) > + switch-function)) > (setq message-reply-headers > - (vector 0 (cdr (assq 'Subject headers)) > - from date message-id references 0 0 "")) > + (vector 0 (cdr (assq 'Subject headers)) > + from date message-id references 0 0 "")) > (message-setup headers cur)))) > > ;;;###autoload > @@ -7025,40 +7025,40 @@ If TO-NEWSGROUPS, use that as the new > Newsgroups line." > (interactive) > (require 'gnus-sum) ; for gnus-list-identifiers > (let ((cur (current-buffer)) > - from subject date reply-to mrt mct > - references message-id follow-to > - (inhibit-point-motion-hooks t) > - (message-this-is-news t) > - followup-to distribution newsgroups gnus-warning posted-to) > + from subject date reply-to mrt mct > + references message-id follow-to > + (inhibit-point-motion-hooks t) > + (message-this-is-news t) > + followup-to distribution newsgroups gnus-warning posted-to) > (save-restriction > (narrow-to-region > (goto-char (point-min)) > (if (search-forward "\n\n" nil t) > - (1- (point)) > - (point-max))) > + (1- (point)) > + (point-max))) > (when (functionp message-followup-to-function) > - (setq follow-to > - (funcall message-followup-to-function))) > + (setq follow-to > + (funcall message-followup-to-function))) > (setq from (message-fetch-field "from") > - date (message-fetch-field "date") > - subject (or (message-fetch-field "subject") "none") > - references (message-fetch-field "references") > - message-id (message-fetch-field "message-id" t) > - followup-to (message-fetch-field "followup-to") > - newsgroups (message-fetch-field "newsgroups") > - posted-to (message-fetch-field "posted-to") > - reply-to (message-fetch-field "reply-to") > - mrt (message-fetch-field "mail-reply-to") > - distribution (message-fetch-field "distribution") > - mct (message-fetch-field "mail-copies-to")) > + date (message-fetch-field "date") > + subject (or (message-fetch-field "subject") "none") > + references (message-fetch-field "references") > + message-id (message-fetch-field "message-id" t) > + followup-to (message-fetch-field "followup-to") > + newsgroups (message-fetch-field "newsgroups") > + posted-to (message-fetch-field "posted-to") > + reply-to (message-fetch-field "reply-to") > + mrt (message-fetch-field "mail-reply-to") > + distribution (message-fetch-field "distribution") > + mct (message-fetch-field "mail-copies-to")) > (when (and (setq gnus-warning (message-fetch-field > "gnus-warning")) > - (string-match "<[^>]+>" gnus-warning)) > - (setq message-id (match-string 0 gnus-warning))) > + (string-match "<[^>]+>" gnus-warning)) > + (setq message-id (match-string 0 gnus-warning))) > ;; Remove bogus distribution. > (when (and (stringp distribution) > - (let ((case-fold-search t)) > - (string-match "world" distribution))) > - (setq distribution nil)) > + (let ((case-fold-search t)) > + (string-match "world" distribution))) > + (setq distribution nil)) > ;; Strip list identifiers, "Re: ", and "was:" > (setq subject (message-simplify-subject subject)) > (widen)) > @@ -7066,20 +7066,20 @@ If TO-NEWSGROUPS, use that as the new > Newsgroups line." > (message-pop-to-buffer (message-buffer-name "followup" from > newsgroups)) > > (setq message-reply-headers > - (vector 0 subject from date message-id references 0 0 "")) > + (vector 0 subject from date message-id references 0 0 "")) > > (message-setup > `((Subject . ,subject) > ,@(cond > - (to-newsgroups > - (list (cons 'Newsgroups to-newsgroups))) > - (follow-to follow-to) > - ((and followup-to message-use-followup-to) > - (list > - (cond > - ((equal (downcase followup-to) "poster") > - (if (or (eq message-use-followup-to 'use) > - (message-y-or-n-p "Obey Followup-To: poster? " t "\ > + (to-newsgroups > + (list (cons 'Newsgroups to-newsgroups))) > + (follow-to follow-to) > + ((and followup-to message-use-followup-to) > + (list > + (cond > + ((equal (downcase followup-to) "poster") > + (if (or (eq message-use-followup-to 'use) > + (message-y-or-n-p "Obey Followup-To: poster? " t "\ > You should normally obey the Followup-To: header. > > `Followup-To: poster' sends your response via e-mail instead of > news. > @@ -7089,21 +7089,21 @@ does not read the newsgroup, so he > wouldn't see any replies sent to it. > > You may customize the variable `message-use-followup-to', if > you > want to get rid of this query permanently.")) > - (progn > - (setq message-this-is-news nil) > - (cons 'To (or mrt reply-to from ""))) > - (cons 'Newsgroups newsgroups))) > - (t > - (if (or (equal followup-to newsgroups) > - (not (eq message-use-followup-to 'ask)) > - (message-y-or-n-p > - (concat "Obey Followup-To: " followup-to "? ") t "\ > + (progn > + (setq message-this-is-news nil) > + (cons 'To (or mrt reply-to from ""))) > + (cons 'Newsgroups newsgroups))) > + (t > + (if (or (equal followup-to newsgroups) > + (not (eq message-use-followup-to 'ask)) > + (message-y-or-n-p > + (concat "Obey Followup-To: " followup-to "? ") t "\ > You should normally obey the Followup-To: header. > > - `Followup-To: " followup-to "' > + `Followup-To: " followup-to "' > directs your response to " (if (string-match "," followup-to) > - "the specified newsgroups" > - "that newsgroup only") ". > + "the specified newsgroups" > + "that newsgroup only") ". > > If a message is posted to several newsgroups, Followup-To is > often > used to direct the following discussion to one newsgroup only, > @@ -7115,20 +7115,20 @@ responses here are directed to other > newsgroups. > > You may customize the variable `message-use-followup-to', if > you > want to get rid of this query permanently.")) > - (cons 'Newsgroups followup-to) > - (cons 'Newsgroups newsgroups)))))) > - (posted-to > - `((Newsgroups . ,posted-to))) > - (t > - `((Newsgroups . ,newsgroups)))) > + (cons 'Newsgroups followup-to) > + (cons 'Newsgroups newsgroups)))))) > + (posted-to > + `((Newsgroups . ,posted-to))) > + (t > + `((Newsgroups . ,newsgroups)))) > ,@(and distribution (list (cons 'Distribution > distribution))) > ,@(when (and mct > - (not (or (equal (downcase mct) "never") > - (equal (downcase mct) "nobody")))) > - (list (cons 'Cc (if (or (equal (downcase mct) "always") > - (equal (downcase mct) "poster")) > - (or mrt reply-to from "") > - mct))))) > + (not (or (equal (downcase mct) "never") > + (equal (downcase mct) "nobody")))) > + (list (cons 'Cc (if (or (equal (downcase mct) "always") > + (equal (downcase mct) "poster")) > + (or mrt reply-to from "") > + mct))))) > > cur))) > > @@ -7152,26 +7152,26 @@ to match all of yours addresses." > (save-restriction > (message-narrow-to-head-1) > (if (and (message-fetch-field "Cancel-Lock") > - (message-gnksa-enable-p 'canlock-verify)) > - (if (null (canlock-verify)) > - t > - (error "Failed to verify Cancel-lock: This article is not > yours")) > - (let (sender from) > - (or > - (message-gnksa-enable-p 'cancel-messages) > - (and (setq sender (message-fetch-field "sender")) > - (string-equal (downcase sender) > - (downcase (message-make-sender)))) > - ;; Email address in From field equals to our address > - (and (setq from (message-fetch-field "from")) > - (string-equal > - (downcase (car (mail-header-parse-address from))) > - (downcase (car (mail-header-parse-address > - (message-make-from)))))) > - ;; Email address in From field matches > - ;; 'message-alternative-emails' regexp or function. > - (and from > - message-alternative-emails > + (message-gnksa-enable-p 'canlock-verify)) > + (if (null (canlock-verify)) > + t > + (error "Failed to verify Cancel-lock: This article is not > yours")) > + (let (sender from) > + (or > + (message-gnksa-enable-p 'cancel-messages) > + (and (setq sender (message-fetch-field "sender")) > + (string-equal (downcase sender) > + (downcase (message-make-sender)))) > + ;; Email address in From field equals to our address > + (and (setq from (message-fetch-field "from")) > + (string-equal > + (downcase (car (mail-header-parse-address from))) > + (downcase (car (mail-header-parse-address > + (message-make-from)))))) > + ;; Email address in From field matches > + ;; 'message-alternative-emails' regexp or function. > + (and from > + message-alternative-emails > (cond ((functionp message-alternative-emails) > (funcall message-alternative-emails > (mail-header-parse-address > from))) > @@ -7189,37 +7189,37 @@ If ARG, allow editing of the > cancellation message." > (save-excursion > ;; Get header info from original article. > (save-restriction > - (message-narrow-to-head-1) > - (setq from (message-fetch-field "from") > - newsgroups (message-fetch-field "newsgroups") > - message-id (message-fetch-field "message-id" t) > - distribution (message-fetch-field "distribution"))) > + (message-narrow-to-head-1) > + (setq from (message-fetch-field "from") > + newsgroups (message-fetch-field "newsgroups") > + message-id (message-fetch-field "message-id" t) > + distribution (message-fetch-field "distribution"))) > ;; Make sure that this article was written by the user. > (unless (message-is-yours-p) > - (error "This article is not yours")) > + (error "This article is not yours")) > (when (yes-or-no-p "Do you really want to cancel this > article? ") > - ;; Make control message. > - (if arg > - (message-news) > - (setq buf (set-buffer (get-buffer-create " *message > cancel*")))) > - (erase-buffer) > - (insert "Newsgroups: " newsgroups "\n" > - "From: " from "\n" > - "Subject: cancel " message-id "\n" > - "Control: cancel " message-id "\n" > - (if distribution > - (concat "Distribution: " distribution "\n") > - "") > - mail-header-separator "\n" > - message-cancel-message) > - (run-hooks 'message-cancel-hook) > - (unless arg > - (message "Canceling your article...") > - (if (let ((message-syntax-checks > - 'dont-check-for-anything-just-trust-me)) > - (funcall message-send-news-function)) > - (message "Canceling your article...done")) > - (kill-buffer buf)))))) > + ;; Make control message. > + (if arg > + (message-news) > + (setq buf (set-buffer (get-buffer-create " *message > cancel*")))) > + (erase-buffer) > + (insert "Newsgroups: " newsgroups "\n" > + "From: " from "\n" > + "Subject: cancel " message-id "\n" > + "Control: cancel " message-id "\n" > + (if distribution > + (concat "Distribution: " distribution "\n") > + "") > + mail-header-separator "\n" > + message-cancel-message) > + (run-hooks 'message-cancel-hook) > + (unless arg > + (message "Canceling your article...") > + (if (let ((message-syntax-checks > + 'dont-check-for-anything-just-trust-me)) > + (funcall message-send-news-function)) > + (message "Canceling your article...done")) > + (kill-buffer buf)))))) > > ;;;###autoload > (defun message-supersede () > @@ -7241,7 +7241,7 @@ header line with the old Message-ID." > (message-remove-header message-ignored-supersedes-headers > t)) > (goto-char (point-min)) > (if (not (re-search-forward "^Message-ID: " nil t)) > - (error "No Message-ID in this article") > + (error "No Message-ID in this article") > (replace-match "Supersedes: " t t)) > (goto-char (point-max)) > (insert mail-header-separator) > @@ -7254,18 +7254,18 @@ header line with the old Message-ID." > (interactive) > (let ((file-name (make-auto-save-file-name))) > (cond ((save-window-excursion > - (with-output-to-temp-buffer "*Directory*" > - (with-current-buffer standard-output > - (fundamental-mode)) > - (buffer-disable-undo standard-output) > - (let ((default-directory "/")) > - (call-process > - "ls" nil standard-output nil "-l" file-name))) > - (yes-or-no-p (format "Recover auto save file %s? " > file-name))) > - (let ((buffer-read-only nil)) > - (erase-buffer) > - (insert-file-contents file-name nil))) > - (t (error "message-recover canceled"))))) > + (with-output-to-temp-buffer "*Directory*" > + (with-current-buffer standard-output > + (fundamental-mode)) > + (buffer-disable-undo standard-output) > + (let ((default-directory "/")) > + (call-process > + "ls" nil standard-output nil "-l" file-name))) > + (yes-or-no-p (format "Recover auto save file %s? " > file-name))) > + (let ((buffer-read-only nil)) > + (erase-buffer) > + (insert-file-contents file-name nil))) > + (t (error "message-recover canceled"))))) > > ;;; Washing Subject: > > @@ -7277,7 +7277,7 @@ Previous forwarders, repliers, etc. may > add it." > (goto-char (point-min)) > ;; strip Re/Fwd stuff off the beginning > (while (re-search-forward > - > "\\([Rr][Ee]:\\|[Ff][Ww][Dd]\\(\\[[0-9]*\\]\\)?:\\|[Ff][Ww]:\\)" > nil t) > + > "\\([Rr][Ee]:\\|[Ff][Ww][Dd]\\(\\[[0-9]*\\]\\)?:\\|[Ff][Ww]:\\)" > nil t) > (replace-match "")) > > ;; and gnus-style forwards [foo@bar.com] subject > @@ -7311,19 +7311,19 @@ 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." > (let* ((group (message-fetch-field "newsgroups")) > - (from (message-fetch-field "from")) > - (prefix > - (if group > - (gnus-group-decoded-name group) > - (or (and from (or > - (car (gnus-extract-address-components from)) > - (cadr (gnus-extract-address-components from)))) > - "(nowhere)")))) > + (from (message-fetch-field "from")) > + (prefix > + (if group > + (gnus-group-decoded-name group) > + (or (and from (or > + (car (gnus-extract-address-components from)) > + (cadr (gnus-extract-address-components from)))) > + "(nowhere)")))) > (concat "[" > - (if message-forward-decoded-p > - prefix > - (mail-decode-encoded-word-string prefix)) > - "] " subject))) > + (if message-forward-decoded-p > + prefix > + (mail-decode-encoded-word-string prefix)) > + "] " subject))) > > (defun message-forward-subject-author-subject (subject) > "Generate a SUBJECT for a forwarded message. > @@ -7331,16 +7331,16 @@ 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." > (let* ((group (message-fetch-field "newsgroups")) > - (prefix > - (if group > - (gnus-group-decoded-name group) > - (or (message-fetch-field "from") > - "(nowhere)")))) > + (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))) > + (if message-forward-decoded-p > + prefix > + (mail-decode-encoded-word-string prefix)) > + "] " subject))) > > (defun message-forward-subject-fwd (subject) > "Generate a SUBJECT for a forwarded message. > @@ -7356,25 +7356,25 @@ the message." > (save-restriction > (message-narrow-to-head-1) > (let ((funcs message-make-forward-subject-function) > - (subject (message-fetch-field "Subject"))) > - (setq subject > - (if subject > - (if message-forward-decoded-p > - subject > - (mail-decode-encoded-word-string subject)) > - "")) > - (when message-wash-forwarded-subjects > - (setq subject (message-wash-subject subject))) > - ;; Make sure funcs is a list. > - (and funcs > - (not (listp funcs)) > - (setq funcs (list funcs))) > - ;; Apply funcs in order, passing subject generated by previous > - ;; func to the next one. > - (dolist (func funcs) > - (when (functionp func) > - (setq subject (funcall func subject)))) > - subject)))) > + (subject (message-fetch-field "Subject"))) > + (setq subject > + (if subject > + (if message-forward-decoded-p > + subject > + (mail-decode-encoded-word-string subject)) > + "")) > + (when message-wash-forwarded-subjects > + (setq subject (message-wash-subject subject))) > + ;; Make sure funcs is a list. > + (and funcs > + (not (listp funcs)) > + (setq funcs (list funcs))) > + ;; Apply funcs in order, passing subject generated by previous > + ;; func to the next one. > + (dolist (func funcs) > + (when (functionp func) > + (setq subject (funcall func subject)))) > + subject)))) > > (defvar gnus-article-decoded-p) > > @@ -7386,13 +7386,13 @@ Optional NEWS will use news to forward > instead of mail. > Optional DIGEST will use digest to forward." > (interactive "P") > (let* ((cur (current-buffer)) > - (message-forward-decoded-p > - (if (local-variable-p 'gnus-article-decoded-p > (current-buffer)) > - gnus-article-decoded-p ;; In an article buffer. > - message-forward-decoded-p)) > - (subject (message-make-forward-subject))) > + (message-forward-decoded-p > + (if (local-variable-p 'gnus-article-decoded-p > (current-buffer)) > + gnus-article-decoded-p ;; In an article buffer. > + message-forward-decoded-p)) > + (subject (message-make-forward-subject))) > (if news > - (message-news nil subject) > + (message-news nil subject) > (message-mail nil subject)) > (message-forward-make-body cur digest))) > > @@ -7400,22 +7400,22 @@ Optional DIGEST will use digest to > forward." > (insert > "\n-------------------- Start of forwarded message > --------------------\n") > (let ((b (point)) > - (contents (with-current-buffer forward-buffer > (buffer-string))) > - e) > + (contents (with-current-buffer forward-buffer > (buffer-string))) > + e) > (unless (multibyte-string-p contents) > (error "Attempt to insert unibyte string from the buffer > \"%s\"\ > to the multibyte buffer \"%s\"" > - (if (bufferp forward-buffer) > - (buffer-name forward-buffer) > - forward-buffer) > - (buffer-name))) > + (if (bufferp forward-buffer) > + (buffer-name forward-buffer) > + forward-buffer) > + (buffer-name))) > (insert (mm-with-multibyte-buffer > - (insert contents) > - (mime-to-mml) > - (goto-char (point-min)) > - (when (looking-at "From ") > - (replace-match "X-From-Line: ")) > - (buffer-string))) > + (insert contents) > + (mime-to-mml) > + (goto-char (point-min)) > + (when (looking-at "From ") > + (replace-match "X-From-Line: ")) > + (buffer-string))) > (unless (bolp) (insert "\n")) > (setq e (point)) > (insert > @@ -7424,25 +7424,25 @@ Optional DIGEST will use digest to > forward." > > (defun message-remove-ignored-headers (b e) > (when (or message-forward-ignored-headers > - message-forward-included-headers) > + message-forward-included-headers) > (save-restriction > (narrow-to-region b e) > (goto-char b) > (narrow-to-region (point) > - (or (search-forward "\n\n" nil t) (point))) > + (or (search-forward "\n\n" nil t) (point))) > (when message-forward-ignored-headers > - (let ((ignored (if (stringp message-forward-ignored-headers) > - (list message-forward-ignored-headers) > - message-forward-ignored-headers))) > - (dolist (elem ignored) > - (message-remove-header elem t)))) > + (let ((ignored (if (stringp message-forward-ignored-headers) > + (list message-forward-ignored-headers) > + message-forward-ignored-headers))) > + (dolist (elem ignored) > + (message-remove-header elem t)))) > (when message-forward-included-headers > - (message-remove-header > - (if (listp message-forward-included-headers) > - (mapconcat #'identity (cons "^$" > message-forward-included-headers) > - "\\|") > - message-forward-included-headers) > - t nil t))))) > + (message-remove-header > + (if (listp message-forward-included-headers) > + (mapconcat #'identity (cons "^$" > message-forward-included-headers) > + "\\|") > + message-forward-included-headers) > + t nil t))))) > > (defun message-forward-make-body-mime (forward-buffer &optional > beg end) > (let ((b (point))) > @@ -7453,7 +7453,7 @@ Optional DIGEST will use digest to > forward." > (mml-quote-region (point-min) (point-max)) > (goto-char (point-min)) > (when (looking-at "From ") > - (replace-match "X-From-Line: ")) > + (replace-match "X-From-Line: ")) > (goto-char (point-max))) > (insert "<#/part>\n") > ;; Consider there is no illegible text. > @@ -7465,28 +7465,28 @@ Optional DIGEST will use digest to > forward." > (insert "\n\n<#mml type=message/rfc822 > disposition=inline>\n") > (let ((b (point)) e) > (if (not message-forward-decoded-p) > - (let ((contents (with-current-buffer forward-buffer > (buffer-string)))) > - (unless (multibyte-string-p contents) > - (error "Attempt to insert unibyte string from the buffer > \"%s\"\ > + (let ((contents (with-current-buffer forward-buffer > (buffer-string)))) > + (unless (multibyte-string-p contents) > + (error "Attempt to insert unibyte string from the buffer > \"%s\"\ > to the multibyte buffer \"%s\"" > - (if (bufferp forward-buffer) > - (buffer-name forward-buffer) > - forward-buffer) > - (buffer-name))) > - (insert (mm-with-multibyte-buffer > - (insert contents) > - (mime-to-mml) > - (goto-char (point-min)) > - (when (looking-at "From ") > - (replace-match "X-From-Line: ")) > - (buffer-string)))) > + (if (bufferp forward-buffer) > + (buffer-name forward-buffer) > + forward-buffer) > + (buffer-name))) > + (insert (mm-with-multibyte-buffer > + (insert contents) > + (mime-to-mml) > + (goto-char (point-min)) > + (when (looking-at "From ") > + (replace-match "X-From-Line: ")) > + (buffer-string)))) > (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)))) > + (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)))) > (setq e (point)) > (insert "<#/mml>\n") > (when (not message-forward-decoded-p) > @@ -7509,7 +7509,7 @@ Optional DIGEST will use digest to > forward." > (narrow-to-region b e) > (goto-char b) > (narrow-to-region (point) > - (or (search-forward "\n\n" nil t) (point))) > + (or (search-forward "\n\n" nil t) (point))) > (delete-region (point-min) (point-max))))) > > (defun message-forward-make-body-digest (forward-buffer) > @@ -7527,51 +7527,51 @@ messages that don't conform to PGP/MIME > described in RFC2015. HANDLES > is for the internal use." > (unless handles > (let ((mm-decrypt-option 'never) > - (mm-verify-option 'never)) > + (mm-verify-option 'never)) > (if (setq handles (mm-dissect-buffer nil t)) > - (unless dont-emulate-mime > - (mm-uu-dissect-text-parts handles)) > - (unless dont-emulate-mime > - (setq handles (mm-uu-dissect)))))) > + (unless dont-emulate-mime > + (mm-uu-dissect-text-parts handles)) > + (unless dont-emulate-mime > + (setq handles (mm-uu-dissect)))))) > ;; Check text/plain message in which there is a signed or > ;; encrypted > ;; body that has been encoded by B or Q. > (unless (or handles dont-emulate-mime) > (let ((cur (current-buffer)) > - (mm-decrypt-option 'never) > - (mm-verify-option 'never)) > + (mm-decrypt-option 'never) > + (mm-verify-option 'never)) > (with-temp-buffer > - (insert-buffer-substring cur) > - (when (setq handles (mm-dissect-buffer t t)) > - (if (and (bufferp (car handles)) > - (equal (mm-handle-media-type handles) "text/plain")) > - (progn > - (erase-buffer) > - (insert-buffer-substring (car handles)) > - (mm-decode-content-transfer-encoding > - (mm-handle-encoding handles)) > - (mm-destroy-parts handles) > - (setq handles (mm-uu-dissect))) > - (mm-destroy-parts handles) > - (setq handles nil)))))) > + (insert-buffer-substring cur) > + (when (setq handles (mm-dissect-buffer t t)) > + (if (and (bufferp (car handles)) > + (equal (mm-handle-media-type handles) "text/plain")) > + (progn > + (erase-buffer) > + (insert-buffer-substring (car handles)) > + (mm-decode-content-transfer-encoding > + (mm-handle-encoding handles)) > + (mm-destroy-parts handles) > + (setq handles (mm-uu-dissect))) > + (mm-destroy-parts handles) > + (setq handles nil)))))) > (when handles > (prog1 > - (catch 'found > - (dolist (handle (if (stringp (car handles)) > - (if (member (car handles) > - '("multipart/signed" > - "multipart/encrypted")) > - (throw 'found t) > - (cdr handles)) > - (list handles))) > - (if (stringp (car handle)) > - (when (message-signed-or-encrypted-p dont-emulate-mime handle) > - (throw 'found t)) > - (when (and (bufferp (car handle)) > - (equal (mm-handle-media-type handle) > - "message/rfc822")) > - (with-current-buffer (mm-handle-buffer handle) > - (when (message-signed-or-encrypted-p dont-emulate-mime) > - (throw 'found t))))))) > + (catch 'found > + (dolist (handle (if (stringp (car handles)) > + (if (member (car handles) > + '("multipart/signed" > + "multipart/encrypted")) > + (throw 'found t) > + (cdr handles)) > + (list handles))) > + (if (stringp (car handle)) > + (when (message-signed-or-encrypted-p dont-emulate-mime handle) > + (throw 'found t)) > + (when (and (bufferp (car handle)) > + (equal (mm-handle-media-type handle) > + "message/rfc822")) > + (with-current-buffer (mm-handle-buffer handle) > + (when (message-signed-or-encrypted-p dont-emulate-mime) > + (throw 'found t))))))) > (mm-destroy-parts handles)))) > > ;;;###autoload > @@ -7584,17 +7584,17 @@ is for the internal use." > (if digest > (message-forward-make-body-digest forward-buffer) > (if message-forward-as-mime > - (if (and message-forward-show-mml > - (not (and (eq message-forward-show-mml 'best) > - ;; Use the raw form in the body if it contains > - ;; signed or encrypted message so as not to be > - ;; destroyed by re-encoding. > - (with-current-buffer forward-buffer > - (condition-case nil > - (message-signed-or-encrypted-p) > - (error t)))))) > - (message-forward-make-body-mml forward-buffer) > - (message-forward-make-body-mime forward-buffer)) > + (if (and message-forward-show-mml > + (not (and (eq message-forward-show-mml 'best) > + ;; Use the raw form in the body if it contains > + ;; signed or encrypted message so as not to be > + ;; destroyed by re-encoding. > + (with-current-buffer forward-buffer > + (condition-case nil > + (message-signed-or-encrypted-p) > + (error t)))))) > + (message-forward-make-body-mml forward-buffer) > + (message-forward-make-body-mime forward-buffer)) > (message-forward-make-body-plain forward-buffer))) > (message-position-point)) > > @@ -7615,7 +7615,7 @@ is for the internal use." > (interactive) > (setq rmail-enable-mime-composing t) > (setq rmail-insert-mime-forwarded-message-function > - 'message-forward-rmail-make-body)) > + 'message-forward-rmail-make-body)) > > (defvar message-inhibit-body-encoding nil) > > @@ -7627,32 +7627,32 @@ is for the internal use." > (message "Resending message to %s..." address) > (save-excursion > (let ((cur (current-buffer)) > - gcc beg) > + gcc beg) > ;; We first set up a normal mail buffer. > (unless (message-mail-user-agent) > - (set-buffer (get-buffer-create " *message resend*")) > - (let ((inhibit-read-only t)) > - (erase-buffer))) > + (set-buffer (get-buffer-create " *message resend*")) > + (let ((inhibit-read-only t)) > + (erase-buffer))) > (let ((message-this-is-mail t) > - message-generate-hashcash > - message-setup-hook) > - (message-setup `((To . ,address)))) > + message-generate-hashcash > + message-setup-hook) > + (message-setup `((To . ,address)))) > ;; Insert our usual headers. > (message-generate-headers '(From Date To Message-ID)) > (message-narrow-to-headers) > (when (setq gcc (mail-fetch-field "gcc" nil t)) > - (message-remove-header "gcc")) > + (message-remove-header "gcc")) > ;; Remove X-Draft-From header etc. > (message-remove-header message-ignored-mail-headers t) > ;; Rename them all to "Resent-*". > (goto-char (point-min)) > (while (re-search-forward "^[A-Za-z]" nil t) > - (forward-char -1) > - (insert "Resent-")) > + (forward-char -1) > + (insert "Resent-")) > (widen) > (forward-line) > (let ((inhibit-read-only t)) > - (delete-region (point) (point-max))) > + (delete-region (point) (point-max))) > (setq beg (point)) > ;; Insert the message to be resent. > (insert-buffer-substring cur) > @@ -7660,35 +7660,35 @@ is for the internal use." > (search-forward "\n\n") > (forward-char -1) > (save-restriction > - (narrow-to-region beg (point)) > - (message-remove-header message-ignored-resent-headers t) > - (goto-char (point-max))) > + (narrow-to-region beg (point)) > + (message-remove-header message-ignored-resent-headers t) > + (goto-char (point-max))) > (insert mail-header-separator) > ;; Rename all old ("Also-")Resent headers. > (while (re-search-backward "^\\(Also-\\)*Resent-" beg t) > - (beginning-of-line) > - (insert "Also-")) > + (beginning-of-line) > + (insert "Also-")) > ;; Quote any "From " lines at the beginning. > (goto-char beg) > (when (looking-at "From ") > - (replace-match "X-From-Line: ")) > + (replace-match "X-From-Line: ")) > ;; Send it. > (let ((message-inhibit-body-encoding > - ;; Don't do any further encoding if it looks like the > - ;; message has already been encoded. > - (let ((case-fold-search t)) > - (re-search-forward "^mime-version:" nil t))) > - (message-inhibit-ecomplete t) > - ;; We don't want smtpmail.el to encode anything, either. > - (sendmail-coding-system 'raw-text) > - (select-safe-coding-system-function nil) > - message-required-mail-headers > - message-generate-hashcash > - rfc2047-encode-encoded-words) > - (message-send-mail)) > + ;; Don't do any further encoding if it looks like the > + ;; message has already been encoded. > + (let ((case-fold-search t)) > + (re-search-forward "^mime-version:" nil t))) > + (message-inhibit-ecomplete t) > + ;; We don't want smtpmail.el to encode anything, either. > + (sendmail-coding-system 'raw-text) > + (select-safe-coding-system-function nil) > + message-required-mail-headers > + message-generate-hashcash > + rfc2047-encode-encoded-words) > + (message-send-mail)) > (when gcc > - (message-goto-eoh) > - (insert "Gcc: " gcc "\n")) > + (message-goto-eoh) > + (insert "Gcc: " gcc "\n")) > (run-hooks 'message-sent-hook) > (kill-buffer (current-buffer))) > (message "Resending message to %s...done" address))) > @@ -7701,11 +7701,11 @@ contains some mail you have written > which has been bounced back to > you." > (interactive) > (let ((handles (mm-dissect-buffer t)) > - boundary) > + boundary) > (message-pop-to-buffer (message-buffer-name "bounce")) > (if (stringp (car handles)) > - ;; This is a MIME bounce. > - (mm-insert-part (car (last handles))) > + ;; This is a MIME bounce. > + (mm-insert-part (car (last handles))) > ;; This is a non-MIME bounce, so we try to remove things > ;; manually. > (mm-insert-part handles) > @@ -7715,18 +7715,18 @@ you." > (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))))) > + (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))))) > (mime-to-mml) > (save-restriction > (message-narrow-to-head-1) > @@ -7745,10 +7745,10 @@ you." > (interactive) > (unless (message-mail-user-agent) > (message-pop-to-buffer (message-buffer-name "mail" to) > - 'switch-to-buffer-other-window)) > + 'switch-to-buffer-other-window)) > (let ((message-this-is-mail t)) > (message-setup `((To . ,(or to "")) (Subject . ,(or subject > ""))) > - nil nil nil 'switch-to-buffer-other-window))) > + nil nil nil 'switch-to-buffer-other-window))) > > ;;;###autoload > (defun message-mail-other-frame (&optional to subject) > @@ -7756,30 +7756,30 @@ you." > (interactive) > (unless (message-mail-user-agent) > (message-pop-to-buffer (message-buffer-name "mail" to) > - 'switch-to-buffer-other-frame)) > + 'switch-to-buffer-other-frame)) > (let ((message-this-is-mail t)) > (message-setup `((To . ,(or to "")) (Subject . ,(or subject > ""))) > - nil nil nil 'switch-to-buffer-other-frame))) > + nil nil nil 'switch-to-buffer-other-frame))) > > ;;;###autoload > (defun message-news-other-window (&optional newsgroups subject) > "Start editing a news article to be sent." > (interactive) > (message-pop-to-buffer (message-buffer-name "posting" nil > newsgroups) > - 'switch-to-buffer-other-window) > + 'switch-to-buffer-other-window) > (let ((message-this-is-news t)) > (message-setup `((Newsgroups . ,(or newsgroups "")) > - (Subject . ,(or subject "")))))) > + (Subject . ,(or subject "")))))) > > ;;;###autoload > (defun message-news-other-frame (&optional newsgroups subject) > "Start editing a news article to be sent." > (interactive) > (message-pop-to-buffer (message-buffer-name "posting" nil > newsgroups) > - 'switch-to-buffer-other-frame) > + 'switch-to-buffer-other-frame) > (let ((message-this-is-news t)) > (message-setup `((Newsgroups . ,(or newsgroups "")) > - (Subject . ,(or subject "")))))) > + (Subject . ,(or subject "")))))) > > ;;; underline.el > > @@ -7797,9 +7797,9 @@ which specify the range to operate on." > (move-marker end1 (max start end)) > (goto-char (min start end)) > (while (< (point) end1) > - (or (looking-at "[_\^@- ]") > - (insert (char-after) "\b")) > - (forward-char 1))))) > + (or (looking-at "[_\^@- ]") > + (insert (char-after) "\b")) > + (forward-char 1))))) > > ;;;###autoload > (defun message-unbold-region (start end) > @@ -7812,13 +7812,13 @@ which specify the range to operate on." > (move-marker end1 (max start end)) > (goto-char (min start end)) > (while (search-forward "\b" end1 t) > - (if (eq (char-after) (char-after (- (point) 2))) > - (delete-char -2)))))) > + (if (eq (char-after) (char-after (- (point) 2))) > + (delete-char -2)))))) > > (defun message-exchange-point-and-mark () > "Exchange point and mark, but don't activate region if it was > inactive." > (goto-char (prog1 (mark t) > - (set-marker (mark-marker) (point))))) > + (set-marker (mark-marker) (point))))) > > ;; Support for toolbar > (defvar tool-bar-mode) > @@ -7835,8 +7835,8 @@ Setter function for custom variables." > (set-default symbol value))) > > (defcustom message-tool-bar (if (eq gmm-tool-bar-style 'gnome) > - 'message-tool-bar-gnome > - 'message-tool-bar-retro) > + 'message-tool-bar-gnome > + 'message-tool-bar-retro) > "Specifies the message mode tool bar. > > It can be either a list or a symbol referring to a list. See > @@ -7847,9 +7847,9 @@ Pre-defined symbols include > `message-tool-bar-gnome' and > `message-tool-bar-retro'." > :type '(repeat gmm-tool-bar-list-item) > :type '(choice (const :tag "GNOME style" > message-tool-bar-gnome) > - (const :tag "Retro look" message-tool-bar-retro) > - (repeat :tag "User defined list" gmm-tool-bar-item) > - (symbol)) > + (const :tag "Retro look" message-tool-bar-retro) > + (repeat :tag "User defined list" gmm-tool-bar-item) > + (symbol)) > :version "23.1" ;; No Gnus > :initialize 'custom-initialize-default > :set 'message-tool-bar-update > @@ -7857,12 +7857,12 @@ Pre-defined symbols include > `message-tool-bar-gnome' and > > (defcustom message-tool-bar-gnome > '((ispell-message "spell" nil > - :vert-only t > - :visible (not flyspell-mode)) > + :vert-only t > + :visible (not flyspell-mode)) > (flyspell-buffer "spell" t > - :vert-only t > - :visible flyspell-mode > - :help "Flyspell whole buffer") > + :vert-only t > + :visible flyspell-mode > + :help "Flyspell whole buffer") > (message-send-and-exit "mail/send" t :label "Send") > (message-dont-send "mail/save-draft") > (mml-attach-file "attach" mml-mode-map :vert-only t) > @@ -7902,7 +7902,7 @@ See `gmm-tool-bar-from-list' for details > on the format of the list." > > (defcustom message-tool-bar-zap-list > '(new-file open-file dired kill-buffer write-file > - print-buffer customize help) > + print-buffer customize help) > "List of icon items from the global tool bar. > These items are not displayed on the message mode tool bar. > > @@ -7915,22 +7915,22 @@ See `gmm-tool-bar-from-list' for the > format of the list." > > (defvar image-load-path) > (declare-function image-load-path-for-library "image" > - (library image &optional path no-error)) > + (library image &optional path no-error)) > > (defun message-make-tool-bar (&optional force) > "Make a message mode tool bar from `message-tool-bar-list'. > When FORCE, rebuild the tool bar." > (when (and (boundp 'tool-bar-mode) > - tool-bar-mode > - (or (not message-tool-bar-map) force)) > + tool-bar-mode > + (or (not message-tool-bar-map) force)) > (setq message-tool-bar-map > - (let* ((load-path > - (image-load-path-for-library > - "message" "mail/save-draft.xpm" nil t)) > - (image-load-path (cons (car load-path) image-load-path))) > - (gmm-tool-bar-from-list message-tool-bar > - message-tool-bar-zap-list > - 'message-mode-map)))) > + (let* ((load-path > + (image-load-path-for-library > + "message" "mail/save-draft.xpm" nil t)) > + (image-load-path (cons (car load-path) image-load-path))) > + (gmm-tool-bar-from-list message-tool-bar > + message-tool-bar-zap-list > + 'message-mode-map)))) > message-tool-bar-map) > > ;;; Group name completion. > @@ -7944,11 +7944,11 @@ When FORCE, rebuild the tool bar." > (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\\):" > - . message-expand-name) > - '("^\\(Disposition-Notification-To\\|Return-Receipt-To\\):" > - . message-expand-name)) > + '("^\\(Resent-\\)?\\(To\\|B?Cc\\):" . message-expand-name) > + > '("^\\(Reply-To\\|From\\|Mail-Followup-To\\|Mail-Copies-To\\):" > + . message-expand-name) > + '("^\\(Disposition-Notification-To\\|Return-Receipt-To\\):" > + . message-expand-name)) > "Alist of (RE . FUN). Use FUN for completion on header lines > matching RE." > :version "22.1" > :group 'message > @@ -7968,7 +7968,7 @@ If nil, the function bound in > `text-mode-map' or `global-map' is executed." > :group 'message > :link '(custom-manual "(message)Various Commands") > :type '(choice (const nil) > - function)) > + function)) > > (declare-function mail-abbrev-in-expansion-header-p > "mailabbrev" ()) > > @@ -7993,8 +7993,8 @@ regular text mode tabbing command." > (defun message-completion-function () > (let ((alist message-completion-alist)) > (while (and alist > - (let ((mail-abbrev-mode-regexp (caar alist))) > - (not (mail-abbrev-in-expansion-header-p)))) > + (let ((mail-abbrev-mode-regexp (caar alist))) > + (not (mail-abbrev-in-expansion-header-p)))) > (setq alist (cdr alist))) > (when (cdar alist) > (let ((fun (cdar alist))) > @@ -8005,44 +8005,44 @@ regular text mode tabbing command." > (defun message-expand-group () > "Expand the group name under point." > (let ((b (save-excursion > - (save-restriction > - (narrow-to-region > - (save-excursion > - (beginning-of-line) > - (skip-chars-forward "^:") > - (1+ (point))) > - (point)) > - (skip-chars-backward "^, \t\n") (point)))) > - (completion-ignore-case t) > - (e (progn (skip-chars-forward "^,\t\n ") (point))) > - group collection) > + (save-restriction > + (narrow-to-region > + (save-excursion > + (beginning-of-line) > + (skip-chars-forward "^:") > + (1+ (point))) > + (point)) > + (skip-chars-backward "^, \t\n") (point)))) > + (completion-ignore-case t) > + (e (progn (skip-chars-forward "^,\t\n ") (point))) > + group collection) > (when (and (boundp 'gnus-active-hashtb) > - gnus-active-hashtb) > + gnus-active-hashtb) > (mapatoms > (lambda (symbol) > - (setq group (symbol-name symbol)) > - (push (if (string-match "[^\000-\177]" group) > - (gnus-group-decoded-name group) > - group) > - collection)) > + (setq group (symbol-name symbol)) > + (push (if (string-match "[^\000-\177]" group) > + (gnus-group-decoded-name group) > + group) > + collection)) > gnus-active-hashtb)) > (completion-in-region b e collection))) > > (defun message-expand-name () > (cond ((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)) > + (boundp 'eudc-protocol) > + eudc-protocol) > + (eudc-expand-inline)) > + ((and (memq 'bbdb message-expand-name-databases) > + (fboundp 'bbdb-complete-name)) > (let ((starttick (buffer-modified-tick))) > (or (bbdb-complete-name) > ;; Apparently, bbdb-complete-name can return nil > ;; even when > ;; completion took place. So let's double check > ;; the buffer was > ;; not modified. > (/= starttick (buffer-modified-tick))))) > - (t > - (expand-abbrev)))) > + (t > + (expand-abbrev)))) > > ;;; Help stuff. > > @@ -8051,14 +8051,14 @@ regular text mode tabbing command." > If SHOW is non-nil, the arguments TEXT... are displayed in a > temp buffer. > The following arguments may contain lists of values." > (if (and show > - (setq text (message-flatten-list text))) > + (setq text (message-flatten-list text))) > (save-window-excursion > (with-output-to-temp-buffer " *MESSAGE information > message*" > (with-current-buffer " *MESSAGE information message*" > - (fundamental-mode) > - (mapc 'princ text) > - (goto-char (point-min)))) > - (funcall ask question)) > + (fundamental-mode) > + (mapc 'princ text) > + (goto-char (point-min)))) > + (funcall ask question)) > (funcall ask question))) > > (defun message-flatten-list (list) > @@ -8067,9 +8067,9 @@ The following arguments may contain lists > of values." > \(message-flatten-list \\='(1 (2 3 (4 5 (6))) 7)) > => (1 2 3 4 5 6 7)" > (cond ((consp list) > - (apply 'append (mapcar 'message-flatten-list list))) > - (list > - (list list)))) > + (apply 'append (mapcar 'message-flatten-list list))) > + (list > + (list list)))) > > (defun message-generate-new-buffer-clone-locals (name &optional > varstr) > "Create and return a buffer with name based on NAME using > `generate-new-buffer'. > @@ -8084,21 +8084,21 @@ regexp VARSTR." > (defun message-clone-locals (buffer &optional varstr) > "Clone the local variables from BUFFER to the current > buffer." > (let ((locals (with-current-buffer buffer > (buffer-local-variables))) > - (regexp > "^gnus\\|^nn\\|^message\\|^sendmail\\|^smtp\\|^user-mail-address")) > + (regexp > "^gnus\\|^nn\\|^message\\|^sendmail\\|^smtp\\|^user-mail-address")) > (mapcar > (lambda (local) > (when (and (consp local) > - (car local) > - (string-match regexp (symbol-name (car local))) > - (or (null varstr) > - (string-match varstr (symbol-name (car local))))) > - (ignore-errors > - ;; Cloning message-default-charset could cause an already > - ;; encoded text to be encoded again, yielding raw bytes > - ;; instead of characters in the message. > - (unless (eq 'message-default-charset (car local)) > - (set (make-local-variable (car local)) > - (cdr local)))))) > + (car local) > + (string-match regexp (symbol-name (car local))) > + (or (null varstr) > + (string-match varstr (symbol-name (car local))))) > + (ignore-errors > + ;; Cloning message-default-charset could cause an already > + ;; encoded text to be encoded again, yielding raw bytes > + ;; instead of characters in the message. > + (unless (eq 'message-default-charset (car local)) > + (set (make-local-variable (car local)) > + (cdr local)))))) > locals))) > > ;;; > @@ -8108,52 +8108,52 @@ regexp VARSTR." > (defun message-encode-message-body () > (unless message-inhibit-body-encoding > (let ((mail-parse-charset (or mail-parse-charset > - message-default-charset)) > - (case-fold-search t) > - lines content-type-p) > + message-default-charset)) > + (case-fold-search t) > + lines content-type-p) > (message-goto-body) > (save-restriction > - (narrow-to-region (point) (point-max)) > - (let ((new (mml-generate-mime))) > - (when new > - (delete-region (point-min) (point-max)) > - (insert new) > - (goto-char (point-min)) > - (if (eq (aref new 0) ?\n) > - (delete-char 1) > - (search-forward "\n\n") > - (setq lines (buffer-substring (point-min) (1- (point)))) > - (delete-region (point-min) (point)))))) > + (narrow-to-region (point) (point-max)) > + (let ((new (mml-generate-mime))) > + (when new > + (delete-region (point-min) (point-max)) > + (insert new) > + (goto-char (point-min)) > + (if (eq (aref new 0) ?\n) > + (delete-char 1) > + (search-forward "\n\n") > + (setq lines (buffer-substring (point-min) (1- (point)))) > + (delete-region (point-min) (point)))))) > (save-restriction > - (message-narrow-to-headers-or-head) > - (message-remove-header "Mime-Version") > - (goto-char (point-max)) > - (insert "MIME-Version: 1.0\n") > - (when lines > - (insert lines)) > - (setq content-type-p > - (or mml-boundary > - (re-search-backward "^Content-Type:" nil t)))) > + (message-narrow-to-headers-or-head) > + (message-remove-header "Mime-Version") > + (goto-char (point-max)) > + (insert "MIME-Version: 1.0\n") > + (when lines > + (insert lines)) > + (setq content-type-p > + (or mml-boundary > + (re-search-backward "^Content-Type:" nil t)))) > (save-restriction > - (message-narrow-to-headers-or-head) > - (message-remove-first-header "Content-Type") > - (message-remove-first-header "Content-Transfer-Encoding")) > + (message-narrow-to-headers-or-head) > + (message-remove-first-header "Content-Type") > + (message-remove-first-header "Content-Transfer-Encoding")) > ;; We always make sure that the message has a > ;; Content-Type > ;; header. This is because some broken MTAs and MUAs get > ;; awfully confused when confronted with a message with a > ;; MIME-Version header and without a Content-Type header. > ;; For > ;; instance, Solaris' /usr/bin/mail. > (unless content-type-p > - (goto-char (point-min)) > - ;; For unknown reason, MIME-Version doesn't exist. > - (when (re-search-forward "^MIME-Version:" nil t) > - (forward-line 1) > - (insert "Content-Type: text/plain; charset=us-ascii\n")))))) > + (goto-char (point-min)) > + ;; For unknown reason, MIME-Version doesn't exist. > + (when (re-search-forward "^MIME-Version:" nil t) > + (forward-line 1) > + (insert "Content-Type: text/plain; charset=us-ascii\n")))))) > > (defun message-read-from-minibuffer (prompt &optional > initial-contents) > "Read from the minibuffer while providing abbrev expansion." > (let ((minibuffer-setup-hook 'mail-abbrevs-setup) > - (minibuffer-local-map message-minibuffer-local-map)) > + (minibuffer-local-map message-minibuffer-local-map)) > (read-from-minibuffer prompt initial-contents))) > > (defun message-use-alternative-email-as-from () > @@ -8162,11 +8162,11 @@ address in `message-alternative-emails', > looking at To, Cc and > From headers in the original article." > (require 'mail-utils) > (let* ((fields '("To" "Cc" "From")) > - (emails > - (message-tokenize-header > - (mail-strip-quoted-names > - (mapconcat 'message-fetch-reply-field fields ",")))) > - (email > + (emails > + (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 (cl-loop for email in emails > @@ -8176,7 +8176,7 @@ From headers in the original article." > (message-remove-header "From") > (goto-char (point-max)) > (insert "From: " (let ((user-mail-address email)) > (message-make-from)) > - "\n")))) > + "\n")))) > > (defun message-options-get (symbol) > (cdr (assq symbol message-options))) > @@ -8184,69 +8184,69 @@ From headers in the original article." > (defun message-options-set (symbol value) > (let ((the-cons (assq symbol message-options))) > (if the-cons > - (if value > - (setcdr the-cons value) > - (setq message-options (delq the-cons message-options))) > + (if value > + (setcdr the-cons value) > + (setq message-options (delq the-cons message-options))) > (and value > - (push (cons symbol value) message-options)))) > + (push (cons symbol value) message-options)))) > value) > > (defun message-options-set-recipient () > (save-restriction > (message-narrow-to-headers-or-head) > (message-options-set 'message-sender > - (mail-strip-quoted-names > - (message-fetch-field "from"))) > + (mail-strip-quoted-names > + (message-fetch-field "from"))) > (message-options-set 'message-recipients > - (mail-strip-quoted-names > - (let ((to (message-fetch-field "to")) > - (cc (message-fetch-field "cc")) > - (bcc (message-fetch-field "bcc"))) > - (concat > - (or to "") > - (if (and to cc) ", ") > - (or cc "") > - (if (and (or to cc) bcc) ", ") > - (or bcc ""))))))) > + (mail-strip-quoted-names > + (let ((to (message-fetch-field "to")) > + (cc (message-fetch-field "cc")) > + (bcc (message-fetch-field "bcc"))) > + (concat > + (or to "") > + (if (and to cc) ", ") > + (or cc "") > + (if (and (or to cc) bcc) ", ") > + (or bcc ""))))))) > > (defun message-hide-headers () > "Hide headers based on the `message-hidden-headers' > variable." > (let ((regexps (if (stringp message-hidden-headers) > - (list message-hidden-headers) > - message-hidden-headers)) > - (inhibit-point-motion-hooks t) > - (inhibit-modification-hooks t) > - (end-of-headers (point-min))) > + (list message-hidden-headers) > + message-hidden-headers)) > + (inhibit-point-motion-hooks t) > + (inhibit-modification-hooks t) > + (end-of-headers (point-min))) > (when regexps > (save-excursion > - (save-restriction > - (message-narrow-to-headers) > - (goto-char (point-min)) > - (while (not (eobp)) > - (if (not (message-hide-header-p regexps)) > - (message-next-header) > - (let ((begin (point)) > - header header-len) > - (message-next-header) > - (setq header (buffer-substring begin (point)) > - header-len (- (point) begin)) > - (delete-region begin (point)) > - (goto-char end-of-headers) > - (insert header) > - (setq end-of-headers > - (+ end-of-headers header-len)))))))) > + (save-restriction > + (message-narrow-to-headers) > + (goto-char (point-min)) > + (while (not (eobp)) > + (if (not (message-hide-header-p regexps)) > + (message-next-header) > + (let ((begin (point)) > + header header-len) > + (message-next-header) > + (setq header (buffer-substring begin (point)) > + header-len (- (point) begin)) > + (delete-region begin (point)) > + (goto-char end-of-headers) > + (insert header) > + (setq end-of-headers > + (+ end-of-headers header-len)))))))) > (narrow-to-region end-of-headers (point-max)))) > > (defun message-hide-header-p (regexps) > (let ((result nil) > - (reverse nil)) > + (reverse nil)) > (when (eq (car regexps) 'not) > (setq reverse t) > (pop regexps)) > (dolist (regexp regexps) > (setq result (or result (looking-at regexp)))) > (if reverse > - (not result) > + (not result) > result))) > > (declare-function ecomplete-add-item "ecomplete" (type key > text)) > @@ -8257,12 +8257,12 @@ From headers in the original article." > (dolist (header '("to" "cc" "from" "reply-to")) > (let ((value (message-field-value header))) > (dolist (string (mail-header-parse-addresses value 'raw)) > - (setq string > - (replace-regexp-in-string > - "\n" "" > - (replace-regexp-in-string "^ +\\| +$" "" string))) > - (ecomplete-add-item 'mail (car (mail-header-parse-address > string)) > - string)))) > + (setq string > + (replace-regexp-in-string > + "\n" "" > + (replace-regexp-in-string "^ +\\| +$" "" string))) > + (ecomplete-add-item 'mail (car (mail-header-parse-address > string)) > + string)))) > (ecomplete-save)) > > (autoload 'ecomplete-display-matches "ecomplete") > @@ -8271,26 +8271,26 @@ From headers in the original article." > (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:")))) > + (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 (message--in-tocc-p) > (let* ((end (point)) > - (start (save-excursion > - (and (re-search-backward "[\n\t ]" nil t) > - (1+ (point))))) > - (word (when start (buffer-substring start end))) > - (match (when (and word > - (not (zerop (length word)))) > - (ecomplete-display-matches 'mail word choose)))) > + (start (save-excursion > + (and (re-search-backward "[\n\t ]" nil t) > + (1+ (point))))) > + (word (when start (buffer-substring start end))) > + (match (when (and word > + (not (zerop (length word)))) > + (ecomplete-display-matches 'mail word choose)))) > (when (and choose match) > - (delete-region start end) > - (insert match))))) > + (delete-region start end) > + (insert match))))) > > (defun message-ecomplete-capf () > "Return completion data for email addresses in Ecomplete. > @@ -8301,7 +8301,7 @@ Meant for use on > `completion-at-point-functions'." > (let ((end (save-excursion > (skip-chars-forward "^, \t\n") > (point))) > - (start (save-excursion > + (start (save-excursion > (skip-chars-backward "^, \t\n") > (point)))) > `(,start ,end ,(ecomplete-completion-table 'mail))))) > @@ -8367,35 +8367,35 @@ The messages are separated by > `message-form-letter-separator'. > Header and body are separated by `mail-header-separator'." > (interactive "P") > (let ((sent 0) (skipped 0) > - start end text > - buff > - to done) > + start end text > + buff > + to done) > (goto-char (point-min)) > (while (not done) > (setq start (point) > - end (if (search-forward message-form-letter-separator nil t) > - (- (point) (length message-form-letter-separator) -1) > - (setq done t) > - (point-max))) > + end (if (search-forward message-form-letter-separator nil t) > + (- (point) (length message-form-letter-separator) -1) > + (setq done t) > + (point-max))) > (setq text > - (buffer-substring-no-properties start end)) > + (buffer-substring-no-properties start end)) > (setq buff (generate-new-buffer "*mail - form letter*")) > (with-current-buffer buff > - (insert text) > - (message-mode) > - (setq to (message-fetch-field "To")) > - (switch-to-buffer buff) > - (when force > - (sit-for message-send-form-letter-delay)) > - (if (or force > - (y-or-n-p (format-message "Send message to `%s'? " to))) > - (progn > - (setq sent (1+ sent)) > - (message-send-and-exit)) > - (message "Message to `%s' skipped." to) > - (setq skipped (1+ skipped))) > - (when (buffer-live-p buff) > - (kill-buffer buff)))) > + (insert text) > + (message-mode) > + (setq to (message-fetch-field "To")) > + (switch-to-buffer buff) > + (when force > + (sit-for message-send-form-letter-delay)) > + (if (or force > + (y-or-n-p (format-message "Send message to `%s'? " to))) > + (progn > + (setq sent (1+ sent)) > + (message-send-and-exit)) > + (message "Message to `%s' skipped." to) > + (setq skipped (1+ skipped))) > + (when (buffer-live-p buff) > + (kill-buffer buff)))) > (message "%s message(s) sent, %s skipped." sent skipped))) > > (defun message-replace-header (header new-value &optional after > force) > @@ -8409,8 +8409,8 @@ even if NEW-VALUE is empty." > (message-remove-header header)) > (when (or force (> (length new-value) 0)) > (if after > - (message-position-on-field header after) > - (message-position-on-field header)) > + (message-position-on-field header after) > + (message-position-on-field header)) > (insert new-value)))) > > (make-obsolete-variable > @@ -8418,16 +8418,16 @@ even if NEW-VALUE is empty." > "Recipients are simplified by default" "27.1") > (defcustom message-recipients-without-full-name > (list "ding@gnus.org" > - "bugs@gnus.org" > - "emacs-devel@gnu.org" > - "emacs-pretest-bug@gnu.org" > - "bug-gnu-emacs@gnu.org") > + "bugs@gnus.org" > + "emacs-devel@gnu.org" > + "emacs-pretest-bug@gnu.org" > + "bug-gnu-emacs@gnu.org") > "Mail addresses that have no full name. > Used in `message-simplify-recipients'." > ;; Maybe the addresses could be extracted from > ;; `gnus-parameter-to-list-alist'? > :type '(choice (const :tag "None" nil) > - (repeat string)) > + (repeat string)) > :version "23.1" ;; No Gnus > :group 'message-headers) > > @@ -8439,17 +8439,17 @@ Used in `message-simplify-recipients'." > hdr > (mapconcat > (lambda (addrcomp) > - (if (and message-recipients-without-full-name > - (string-match > - (regexp-opt message-recipients-without-full-name) > - (cadr addrcomp))) > - (cadr addrcomp) > - (if (car addrcomp) > - (message-make-from (car addrcomp) (cadr addrcomp)) > - (cadr addrcomp)))) > + (if (and message-recipients-without-full-name > + (string-match > + (regexp-opt message-recipients-without-full-name) > + (cadr addrcomp))) > + (cadr addrcomp) > + (if (car addrcomp) > + (message-make-from (car addrcomp) (cadr addrcomp)) > + (cadr addrcomp)))) > (when (message-fetch-field hdr) > - (mail-extract-address-components > - (message-fetch-field hdr) t)) > + (mail-extract-address-components > + (message-fetch-field hdr) t)) > ", ")))) > > ;;; multipart/related and HTML support. > @@ -8472,29 +8472,29 @@ Used in `message-simplify-recipients'." > (save-excursion > (goto-char (point-min)) > (while (not (eobp)) > - (when-let* ((props (get-text-property (point) 'display))) > - (when (and (consp props) > - (eq (car props) 'image)) > - (put-text-property (point) (1+ (point)) 'display nil) > - (setq displayed t))) > - (forward-char 1))) > + (when-let* ((props (get-text-property (point) 'display))) > + (when (and (consp props) > + (eq (car props) 'image)) > + (put-text-property (point) (1+ (point)) 'display nil) > + (setq displayed t))) > + (forward-char 1))) > (unless displayed > (save-excursion > - (goto-char (point-min)) > - (while (re-search-forward "" nil t) > - (let ((string (match-string 0)) > - (file (match-string 1)) > - (edges (window-inside-pixel-edges > - (get-buffer-window (current-buffer))))) > - (delete-region (match-beginning 0) (match-end 0)) > - (insert-image > - (create-image > - file 'imagemagick nil > - :max-width (truncate > - (* 0.7 (- (nth 2 edges) (nth 0 edges)))) > - :max-height (truncate > - (* 0.5 (- (nth 3 edges) (nth 1 edges))))) > - string))))))) > + (goto-char (point-min)) > + (while (re-search-forward "" nil t) > + (let ((string (match-string 0)) > + (file (match-string 1)) > + (edges (window-inside-pixel-edges > + (get-buffer-window (current-buffer))))) > + (delete-region (match-beginning 0) (match-end 0)) > + (insert-image > + (create-image > + file 'imagemagick nil > + :max-width (truncate > + (* 0.7 (- (nth 2 edges) (nth 0 edges)))) > + :max-height (truncate > + (* 0.5 (- (nth 3 edges) (nth 1 edges))))) > + string))))))) > > (provide 'message) > 0