[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/gnus/message.el,v
|
From: |
Miles Bader |
|
Subject: |
[Emacs-diffs] Changes to emacs/lisp/gnus/message.el,v |
|
Date: |
Sun, 28 Oct 2007 09:18:48 +0000 |
CVSROOT: /cvsroot/emacs
Module name: emacs
Changes by: Miles Bader <miles> 07/10/28 09:18:40
Index: lisp/gnus/message.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/gnus/message.el,v
retrieving revision 1.122
retrieving revision 1.123
diff -u -b -r1.122 -r1.123
--- lisp/gnus/message.el 31 Jul 2007 05:02:50 -0000 1.122
+++ lisp/gnus/message.el 28 Oct 2007 09:18:27 -0000 1.123
@@ -35,6 +35,7 @@
(require 'cl)
(defvar gnus-message-group-art)
(defvar gnus-list-identifiers)) ; gnus-sum is required where necessary
+(require 'hashcash)
(require 'canlock)
(require 'mailheader)
(require 'gmm-utils)
@@ -48,10 +49,8 @@
(require 'mail-parse)
(require 'mml)
(require 'rfc822)
-(eval-and-compile
- (autoload 'gnus-find-method-for-group "gnus")
- (autoload 'nnvirtual-find-group-art "nnvirtual")
- (autoload 'gnus-group-decoded-name "gnus-group"))
+(require 'ecomplete)
+
(defgroup message '((user-mail-address custom-variable)
(user-full-name custom-variable))
@@ -156,7 +155,6 @@
:group 'message-interface
:type 'regexp)
-;;;###autoload
(defcustom message-from-style 'default
"*Specifies how \"From\" headers look.
@@ -211,7 +209,7 @@
:link '(custom-manual "(message)Message Headers")
:type '(repeat sexp))
-(defcustom message-draft-headers '(References From)
+(defcustom message-draft-headers '(References From Date)
"*Headers to be generated when saving a draft message."
:version "22.1"
:group 'message-news
@@ -271,7 +269,7 @@
:link '(custom-manual "(message)Mail Headers")
:type 'regexp)
-(defcustom message-ignored-supersedes-headers
"^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:\\|^X-Payment:"
+(defcustom message-ignored-supersedes-headers
"^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:\\|^X-Payment:\\|^Approved:"
"*Header lines matching this regexp will be deleted before posting.
It's best to delete old Path and Date headers before posting to avoid
any confusion."
@@ -411,7 +409,6 @@
;;; End of variables adopted from `message-utils.el'.
-;;;###autoload
(defcustom message-signature-separator "^-- *$"
"Regexp matching the signature separator."
:type 'regexp
@@ -470,6 +467,13 @@
:link '(custom-manual "(message)Message Buffers")
:type 'boolean)
+(defcustom message-kill-buffer-query t
+ "*Non-nil means that killing a modified message buffer has to be confirmed.
+This is used by `message-kill-buffer'."
+ :version "23.0" ;; No Gnus
+ :group 'message-buffers
+ :type 'boolean)
+
(eval-when-compile
(defvar gnus-local-organization))
(defcustom message-user-organization
@@ -484,8 +488,14 @@
:type '(choice string
(const :tag "consult file" t)))
-;;;###autoload
-(defcustom message-user-organization-file "/usr/lib/news/organization"
+(defcustom message-user-organization-file
+ (let (orgfile)
+ (dolist (f (list "/etc/organization"
+ "/etc/news/organization"
+ "/usr/lib/news/organization"))
+ (when (file-readable-p f)
+ (setq orgfile f)))
+ orgfile)
"*Local news organization file."
:type 'file
:link '(custom-manual "(message)News Headers")
@@ -578,15 +588,13 @@
(if (string-match "[[:digit:]]" "1") ;; support POSIX?
"\\([ \t]*[-_.[:word:]]+>+\\|[ \t]*[]>|}+]\\)+"
;; ?-, ?_ or ?. MUST NOT be in syntax entry w.
- (let ((old-table (syntax-table))
- non-word-constituents)
- (set-syntax-table text-mode-syntax-table)
+ (let (non-word-constituents)
+ (with-syntax-table text-mode-syntax-table
(setq non-word-constituents
(concat
(if (string-match "\\w" "-") "" "-")
(if (string-match "\\w" "_") "" "_")
- (if (string-match "\\w" ".") "" ".")))
- (set-syntax-table old-table)
+ (if (string-match "\\w" ".") "" "."))))
(if (equal non-word-constituents "")
"\\([ \t]*\\(\\w\\)+>+\\|[ \t]*[]>|}+]\\)+"
(concat "\\([ \t]*\\(\\w\\|["
@@ -596,7 +604,13 @@
:version "22.1"
:group 'message-insertion
:link '(custom-manual "(message)Insertion Variables")
- :type 'regexp)
+ :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 "\\)"))))))
(defcustom message-cancel-message "I am canceling my own article.\n"
"Message to be inserted in the cancel message."
@@ -605,8 +619,20 @@
:type 'string)
;; Useful to set in site-init.el
-;;;###autoload
-(defcustom message-send-mail-function 'message-send-mail-with-sendmail
+(defcustom message-send-mail-function
+ (let ((program (if (boundp 'sendmail-program)
+ ;; see paths.el
+ sendmail-program)))
+ (cond
+ ((and program
+ (string-match "/" program) ;; Skip path
+ (file-executable-p program))
+ 'message-send-mail-with-sendmail)
+ ((and program
+ (executable-find program))
+ 'message-send-mail-with-sendmail)
+ (t
+ 'smtpmail-send-it)))
"Function to call to send the current buffer as mail.
The headers should be delimited by a line whose contents match the
variable `mail-header-separator'.
@@ -660,6 +686,12 @@
:link '(custom-manual "(message)Followup")
:type '(choice function (const nil)))
+(defcustom message-extra-wide-headers nil
+ "If non-nil, a list of additional address headers.
+These are used when composing a wide reply."
+ :group 'message-sending
+ :type '(repeat string))
+
(defcustom message-use-followup-to 'ask
"*Specifies what to do with Followup-To header.
If nil, always ignore the header. If it is t, use its value, but
@@ -756,6 +788,14 @@
:link '(custom-manual "(message)Mail Variables")
:group 'message-sending)
+(defcustom message-sendmail-extra-arguments nil
+ "Additional arguments to `sendmail-program'."
+ ;; E.g. '("-a" "account") for msmtp
+ :version "23.0" ;; No Gnus
+ :type '(repeat string)
+ ;; :link '(custom-manual "(message)Mail Variables")
+ :group 'message-sending)
+
;; qmail-related stuff
(defcustom message-qmail-inject-program "/var/qmail/bin/qmail-inject"
"Location of the qmail-inject program."
@@ -776,11 +816,6 @@
:type '(choice (function)
(repeat string)))
-(defvar message-cater-to-broken-inn t
- "Non-nil means Gnus should not fold the `References' header.
-Folding `References' makes ancient versions of INN create incorrect
-NOV lines.")
-
(eval-when-compile
(defvar gnus-post-method)
(defvar gnus-select-method))
@@ -821,6 +856,15 @@
(const :tag "All" t)
(repeat (sexp :tag "Header"))))
+(defcustom message-fill-column 72
+ "Column beyond which automatic line-wrapping should happen.
+Local value for message buffers. If non-nil, also turn on
+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)))
+
(defcustom message-setup-hook nil
"Normal hook, run each time a new outgoing message is initialized.
The function `message-setup' runs this hook."
@@ -866,31 +910,71 @@
:version "22.1"
:group 'message-various)
-;;;###autoload
(defcustom message-citation-line-function 'message-insert-citation-line
"*Function called to insert the \"Whomever writes:\" line.
+Predefined functions include `message-insert-citation-line' and
+`message-insert-formated-citation-line' (see the variable
+`message-citation-line-format').
+
Note that Gnus provides a feature where the reader can click on
`writes:' to hide the cited text. If you change this line too much,
people who read your message will have to change their Gnus
configuration. See the variable `gnus-cite-attribution-suffix'."
- :type 'function
+ :type '(choice
+ (function-item :tag "plain" message-insert-citation-line)
+ (function-item :tag "formatted" message-insert-formated-citation-line)
+ (function :tag "Other"))
:link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
-;;;###autoload
+(defcustom message-citation-line-format "On %a, %b %d %Y, %N wrote:\n"
+ "Format of the \"Whomever writes:\" line.
+
+The string is formatted using `format-spec'. The following
+constructs are replaced:
+
+ %f The full From, e.g. \"John Doe <address@hidden>\".
+ %n The mail address, e.g. \"address@hidden".
+ %N The real name if present, e.g.: \"John Doe\", else fall
+ back to the mail address.
+ %F The first name if present, e.g.: \"John\".
+ %L The last name if present, e.g.: \"Doe\".
+
+All other format specifiers are passed to `format-time-string'
+which is called using the date from the article your replying to.
+Extracting the first (%F) and last name (%L) is done
+heuristically, 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)
+ :link '(custom-manual "(message)Insertion Variables")
+ :version "23.0" ;; No Gnus
+ :group 'message-insertion)
+
(defcustom message-yank-prefix "> "
"*Prefix inserted on the lines of yanked messages.
Fix `message-cite-prefix-regexp' if it is set to an abnormal value.
-See also `message-yank-cited-prefix'."
+See also `message-yank-cited-prefix' and `message-yank-empty-prefix'."
:type 'string
:link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
(defcustom message-yank-cited-prefix ">"
- "*Prefix inserted on cited or empty lines of yanked messages.
+ "*Prefix inserted on cited lines of yanked messages.
Fix `message-cite-prefix-regexp' if it is set to an abnormal value.
-See also `message-yank-prefix'."
+See also `message-yank-prefix' and `message-yank-empty-prefix'."
+ :version "22.1"
+ :type 'string
+ :link '(custom-manual "(message)Insertion Variables")
+ :group 'message-insertion)
+
+(defcustom message-yank-empty-prefix ">"
+ "*Prefix inserted on empty lines of yanked messages.
+See also `message-yank-prefix' and `message-yank-cited-prefix'."
:version "22.1"
:type 'string
:link '(custom-manual "(message)Insertion Variables")
@@ -903,12 +987,11 @@
:link '(custom-manual "(message)Insertion Variables")
:type 'integer)
-;;;###autoload
(defcustom message-cite-function 'message-cite-original
"*Function for citing an original message.
Predefined functions include `message-cite-original' and
`message-cite-original-without-signature'.
-Note that `message-cite-original' uses `mail-citation-hook' if that is
non-nil."
+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)
@@ -916,7 +999,6 @@
:link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
-;;;###autoload
(defcustom message-indent-citation-function 'message-indent-citation
"*Function for modifying a citation just inserted in the mail buffer.
This can also be a list of functions. Each function can find the
@@ -926,7 +1008,6 @@
:link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
-;;;###autoload
(defcustom message-signature t
"*String to be inserted at the end of the message buffer.
If t, the `message-signature-file' file will be inserted instead.
@@ -936,16 +1017,26 @@
:link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
-;;;###autoload
(defcustom message-signature-file "~/.signature"
"*Name of file containing the text inserted at end of message buffer.
Ignored if the named file doesn't exist.
-If nil, don't insert a signature."
+If nil, don't insert a signature.
+If a path is specified, the value of `message-signature-directory' is ignored,
+even if set."
:type '(choice file (const :tags "None" nil))
:link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
-;;;###autoload
+(defcustom message-signature-directory nil
+ "*Name of directory containing signature files.
+Comes in handy if you have many such files, handled via posting styles for
+instance.
+If nil, `message-signature-file' is expected to specify the directory if
+needed."
+ :type '(choice string (const :tags "None" nil))
+ :link '(custom-manual "(message)Insertion Variables")
+ :group 'message-insertion)
+
(defcustom message-signature-insert-empty-line t
"*If non-nil, insert an empty line before the signature separator."
:version "22.1"
@@ -1075,13 +1166,25 @@
(defcustom message-mail-alias-type 'abbrev
"*What alias expansion type to use in Message buffers.
-The default is `abbrev', which uses mailabbrev. nil switches
-mail aliases off."
+The default is `abbrev', which uses mailabbrev. `ecomplete' uses
+an electric completion mode. nil switches mail aliases off.
+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)))
+(defcustom message-self-insert-commands '(self-insert-command)
+ "List of `self-insert-command's used to trigger ecomplete.
+When one of those commands is invoked to enter a character in To or Cc
+header, ecomplete will suggest the candidates of recipients (see also
+`message-mail-alias-type'). If you use some tool to enter non-ASCII
+text and it replaces `self-insert-command' with the other command, e.g.
+`egg-self-insert-command', you may want to add it to this list."
+ :group 'message-various
+ :type '(repeat function))
+
(defcustom message-auto-save-directory
(file-name-as-directory (nnheader-concat message-directory "drafts"))
"*Directory where Message auto-saves buffers if Gnus isn't running.
@@ -1101,13 +1204,18 @@
(defcustom message-dont-reply-to-names
(and (boundp 'rmail-dont-reply-to-names) rmail-dont-reply-to-names)
- "*A regexp specifying addresses to prune when doing wide replies.
-A value of nil means exclude your own user name only."
+ "*Addresses to prune when doing wide replies.
+This can be a regexp or a list of regexps. Also, a value of nil means
+exclude your own user name only."
:version "21.1"
:group 'message
:link '(custom-manual "(message)Wide Reply")
:type '(choice (const :tag "Yourself" nil)
- regexp))
+ regexp
+ (repeat :tag "Regexp List" regexp)))
+
+(defsubst message-dont-reply-to-names ()
+ (gmm-regexp-concat message-dont-reply-to-names))
(defvar message-shoot-gnksa-feet nil
"*A list of GNKSA feet you are allowed to shoot.
@@ -1125,14 +1233,28 @@
(or (not (listp message-shoot-gnksa-feet))
(memq feature message-shoot-gnksa-feet)))
-(defcustom message-hidden-headers nil
+(defcustom message-hidden-headers '("^References:" "^Face:" "^X-Face:"
+ "^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."
:version "22.1"
:group 'message
:link '(custom-manual "(message)Message Headers")
- :type '(repeat regexp))
+ :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")))))
+
+(defcustom message-cite-articles-with-x-no-archive t
+ "If non-nil, cite text from articles that has X-No-Archive set."
+ :group 'message
+ :type 'boolean)
;;; Internal variables.
;;; Well, not really internal.
@@ -1148,7 +1270,7 @@
(defface message-header-to
'((((class color)
(background dark))
- (:foreground "green2" :bold t))
+ (:foreground "DarkOliveGreen1" :bold t))
(((class color)
(background light))
(:foreground "MidnightBlue" :bold t))
@@ -1162,7 +1284,7 @@
(defface message-header-cc
'((((class color)
(background dark))
- (:foreground "green4" :bold t))
+ (:foreground "chartreuse1" :bold t))
(((class color)
(background light))
(:foreground "MidnightBlue"))
@@ -1176,7 +1298,7 @@
(defface message-header-subject
'((((class color)
(background dark))
- (:foreground "green3"))
+ (:foreground "OliveDrab1"))
(((class color)
(background light))
(:foreground "navy blue" :bold t))
@@ -1204,7 +1326,7 @@
(defface message-header-other
'((((class color)
(background dark))
- (:foreground "#b00000"))
+ (:foreground "VioletRed1"))
(((class color)
(background light))
(:foreground "steel blue"))
@@ -1218,7 +1340,7 @@
(defface message-header-name
'((((class color)
(background dark))
- (:foreground "DarkGreen"))
+ (:foreground "green"))
(((class color)
(background light))
(:foreground "cornflower blue"))
@@ -1232,7 +1354,7 @@
(defface message-header-xheader
'((((class color)
(background dark))
- (:foreground "blue"))
+ (:foreground "DeepSkyBlue1"))
(((class color)
(background light))
(:foreground "blue"))
@@ -1246,7 +1368,7 @@
(defface message-separator
'((((class color)
(background dark))
- (:foreground "blue3"))
+ (:foreground "LightSkyBlue1"))
(((class color)
(background light))
(:foreground "brown"))
@@ -1260,7 +1382,7 @@
(defface message-cited-text
'((((class color)
(background dark))
- (:foreground "red"))
+ (:foreground "LightPink1"))
(((class color)
(background light))
(:foreground "red"))
@@ -1274,7 +1396,7 @@
(defface message-mml
'((((class color)
(background dark))
- (:foreground "ForestGreen"))
+ (:foreground "MediumSpringGreen"))
(((class color)
(background light))
(:foreground "ForestGreen"))
@@ -1322,13 +1444,13 @@
(1 'message-header-name)
(2 'message-header-newsgroups nil t))
(,(message-font-lock-make-header-matcher
- (concat "^\\([A-Z][^: \n\t]+:\\)" content))
+ (concat "^\\(X-[A-Za-z0-9-]+:\\|In-Reply-To:\\)" content))
(1 'message-header-name)
- (2 'message-header-other nil t))
+ (2 'message-header-xheader))
(,(message-font-lock-make-header-matcher
- (concat "^\\(X-[A-Za-z0-9-]+:\\|In-Reply-To:\\)" content))
+ (concat "^\\([A-Z][^: \n\t]+:\\)" content))
(1 'message-header-name)
- (2 '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) "\\)$")
@@ -1350,10 +1472,10 @@
(put 'message-mode 'font-lock-defaults '(message-font-lock-keywords t))
(defvar message-face-alist
- '((bold . bold-region)
+ '((bold . message-bold-region)
(underline . underline-region)
(default . (lambda (b e)
- (unbold-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.")
@@ -1493,6 +1615,19 @@
(const :tag "Never" nil)
(const :tag "Always" t)))
+(defcustom message-generate-hashcash (if (executable-find "hashcash") t)
+ "*Whether to generate X-Hashcash: headers.
+If `t', always generate hashcash headers. If `opportunistic',
+only generate hashcash headers if it can be done without the user
+waiting (i.e., only asynchronously).
+
+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)))
+
;;; Internal variables.
(defvar message-sending-message "Sending...")
@@ -1575,10 +1710,17 @@
"^|? *---+ +Message text follows: +---+ *|?$")
"A regexp that matches the separator before the text of a failed message.")
+(defvar message-field-fillers
+ '((To message-fill-field-address)
+ (Cc message-fill-field-address)
+ (From message-fill-field-address))
+ "Alist of header names/filler functions.")
+
(defvar message-header-format-alist
- `((Newsgroups)
- (To . message-fill-address)
- (Cc . message-fill-address)
+ `((From)
+ (Newsgroups)
+ (To)
+ (Cc)
(Subject)
(In-Reply-To)
(Fcc)
@@ -1622,28 +1764,32 @@
:type 'regexp)
(eval-and-compile
+ (autoload 'gnus-alive-p "gnus-util")
+ (autoload 'gnus-delay-article "gnus-delay")
+ (autoload 'gnus-extract-address-components "gnus-util")
+ (autoload 'gnus-find-method-for-group "gnus")
+ (autoload 'gnus-group-decoded-name "gnus-group")
+ (autoload 'gnus-group-name-charset "gnus-group")
+ (autoload 'gnus-group-name-decode "gnus-group")
+ (autoload 'gnus-groups-from-server "gnus")
+ (autoload 'gnus-make-local-hook "gnus-util")
+ (autoload 'gnus-open-server "gnus-int")
+ (autoload 'gnus-output-to-mail "gnus-util")
+ (autoload 'gnus-output-to-rmail "gnus-util")
+ (autoload 'gnus-request-post "gnus-int")
+ (autoload 'gnus-select-frame-set-input-focus "gnus-util")
+ (autoload 'gnus-server-string "gnus")
(autoload 'idna-to-ascii "idna")
(autoload 'message-setup-toolbar "messagexmas")
(autoload 'mh-new-draft-name "mh-comp")
(autoload 'mh-send-letter "mh-comp")
- (autoload 'gnus-point-at-eol "gnus-util")
- (autoload 'gnus-point-at-bol "gnus-util")
- (autoload 'gnus-output-to-rmail "gnus-util")
- (autoload 'gnus-output-to-mail "gnus-util")
(autoload 'nndraft-request-associate-buffer "nndraft")
(autoload 'nndraft-request-expire-articles "nndraft")
- (autoload 'gnus-open-server "gnus-int")
- (autoload 'gnus-request-post "gnus-int")
- (autoload 'gnus-alive-p "gnus-util")
- (autoload 'gnus-server-string "gnus")
- (autoload 'gnus-group-name-charset "gnus-group")
- (autoload 'gnus-group-name-decode "gnus-group")
- (autoload 'gnus-groups-from-server "gnus")
- (autoload 'rmail-output "rmailout")
- (autoload 'gnus-delay-article "gnus-delay")
- (autoload 'gnus-make-local-hook "gnus-util")
- (autoload 'gnus-extract-address-components "gnus-util")
- (autoload 'gnus-select-frame-set-input-focus "gnus-util"))
+ (autoload 'nnvirtual-find-group-art "nnvirtual")
+ (autoload 'rmail-dont-reply-to "mail-utils")
+ (autoload 'rmail-msg-is-pruned "rmail")
+ (autoload 'rmail-msg-restore-non-pruned-header "rmail")
+ (autoload 'rmail-output "rmailout"))
@@ -1723,12 +1869,10 @@
The buffer is expected to be narrowed to just the header of the message;
see `message-narrow-to-headers-or-head'."
(let* ((inhibit-point-motion-hooks t)
- (case-fold-search t)
(value (mail-fetch-field header nil (not not-all))))
(when value
(while (string-match "\n[\t ]+" value)
(setq value (replace-match " " t t value)))
- (set-text-properties 0 (length value) nil value)
value)))
(defun message-field-value (header &optional not-all)
@@ -1741,14 +1885,14 @@
(defun message-narrow-to-field ()
"Narrow the buffer to the header on the current line."
(beginning-of-line)
+ (while (looking-at "[ \t]")
+ (forward-line -1))
(narrow-to-region
(point)
(progn
(forward-line 1)
(if (re-search-forward "^[^ \n\t]" nil t)
- (progn
- (beginning-of-line)
- (point))
+ (point-at-bol)
(point-max))))
(goto-char (point-min)))
@@ -1964,28 +2108,30 @@
" (was: "
old-subject ")\n")))))))))
-(defun message-mark-inserted-region (beg end)
+(defun message-mark-inserted-region (beg end &optional verbatim)
"Mark some region in the current article with enclosing tags.
-See `message-mark-insert-begin' and `message-mark-insert-end'."
- (interactive "r")
+See `message-mark-insert-begin' and `message-mark-insert-end'.
+If VERBATIM, use slrn style verbatim marks (\"#v+\" and \"#v-\")."
+ (interactive "r\nP")
(save-excursion
;; add to the end of the region first, otherwise end would be invalid
(goto-char end)
- (insert message-mark-insert-end)
+ (insert (if verbatim "#v-\n" message-mark-insert-end))
(goto-char beg)
- (insert message-mark-insert-begin)))
+ (insert (if verbatim "#v+\n" message-mark-insert-begin))))
-(defun message-mark-insert-file (file)
+(defun message-mark-insert-file (file &optional verbatim)
"Insert FILE at point, marking it with enclosing tags.
-See `message-mark-insert-begin' and `message-mark-insert-end'."
- (interactive "fFile to insert: ")
+See `message-mark-insert-begin' and `message-mark-insert-end'.
+If VERBATIM, use slrn style verbatim marks (\"#v+\" and \"#v-\")."
+ (interactive "fFile to insert: \nP")
;; reverse insertion to get correct result.
(let ((p (point)))
- (insert message-mark-insert-end)
+ (insert (if verbatim "#v-\n" message-mark-insert-end))
(goto-char p)
(insert-file-contents file)
(goto-char p)
- (insert message-mark-insert-begin)))
+ (insert (if verbatim "#v+\n" message-mark-insert-begin))))
(defun message-add-archive-header ()
"Insert \"X-No-Archive: Yes\" in the header and a note in the body.
@@ -2304,6 +2450,14 @@
(1+ max)))))
(message-sort-headers-1))))
+(defun message-kill-address ()
+ "Kill the address under point."
+ (interactive)
+ (let ((start (point)))
+ (message-skip-to-next-address)
+ (kill-region start (point))))
+
+
(defun message-info (&optional arg)
"Display the Message manual.
@@ -2365,6 +2519,7 @@
(define-key message-mode-map "\C-c\C-fw" 'message-insert-wide-reply)
(define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups)
(define-key message-mode-map "\C-c\C-l" 'message-to-list-only)
+ (define-key message-mode-map "\C-c\C-f\C-e" 'message-insert-expires)
(define-key message-mode-map "\C-c\C-u" 'message-insert-or-toggle-importance)
(define-key message-mode-map "\C-c\M-n"
@@ -2385,18 +2540,20 @@
(define-key message-mode-map "\C-c\C-d" 'message-dont-send)
(define-key message-mode-map "\C-c\n" 'gnus-delay-article)
+ (define-key message-mode-map "\C-c\M-k" 'message-kill-address)
(define-key message-mode-map "\C-c\C-e" 'message-elide-region)
(define-key message-mode-map "\C-c\C-v" 'message-delete-not-region)
(define-key message-mode-map "\C-c\C-z" 'message-kill-to-signature)
(define-key message-mode-map "\M-\r" 'message-newline-and-reformat)
- ;;(define-key message-mode-map "\M-q" 'message-fill-paragraph)
(define-key message-mode-map [remap split-line] 'message-split-line)
(define-key message-mode-map "\C-c\C-a" 'mml-attach-file)
(define-key message-mode-map "\C-a" 'message-beginning-of-line)
(define-key message-mode-map "\t" 'message-tab)
- (define-key message-mode-map "\M-;" 'comment-region))
+ (define-key message-mode-map "\M-;" 'comment-region)
+
+ (define-key message-mode-map "\M-n" 'message-display-abbrev))
(easy-menu-define
message-mode-menu message-mode-map "Message Menu."
@@ -2477,7 +2634,8 @@
;; ["Followup-To (with note in body)" message-cross-post-followup-to t]
["Crosspost / Followup-To..." message-cross-post-followup-to t]
["Distribution" message-goto-distribution t]
- ["X-No-Archive:" message-add-archive-header t ]
+ ["Expires" message-insert-expires t ]
+ ["X-No-Archive" message-add-archive-header t ]
"----"
;; (typical) mailing-lists stuff
["Fetch To" message-insert-to
@@ -2497,6 +2655,8 @@
"----"
["Sort Headers" message-sort-headers t]
["Encode non-ASCII domain names" message-idna-to-ascii-rhs t]
+ ;; We hide `message-hidden-headers' by narrowing the buffer.
+ ["Show Hidden Headers" widen t]
["Goto Body" message-goto-body t]
["Goto Signature" message-goto-signature t]))
@@ -2555,19 +2715,23 @@
(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)
+ (eq message-mail-alias-type type)
+ (memq type message-mail-alias-type)))
+
(defun message-strip-forbidden-properties (begin end &optional old-length)
"Strip forbidden properties between BEGIN and END, ignoring the third arg.
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))
+ (message-display-abbrev))
(when (and message-strip-special-text-properties
(message-tamago-not-in-use-p begin))
(let ((buffer-read-only nil)
(inhibit-read-only t))
- (while (not (= begin end))
- (when (not (get-text-property begin 'message-hidden))
- (remove-text-properties begin (1+ begin)
- message-forbidden-properties))
- (incf begin)))))
+ (remove-text-properties begin end message-forbidden-properties))))
;;;###autoload
(define-derived-mode message-mode text-mode "Message"
@@ -2584,6 +2748,7 @@
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: <Old Subject>)\"
C-c C-f x crossposting with FollowUp-To header and note in body
@@ -2632,6 +2797,9 @@
(set (make-local-variable 'message-checksum) nil)
(set (make-local-variable 'message-mime-part) 0)
(message-setup-fill-variables)
+ (when message-fill-column
+ (setq fill-column message-fill-column)
+ (turn-on-auto-fill))
;; Allow using comment commands to add/remove quoting.
;; (set (make-local-variable 'comment-start) message-yank-prefix)
(when message-yank-prefix
@@ -2651,11 +2819,14 @@
(add-hook 'after-change-functions 'message-strip-forbidden-properties
nil 'local)
;; Allow mail alias things.
- (when (eq message-mail-alias-type 'abbrev)
+ (cond
+ ((message-mail-alias-type-p 'abbrev)
(if (fboundp 'mail-abbrevs-setup)
(mail-abbrevs-setup)
(if (fboundp 'mail-aliases-setup) ; warning avoidance
(mail-aliases-setup))))
+ ((message-mail-alias-type-p 'ecomplete)
+ (ecomplete-setup)))
(unless buffer-file-name
(message-set-auto-save-file-name))
(unless (buffer-base-buffer)
@@ -2961,22 +3132,30 @@
(when (message-goto-signature)
(forward-line -2)))
-(defun message-kill-to-signature ()
- "Deletes all text up to the signature."
- (interactive)
+(defun message-kill-to-signature (&optional arg)
+ "Kill all text up to the signature.
+If a numberic argument or prefix arg is given, leave that number
+of lines before the signature intact."
+ (interactive "P")
+ (save-excursion
+ (save-restriction
(let ((point (point)))
+ (narrow-to-region point (point-max))
(message-goto-signature)
(unless (eobp)
- (end-of-line -1))
+ (if (and arg (numberp arg))
+ (forward-line (- -1 arg))
+ (end-of-line -1)))
+ (unless (= point (point))
(kill-region point (point))
(unless (bolp)
- (insert "\n"))))
+ (insert "\n")))))))
(defun message-newline-and-reformat (&optional arg not-break)
"Insert four newlines, and then reformat if inside quoted text.
Prefix arg means justify as well."
(interactive (list (if current-prefix-arg 'full)))
- (let (quoted point beg end leading-space bolp)
+ (let (quoted point beg end leading-space bolp fill-paragraph-function)
(setq point (point))
(beginning-of-line)
(setq beg (point))
@@ -3061,22 +3240,22 @@
(if point (goto-char point)))))
(defun message-fill-paragraph (&optional arg)
- "Like `fill-paragraph'."
+ "Message specific function to fill a paragraph.
+This function is used as the value of `fill-paragraph-function' in
+Message buffers and is not meant to be called directly."
(interactive (list (if current-prefix-arg 'full)))
(if (if (boundp 'filladapt-mode) filladapt-mode)
nil
- (message-newline-and-reformat arg t)
+ (if (message-point-in-header-p)
+ (message-fill-field)
+ (message-newline-and-reformat arg t))
t))
-;; Is it better to use `mail-header-end'?
(defun message-point-in-header-p ()
"Return t if point is in the header."
(save-excursion
- (let ((p (point)))
- (goto-char (point-min))
- (not (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "\n")
- p t)))))
+ (not (re-search-backward
+ (concat "^" (regexp-quote mail-header-separator) "\n") nil t))))
(defun message-do-auto-fill ()
"Like `do-auto-fill', but don't fill in message header."
@@ -3101,13 +3280,21 @@
((listp message-signature)
(eval message-signature))
(t message-signature)))
- (signature
+ signature-file)
+ (setq signature
(cond ((stringp signature)
signature)
- ((and (eq t signature)
- message-signature-file
- (file-exists-p message-signature-file))
- 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)))
+ (nnheader-concat message-signature-directory
+ message-signature-file)
+ message-signature-file))
+ (file-exists-p signature-file))))
(when signature
(goto-char (point-max))
;; Insert the signature.
@@ -3117,7 +3304,7 @@
(insert "\n"))
(insert "-- \n")
(if (eq signature t)
- (insert-file-contents message-signature-file)
+ (insert-file-contents signature-file)
(insert signature))
(goto-char (point-max))
(or (bolp) (insert "\n")))))
@@ -3222,17 +3409,17 @@
(substring table ?a (+ ?a n))
(substring table (+ ?a 26) 255))))
-(defun message-caesar-buffer-body (&optional rotnum)
+(defun message-caesar-buffer-body (&optional rotnum wide)
"Caesar rotate all letters in the current buffer by 13 places.
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."
+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)))
(save-excursion
(save-restriction
- (when (message-goto-body)
+ (when (and (not wide) (message-goto-body))
(narrow-to-region (point) (point-max)))
(message-caesar-region (point-min) (point-max) rotnum))))
@@ -3279,14 +3466,15 @@
(let ((fill-prefix message-yank-prefix))
(fill-individual-paragraphs (point) (point-max) justifyp))))
-(defun message-indent-citation ()
+(defun message-indent-citation (&optional start end yank-only)
"Modify text just inserted from a message to be cited.
The inserted text should be the region.
When this function returns, the region is again around the modified text.
Normally, indent each nonblank line `message-indentation-spaces' spaces.
However, if `message-yank-prefix' is non-nil, insert that prefix on each line."
- (let ((start (point)))
+ (unless start (setq start (point)))
+ (unless yank-only
;; Remove unwanted headers.
(when message-ignored-cited-headers
(let (all-removed)
@@ -3314,18 +3502,53 @@
(insert "\n"))
(while (and (zerop (forward-line -1))
(looking-at "$"))
- (message-delete-line))
+ (message-delete-line)))
;; Do the indentation.
(if (null message-yank-prefix)
- (indent-rigidly start (mark t) message-indentation-spaces)
+ (indent-rigidly start (or end (mark t)) message-indentation-spaces)
(save-excursion
(goto-char start)
- (while (< (point) (mark t))
- (if (or (looking-at ">") (looking-at "^$"))
- (insert message-yank-cited-prefix)
- (insert message-yank-prefix))
+ (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))))
- (goto-char start)))
+ (goto-char start))
+
+(defun message-remove-blank-cited-lines (&optional remove)
+ "Remove cited lines containing only blanks.
+If REMOVE is non-nil, remove newlines, too.
+
+To use this automatically, you may add this function to
+`gnus-message-setup-hook'."
+ (interactive "P")
+ (let ((citexp
+ (concat
+ "^\\("
+ (if (boundp 'message-yank-cited-prefix)
+ (concat message-yank-cited-prefix "\\|"))
+ message-yank-prefix
+ "\\)+ *$"
+ (if remove "\n" ""))))
+ (gnus-message 8 "removing `%s'" citexp)
+ (save-excursion
+ (message-goto-body)
+ (while (re-search-forward citexp nil t)
+ (replace-match "")))))
+
+(defvar message-cite-reply-above nil
+ "If non-nil, start own text above the quote.
+
+Note: Top posting is bad netiquette. Don't use it unless you
+really must. You probably want to set variable only for specific
+groups, e.g. using `gnus-posting-styles':
+
+ (eval (set (make-local-variable 'message-cite-reply-above) t))
+
+This variable has no effect in news postings.")
(defun message-yank-original (&optional arg)
"Insert the message being replied to, if any.
@@ -3338,9 +3561,22 @@
Just \\[universal-argument] as argument means don't indent, insert no
prefix, and don't delete any headers."
(interactive "P")
- (let ((modified (buffer-modified-p)))
+ (let ((modified (buffer-modified-p))
+ body-text)
(when (and message-reply-buffer
message-cite-function)
+ (when message-cite-reply-above
+ (if (and (not (message-news-p))
+ (or (eq message-cite-reply-above 'is-evil)
+ (y-or-n-p "\
+Top posting is bad netiquette. Please don't top post unless you really must.
+Really top post? ")))
+ (save-excursion
+ (setq body-text
+ (buffer-substring (message-goto-body)
+ (point-max)))
+ (delete-region (message-goto-body) (point-max)))
+ (set (make-local-variable 'message-cite-reply-above) nil)))
(delete-windows-on message-reply-buffer t)
(push-mark (save-excursion
(insert-buffer-substring message-reply-buffer)
@@ -3354,6 +3590,13 @@
(goto-char (mark t))
(insert-before-markers ?\n)
(goto-char pt))))
+ (when message-cite-reply-above
+ (message-goto-body)
+ (insert body-text)
+ (insert (if (bolp) "\n" "\n\n"))
+ (message-goto-body))
+ ;; Add a `message-setup-very-last-hook' here?
+ ;; Add `gnus-article-highlight-citation' here?
(unless modified
(setq message-checksum (message-checksum))))))
@@ -3375,10 +3618,20 @@
(push (buffer-name buffer) buffers))))
(nreverse buffers)))
-(defun message-cite-original-without-signature ()
- "Cite function in the standard Message manner."
+(eval-when-compile (defvar mail-citation-hook)) ; Compiler directive
+
+(defun message-cite-original-1 (strip-signature)
+ "Cite an original message.
+If STRIP-SIGNATURE is non-nil, strips off the signature from the
+original message.
+
+This function uses `mail-citation-hook' if that is non-nil."
+ (if (and (boundp '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)
@@ -3391,6 +3644,7 @@
(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")
@@ -3399,6 +3653,7 @@
(message-fetch-field "references")
0 0 ""))))
(mml-quote-region start end)
+ (when strip-signature
;; Allow undoing.
(undo-boundary)
(goto-char end)
@@ -3411,50 +3666,116 @@
(delete-region (point) end)
(unless (search-backward "\n\n" start t)
;; Insert a blank line if it is peeled off.
- (insert "\n")))
+ (insert "\n"))))
(goto-char start)
- (while functions
- (funcall (pop functions)))
+ (mapc 'funcall functions)
(when message-citation-line-function
(unless (bolp)
(insert "\n"))
- (funcall message-citation-line-function))))
+ (funcall message-citation-line-function))
+ (when (and x-no-archive
+ (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)))))
-(eval-when-compile (defvar mail-citation-hook)) ;Compiler directive
(defun message-cite-original ()
"Cite function in the standard Message manner."
- (if (and (boundp 'mail-citation-hook)
- mail-citation-hook)
- (run-hooks 'mail-citation-hook)
- (let* ((start (point))
- (end (mark t))
- (functions
- (when message-indent-citation-function
- (if (listp message-indent-citation-function)
- message-indent-citation-function
- (list message-indent-citation-function))))
- ;; This function may be called by `gnus-summary-yank-message' and
- ;; may insert a different article from the original. So, we will
- ;; modify the value of `message-reply-headers' with that article.
- (message-reply-headers
- (save-restriction
- (narrow-to-region start end)
- (message-narrow-to-head-1)
- (vector 0
- (or (message-fetch-field "subject") "none")
- (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)
- (goto-char start)
- (while functions
- (funcall (pop functions)))
- (when message-citation-line-function
- (unless (bolp)
- (insert "\n"))
- (funcall message-citation-line-function)))))
+ (message-cite-original-1 nil))
+
+(defun message-insert-formated-citation-line (&optional from date)
+ "Function that inserts a formated citation line.
+
+See `message-citation-line-format'."
+ ;; The optional args are for testing/debugging. They will disappear later.
+ ;; Example:
+ ;; (with-temp-buffer
+ ;; (message-insert-formated-citation-line
+ ;; "John Doe <address@hidden>"
+ ;; (current-time))
+ ;; (buffer-string))
+ (when (or message-reply-headers (and from date))
+ (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))
+ (replydate
+ (or
+ date
+ ;; We need Gnus functionality if the user wants date or time from
+ ;; the original article:
+ (when (string-match "%[^fnNFL]" message-citation-line-format)
+ (autoload 'gnus-date-get-time "gnus-util")
+ (gnus-date-get-time (mail-header-date message-reply-headers)))))
+ (flist
+ (let ((i ?A) lst)
+ (when (stringp name)
+ ;; Guess first name and last name:
+ (cond ((string-match
+ "\\`\\(\\w\\|[-.]\\)+ \\(\\w\\|[-.]\\)+\\'" name)
+ (setq fname (nth 0 (split-string name "[ \t]+"))
+ lname (nth 1 (split-string name "[ \t]+"))))
+ ((string-match
+ "\\`\\(\\w\\|[-.]\\)+, \\(\\w\\|[-.]\\)+\\'" name)
+ (setq fname (nth 1 (split-string name "[ \t,]+"))
+ lname (nth 0 (split-string name "[ \t,]+"))))
+ ((string-match
+ "\\`\\(\\w\\|[-.]\\)+\\'" name)
+ (setq fname name
+ lname ""))))
+ ;; The following letters are not used in `format-time-string':
+ (push ?E lst) (push "<E>" lst)
+ (push ?F lst) (push fname lst)
+ ;; We might want to use "" instead of "<X>" later.
+ (push ?J lst) (push "<J>" lst)
+ (push ?K lst) (push "<K>" lst)
+ (push ?L lst) (push lname lst)
+ (push ?N lst) (push name-or-net lst)
+ (push ?O lst) (push "<O>" lst)
+ (push ?P lst) (push "<P>" lst)
+ (push ?Q lst) (push "<Q>" lst)
+ (push ?f lst) (push from lst)
+ (push ?i lst) (push "<i>" lst)
+ (push ?n lst) (push net lst)
+ (push ?o lst) (push "<o>" lst)
+ (push ?q lst) (push "<q>" lst)
+ (push ?t lst) (push "<t>" lst)
+ (push ?v lst) (push "<v>" 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
+ (progn (format-time-string (format "%%%c" i)
+ replydate))
+ (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)))
+
+(defun message-cite-original-without-signature ()
+ "Cite function in the standard Message manner.
+This function strips off the signature from the original message."
+ (message-cite-original-1 t))
(defun message-insert-citation-line ()
"Insert a simple citation line."
@@ -3548,6 +3869,7 @@
"Kill the current buffer."
(interactive)
(when (or (not (buffer-modified-p))
+ (not message-kill-buffer-query)
(yes-or-no-p "Message modified; kill anyway? "))
(let ((actions message-kill-actions)
(draft-article message-draft-article)
@@ -3640,6 +3962,9 @@
(save-excursion
(run-hooks 'message-sent-hook))
(message "Sending...done")
+ ;; Do ecomplete address snarfing.
+ (when (message-mail-alias-type-p '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)
@@ -3667,16 +3992,31 @@
(put 'message-check 'lisp-indent-function 1)
(put 'message-check 'edebug-form-spec '(form body))
-(defun message-text-with-property (prop)
- "Return a list of all points where the text has PROP."
- (let ((points nil)
- (point (point-min)))
- (save-excursion
- (while (< point (point-max))
- (when (get-text-property point prop)
- (push point points))
- (incf point)))
- (nreverse points)))
+(defun message-text-with-property (prop &optional start end reverse)
+ "Return a list of start and end positions where the text has PROP.
+START and END bound the search, they default to `point-min' and
+`point-max' respectively. If REVERSE is non-nil, find text which does
+not have PROP."
+ (unless start
+ (setq start (point-min)))
+ (unless end
+ (setq end (point-max)))
+ (let (next regions)
+ (if reverse
+ (while (and start
+ (setq start (text-property-any start end prop nil)))
+ (setq next (next-single-property-change start prop nil end))
+ (push (cons start (or next end)) regions)
+ (setq start next))
+ (while (and start
+ (or (get-text-property start prop)
+ (and (setq start (next-single-property-change
+ start prop nil end))
+ (get-text-property start prop))))
+ (setq next (text-property-any start end prop nil))
+ (push (cons start (or next end)) regions)
+ (setq start next)))
+ (nreverse regions)))
(defun message-fix-before-sending ()
"Do various things to make the message nice before sending it."
@@ -3685,44 +4025,49 @@
(unless (bolp)
(insert "\n"))
;; Make the hidden headers visible.
- (let ((points (message-text-with-property 'message-hidden)))
- (when points
- (goto-char (car points))
- (dolist (point points)
- (add-text-properties point (1+ point)
- '(invisible nil intangible nil)))))
+ (widen)
+ ;; Sort headers before sending the message.
+ (message-sort-headers)
;; Make invisible text visible.
;; It doesn't seem as if this is useful, since the invisible property
;; is clobbered by an after-change hook anyhow.
(message-check 'invisible-text
- (let ((points (message-text-with-property 'invisible)))
- (when points
- (goto-char (car points))
- (dolist (point points)
- (put-text-property point (1+ point) 'invisible nil)
- (message-overlay-put (message-make-overlay point (1+ point))
+ (let ((regions (message-text-with-property 'invisible))
+ from to)
+ (when regions
+ (while regions
+ (setq from (caar regions)
+ to (cdar regions)
+ regions (cdr regions))
+ (put-text-property from to 'invisible nil)
+ (message-overlay-put (message-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 (found choice)
+ (let (char found choice)
(message-goto-body)
+ (while (progn
(skip-chars-forward mm-7bit-chars)
- (while (not (eobp))
- (when (let ((char (char-after)))
- (or (< (mm-char-int char) 128)
+ (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 (< (mm-char-int char) 128)
(and (mm-multibyte-p)
(memq (char-charset char)
'(eight-bit-control eight-bit-graphic
control-1))
(not (get-text-property
- (point) 'untranslated-utf-8)))))
+ (point) 'untranslated-utf-8))))
(message-overlay-put (message-make-overlay (point) (1+ (point)))
'face 'highlight)
(setq found t))
- (forward-char)
- (skip-chars-forward mm-7bit-chars))
+ (forward-char))
(when found
(setq choice
(gnus-multiple-choice
@@ -3773,16 +4118,15 @@
(defun message-do-actions (actions)
"Perform all actions in ACTIONS."
;; Now perform actions on successful sending.
- (while actions
+ (dolist (action actions)
(ignore-errors
(cond
;; A simple function.
- ((functionp (car actions))
- (funcall (car actions)))
+ ((functionp action)
+ (funcall action))
;; Something to be evaled.
(t
- (eval (car actions)))))
- (pop actions)))
+ (eval action))))))
(defun message-send-mail-partially ()
"Send mail as message/partial."
@@ -3867,6 +4211,15 @@
(gnus-setup-posting-charset nil)
message-posting-charset))
(headers message-required-mail-headers))
+ (when (and message-generate-hashcash
+ (not (eq message-generate-hashcash 'opportunistic)))
+ (message "Generating hashcash...")
+ ;; Wait for calculations already started to finish...
+ (hashcash-wait-async)
+ ;; ...and do calculations not already done. mail-add-payment
+ ;; will leave existing X-Hashcash headers alone.
+ (mail-add-payment)
+ (message "Generating hashcash...done"))
(save-restriction
(message-narrow-to-headers)
;; Generate the Mail-Followup-To header if the header is not there...
@@ -4003,8 +4356,7 @@
(when (eval message-mailer-swallows-blank-line)
(newline))
(when message-interactive
- (save-excursion
- (set-buffer errbuf)
+ (with-current-buffer errbuf
(erase-buffer))))
(let* ((default-directory "/")
(coding-system-for-write message-send-coding-system)
@@ -4022,6 +4374,7 @@
"/usr/ucblib/sendmail")
(t "fakemail"))
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
@@ -4045,7 +4398,7 @@
(save-excursion
(set-buffer errbuf)
(goto-char (point-min))
- (while (re-search-forward "\n\n* *" nil t)
+ (while (re-search-forward "\n+ *" nil t)
(replace-match "; "))
(if (not (zerop (buffer-size)))
(error "Sending...failed to %s"
@@ -4753,29 +5106,27 @@
(when (re-search-forward ",+$" nil t)
(replace-match "" t t))))))
-(eval-when-compile (require 'parse-time))
(defun message-make-date (&optional now)
"Make a valid data header.
If NOW, use that time instead."
- (require 'parse-time)
- (let* ((now (or now (current-time)))
- (zone (nth 8 (decode-time now)))
- (sign "+"))
- (when (< zone 0)
- (setq sign "-")
- (setq zone (- zone)))
- (concat
- ;; The day name of the %a spec is locale-specific. Pfff.
- (format "%s, " (capitalize (car (rassoc (nth 6 (decode-time now))
- parse-time-weekdays))))
- (format-time-string "%d" now)
- ;; The month name of the %b spec is locale-specific. Pfff.
- (format " %s "
- (capitalize (car (rassoc (nth 4 (decode-time now))
- parse-time-months))))
- (format-time-string "%Y %H:%M:%S " now)
- ;; We do all of this because XEmacs doesn't have the %z spec.
- (format "%s%02d%02d" sign (/ zone 3600) (/ (% zone 3600) 60)))))
+ (let ((system-time-locale "C"))
+ (format-time-string "%a, %d %b %Y %T %z" now)))
+
+(defun message-insert-expires (days)
+ "Insert the Expires header. Expiry in DAYS days."
+ (interactive "NExpire article in how many days? ")
+ (save-excursion
+ (message-position-on-field "Expires" "X-Draft-From")
+ (insert (message-make-expires-date days))))
+
+(defun message-make-expires-date (days)
+ "Make date string for the Expires header. Expiry in DAYS days.
+
+In posting styles use `(\"Expires\" (make-expires-date 30))'."
+ (let* ((cur (decode-time (current-time)))
+ (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."
@@ -4940,12 +5291,12 @@
(concat message-user-path "!" login-name))
(t login-name))))
-(defun message-make-from ()
+(defun message-make-from (&optional name address )
"Make a From header."
(let* ((style message-from-style)
- (login (message-make-address))
- (fullname
- (or (and (boundp 'user-full-name)
+ (login (or address (message-make-address)))
+ (fullname (or name
+ (and (boundp 'user-full-name)
user-full-name)
(user-full-name))))
(when (string= fullname "&")
@@ -5279,19 +5630,21 @@
(if formatter
(funcall formatter header value)
(insert header-string ": " value))
+ (goto-char (message-fill-field))
;; We check whether the value was ended by a
- ;; newline. If now, we insert one.
+ ;; newline. If not, we insert one.
(unless (bolp)
(insert "\n"))
(forward-line -1)))
;; The value of this header was empty, so we clear
;; totally and insert the new value.
- (delete-region (point) (gnus-point-at-eol))
+ (delete-region (point) (point-at-eol))
;; If the header is optional, and the header was
- ;; empty, we con't insert it anyway.
+ ;; empty, we can't insert it anyway.
(unless optionalp
(push header-string message-inserted-headers)
- (insert value)))
+ (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 "[^:]+: "))
@@ -5347,35 +5700,29 @@
;;; Setting up a message buffer
;;;
+(defun message-skip-to-next-address ()
+ (let ((end (save-excursion
+ (message-next-header)
+ (point)))
+ quoted char)
+ (when (looking-at ",")
+ (forward-char 1))
+ (while (and (not (= (point) end))
+ (or (not (eq char ?,))
+ quoted))
+ (skip-chars-forward "^,\"" (point-max))
+ (when (eq (setq char (following-char)) ?\")
+ (setq quoted (not quoted)))
+ (unless (= (point) end)
+ (forward-char 1)))
+ (skip-chars-forward " \t\n")))
+
(defun message-fill-address (header value)
- (save-restriction
- (narrow-to-region (point) (point))
(insert (capitalize (symbol-name header))
": "
(if (consp value) (car value) value)
"\n")
- (narrow-to-region (point-min) (1- (point-max)))
- (let (quoted last)
- (goto-char (point-min))
- (while (not (eobp))
- (skip-chars-forward "^,\"" (point-max))
- (if (or (eq (char-after) ?,)
- (eobp))
- (when (not quoted)
- (if (and (> (current-column) 78)
- last)
- (progn
- (save-excursion
- (goto-char last)
- (insert "\n\t"))
- (setq last (1+ (point))))
- (setq last (1+ (point)))))
- (setq quoted (not quoted)))
- (unless (eobp)
- (forward-char 1))))
- (goto-char (point-max))
- (widen)
- (forward-line 1)))
+ (message-fill-field-address))
(defun message-split-line ()
"Split current line, moving portion beyond point vertically down.
@@ -5386,26 +5733,56 @@
(error
(split-line))))
-(defun message-fill-header (header value)
- (let ((begin (point))
- (fill-column 78)
- (fill-prefix "\t"))
+(defun message-insert-header (header value)
(insert (capitalize (symbol-name header))
": "
- (if (consp value) (car value) value)
- "\n")
+ (if (consp value) (car value) value)))
+
+(defun message-field-name ()
+ (save-excursion
+ (goto-char (point-min))
+ (when (looking-at "\\([^:]+\\):")
+ (intern (capitalize (match-string 1))))))
+
+(defun message-fill-field ()
+ (save-excursion
(save-restriction
- (narrow-to-region begin (point))
- (fill-region-as-paragraph begin (point))
+ (message-narrow-to-field)
+ (let ((field-name (message-field-name)))
+ (funcall (or (cadr (assq field-name message-field-fillers))
+ 'message-fill-field-general)))
+ (point-max))))
+
+(defun message-fill-field-address ()
+ (while (not (eobp))
+ (message-skip-to-next-address)
+ (let (last)
+ (if (and (> (current-column) 78)
+ last)
+ (progn
+ (save-excursion
+ (goto-char last)
+ (insert "\n\t"))
+ (setq last (1+ (point))))
+ (setq last (1+ (point)))))))
+
+(defun message-fill-field-general ()
+ (let ((begin (point))
+ (fill-column 78)
+ (fill-prefix "\t"))
+ (while (and (search-forward "\n" nil t)
+ (not (eobp)))
+ (replace-match " " t t))
+ (fill-region-as-paragraph begin (point-max))
;; Tapdance around looong Message-IDs.
(forward-line -1)
(when (looking-at "[ \t]*$")
(message-delete-line))
(goto-char begin)
- (re-search-forward ":" nil t)
+ (search-forward ":" nil t)
(when (looking-at "\n[ \t]+")
(replace-match " " t t))
- (goto-char (point-max)))))
+ (goto-char (point-max))))
(defun message-shorten-1 (list cut surplus)
"Cut SURPLUS elements out of LIST, beginning with CUTth one."
@@ -5414,8 +5791,9 @@
(defun message-shorten-references (header references)
"Trim REFERENCES to be 21 Message-ID long or less, and fold them.
-If folding is disallowed, also check that the REFERENCES are less
-than 988 characters long, and if they are not, trim them until they are."
+When sending via news, also check that the REFERENCES are less
+than 988 characters long, and if they are not, trim them until
+they are."
(let ((maxcount 21)
(count 0)
(cut 2)
@@ -5437,33 +5815,26 @@
(message-shorten-1 refs cut surplus)
(decf count surplus)))
- ;; If folding is disallowed, make sure the total length (including
- ;; the spaces between) will be less than MAXSIZE characters.
+ ;; When sending via news, make sure the total folded length will
+ ;; be less than 998 characters. This is to cater to broken INN
+ ;; 2.3 which counts the total number of characters in a header
+ ;; rather than the physical line length of each line, as it should.
;;
- ;; Only disallow folding for News messages. At this point the headers
- ;; have not been generated, thus we use message-this-is-news directly.
- (when (and message-this-is-news message-cater-to-broken-inn)
- (let ((maxsize 988)
- (totalsize (+ (apply #'+ (mapcar #'length refs))
- (1- count)))
- (surplus 0)
- (ptr (nthcdr (1- cut) refs)))
- ;; Decide how many elements to cut off...
- (while (> totalsize maxsize)
- (decf totalsize (1+ (length (car ptr))))
- (incf surplus)
- (setq ptr (cdr ptr)))
- ;; ...and do it.
- (when (> surplus 0)
- (message-shorten-1 refs cut surplus))))
-
+ ;; This hack should be removed when it's believed than INN 2.3 is
+ ;; no longer widely used.
+ ;;
+ ;; At this point the headers have not been generated, thus we use
+ ;; message-this-is-news directly.
+ (when message-this-is-news
+ (while (< 998
+ (with-temp-buffer
+ (message-insert-header
+ header (mapconcat #'identity refs " "))
+ (buffer-size)))
+ (message-shorten-1 refs cut 1)))
;; Finally, collect the references back into a string and insert
;; it into the buffer.
- (let ((refstring (mapconcat #'identity refs " ")))
- (if (and message-this-is-news message-cater-to-broken-inn)
- (insert (capitalize (symbol-name header)) ": "
- refstring "\n")
- (message-fill-header header refstring)))))
+ (message-insert-header header (mapconcat #'identity refs " "))))
(defun message-position-point ()
"Move point to where the user probably wants to find it."
@@ -5513,7 +5884,7 @@
(message-point-in-header-p))
(let* ((here (point))
(bol (progn (beginning-of-line n) (point)))
- (eol (gnus-point-at-eol))
+ (eol (point-at-eol))
(eoh (re-search-forward ": *" eol t)))
(goto-char
(if (and eoh (or (< eoh here) (= bol here)))
@@ -5726,12 +6097,7 @@
(when message-default-headers
(insert message-default-headers)
(or (bolp) (insert ?\n)))
- (put-text-property
- (point)
- (progn
(insert mail-header-separator "\n")
- (1- (point)))
- 'read-only nil)
(forward-line -1)
(when (message-news-p)
(when message-default-news-headers
@@ -5762,6 +6128,9 @@
(run-hooks 'message-header-setup-hook))
(set-buffer-modified-p nil)
(setq buffer-undo-list nil)
+ (when message-generate-hashcash
+ ;; Generate hashcash headers for recipients already known
+ (mail-add-payment-async))
(run-hooks 'message-setup-hook)
;; Do this last to give it precedence over posting styles, etc.
(when (message-mail-p)
@@ -5864,7 +6233,7 @@
(Subject . ,(or subject ""))))))
(defun message-get-reply-headers (wide &optional to-address address-headers)
- (let (follow-to mct never-mct to cc author mft recipients)
+ (let (follow-to mct never-mct to cc author mft recipients extra)
;; Find all relevant headers we need.
(save-restriction
(message-narrow-to-headers-or-head)
@@ -5876,6 +6245,11 @@
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")
@@ -5940,6 +6314,7 @@
(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 ", ".
@@ -5948,7 +6323,7 @@
(while (string-match "[ \t][ \t]+" recipients)
(setq recipients (replace-match " " t t recipients)))
;; Remove addresses that match `rmail-dont-reply-to-names'.
- (let ((rmail-dont-reply-to-names message-dont-reply-to-names))
+ (let ((rmail-dont-reply-to-names (message-dont-reply-to-names)))
(setq recipients (rmail-dont-reply-to recipients)))
;; Perhaps "Mail-Copies-To: never" removed the only address?
(if (string-equal recipients "")
@@ -6233,8 +6608,8 @@
;; Email address in From field equals to our address
(and (setq from (message-fetch-field "from"))
(string-equal
- (downcase (cadr (mail-extract-address-components from)))
- (downcase (cadr (mail-extract-address-components
+ (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
@@ -6242,7 +6617,7 @@
message-alternative-emails
(string-match
message-alternative-emails
- (cadr (mail-extract-address-components from))))))))))
+ (car (mail-header-parse-address from))))))))))
;;;###autoload
(defun message-cancel-news (&optional arg)
@@ -6382,7 +6757,9 @@
(prefix
(if group
(gnus-group-decoded-name group)
- (or (and from (car (gnus-extract-address-components from)))
+ (or (and from (or
+ (car (gnus-extract-address-components from))
+ (cadr (gnus-extract-address-components from))))
"(nowhere)"))))
(concat "["
(if message-forward-decoded-p
@@ -6428,7 +6805,7 @@
subject
(mail-decode-encoded-word-string subject))
""))
- (if message-wash-forwarded-subjects
+ (when message-wash-forwarded-subjects
(setq subject (message-wash-subject subject)))
;; Make sure funcs is a list.
(and funcs
@@ -6436,10 +6813,9 @@
(setq funcs (list funcs)))
;; Apply funcs in order, passing subject generated by previous
;; func to the next one.
- (while funcs
- (when (functionp (car funcs))
- (setq subject (funcall (car funcs) subject)))
- (setq funcs (cdr funcs)))
+ (dolist (func funcs)
+ (when (functionp func)
+ (setq subject (funcall func subject))))
subject))))
(eval-when-compile
@@ -6482,17 +6858,24 @@
(setq e (point))
(insert
"\n-------------------- End of forwarded message --------------------\n")
+ (message-remove-ignored-headers b e)))
+
+(defun message-remove-ignored-headers (b e)
(when message-forward-ignored-headers
(save-restriction
(narrow-to-region b e)
(goto-char b)
(narrow-to-region (point)
(or (search-forward "\n\n" nil t) (point)))
- (message-remove-header message-forward-ignored-headers t)))))
+ (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))))))
(defun message-forward-make-body-mime (forward-buffer)
+ (let ((b (point)))
(insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n")
- (let ((b (point)) e)
(save-restriction
(narrow-to-region (point) (point))
(mml-insert-buffer forward-buffer)
@@ -6500,8 +6883,11 @@
(when (looking-at "From ")
(replace-match "X-From-Line: "))
(goto-char (point-max)))
- (setq e (point))
- (insert "<#/part>\n")))
+ (insert "<#/part>\n")
+ ;; Consider there is no illegible text.
+ (add-text-properties
+ b (point)
+ `(no-illegible-text t rear-nonsticky t start-open t))))
(defun message-forward-make-body-mml (forward-buffer)
(insert "\n\n<#mml type=message/rfc822 disposition=inline>\n")
@@ -6530,12 +6916,7 @@
(insert "<#/mml>\n")
(when (and (not message-forward-decoded-p)
message-forward-ignored-headers)
- (save-restriction
- (narrow-to-region b e)
- (goto-char b)
- (narrow-to-region (point)
- (or (search-forward "\n\n" nil t) (point)))
- (message-remove-header message-forward-ignored-headers t)))))
+ (message-remove-ignored-headers b e))))
(defun message-forward-make-body-digest-plain (forward-buffer)
(insert
@@ -6564,6 +6945,62 @@
(message-forward-make-body-digest-mime forward-buffer)
(message-forward-make-body-digest-plain forward-buffer)))
+(eval-and-compile
+ (autoload 'mm-uu-dissect-text-parts "mm-uu")
+ (autoload 'mm-uu-dissect "mm-uu"))
+
+(defun message-signed-or-encrypted-p (&optional dont-emulate-mime handles)
+ "Say whether the current buffer contains signed or encrypted message.
+If DONT-EMULATE-MIME is nil, this function does the MIME emulation on
+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))
+ (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))))))
+ ;; 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))
+ (with-temp-buffer
+ (insert-buffer-substring cur)
+ (when (setq handles (mm-dissect-buffer t t))
+ (if (and (prog1
+ (bufferp (car handles))
+ (mm-destroy-parts handles))
+ (equal (mm-handle-media-type handles) "text/plain"))
+ (progn
+ (mm-decode-content-transfer-encoding
+ (mm-handle-encoding handles))
+ (setq handles (mm-uu-dissect)))
+ (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)))))))
+ (mm-destroy-parts handles))))
+
;;;###autoload
(defun message-forward-make-body (forward-buffer &optional digest)
;; Put point where we want it before inserting the forwarded
@@ -6576,11 +7013,13 @@
(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
- (goto-char (point-min))
- (re-search-forward
- "Content-Type:
*multipart/\\(signed\\|encrypted\\)"
- nil t)))))
+ (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)))
@@ -6590,8 +7029,6 @@
(defun message-forward-rmail-make-body (forward-buffer)
(save-window-excursion
(set-buffer forward-buffer)
- ;; Rmail doesn't have rmail-msg-restore-non-pruned-header in Emacs
- ;; 20. FIXIT, or we drop support for rmail in Emacs 20.
(if (rmail-msg-is-pruned)
(rmail-msg-restore-non-pruned-header)))
(message-forward-make-body forward-buffer))
@@ -6621,6 +7058,7 @@
(set-buffer (get-buffer-create " *message resend*"))
(erase-buffer))
(let ((message-this-is-mail t)
+ message-generate-hashcash
message-setup-hook)
(message-setup `((To . ,address))))
;; Insert our usual headers.
@@ -6658,6 +7096,7 @@
;; Send it.
(let ((message-inhibit-body-encoding t)
message-required-mail-headers
+ message-generate-hashcash
rfc2047-encode-encoded-words)
(message-send-mail))
(kill-buffer (current-buffer)))
@@ -6772,7 +7211,7 @@
;; This code should be moved to underline.el (from which it is stolen).
;;;###autoload
-(defun bold-region (start end)
+(defun message-bold-region (start end)
"Bold all nonblank characters in the region.
Works by overstriking characters.
Called from program, takes two arguments START and END
@@ -6788,7 +7227,7 @@
(forward-char 1)))))
;;;###autoload
-(defun unbold-region (start end)
+(defun message-unbold-region (start end)
"Remove all boldness (overstruck characters) in the region.
Called from program, takes two arguments START and END
which specify the range to operate on."
@@ -6797,7 +7236,7 @@
(let ((end1 (make-marker)))
(move-marker end1 (max start end))
(goto-char (min start end))
- (while (re-search-forward "\b" end1 t)
+ (while (search-forward "\b" end1 t)
(if (eq (char-after) (char-after (- (point) 2)))
(delete-char -2))))))
@@ -6847,7 +7286,7 @@
(const :tag "Retro look" message-tool-bar-retro)
(repeat :tag "User defined list" gmm-tool-bar-item)
(symbol))
- :version "22.1" ;; Gnus 5.10.9
+ :version "23.0" ;; No Gnus
:initialize 'custom-initialize-default
:set 'message-tool-bar-update
:group 'message)
@@ -6866,7 +7305,7 @@
(message-kill-buffer "close") ;; stock_cancel
(mml-attach-file "attach" mml-mode-map)
(mml-preview "mail/preview" mml-mode-map)
- ;; (mml-secure-message-sign-encrypt "lock" mml-mode-map :visible nil)
+ (mml-secure-message-sign-encrypt "lock" mml-mode-map :visible nil)
(message-insert-importance-high "important" nil :visible nil)
(message-insert-importance-low "unimportant" nil :visible nil)
(message-insert-disposition-notification-to "receipt" nil :visible nil)
@@ -6876,7 +7315,7 @@
See `gmm-tool-bar-from-list' for details on the format of the list."
:type '(repeat gmm-tool-bar-item)
- :version "22.1" ;; Gnus 5.10.9
+ :version "23.0" ;; No Gnus
:initialize 'custom-initialize-default
:set 'message-tool-bar-update
:group 'message)
@@ -6896,7 +7335,7 @@
See `gmm-tool-bar-from-list' for details on the format of the list."
:type '(repeat gmm-tool-bar-item)
- :version "22.1" ;; Gnus 5.10.9
+ :version "23.0" ;; No Gnus
:initialize 'custom-initialize-default
:set 'message-tool-bar-update
:group 'message)
@@ -6909,7 +7348,7 @@
See `gmm-tool-bar-from-list' for the format of the list."
:type 'gmm-tool-bar-zap-list
- :version "22.1" ;; Gnus 5.10.9
+ :version "23.0" ;; No Gnus
:initialize 'custom-initialize-default
:set 'message-tool-bar-update
:group 'message)
@@ -6956,6 +7395,13 @@
:group 'message
:type '(alist :key-type regexp :value-type function))
+(defcustom message-expand-name-databases
+ (list 'bbdb 'eudc)
+ "List of databases to try for name completion (`message-expand-name').
+Each element is a symbol and can be `bbdb' or `eudc'."
+ :group 'message
+ :type '(set (const bbdb) (const eudc)))
+
(defcustom message-tab-body-function nil
"*Function to execute when `message-tab' (TAB) is executed in the body.
If nil, the function bound in `text-mode-map' or `global-map' is executed."
@@ -7036,9 +7482,15 @@
(delete-region (point) (progn (forward-line 3) (point))))))))))
(defun message-expand-name ()
- (if (fboundp 'bbdb-complete-name)
- (bbdb-complete-name)
- (expand-abbrev)))
+ (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))
+ (bbdb-complete-name))
+ (t
+ (expand-abbrev))))
;;; Help stuff.
@@ -7053,7 +7505,7 @@
(with-output-to-temp-buffer " *MESSAGE information message*"
(set-buffer " *MESSAGE information message*")
(fundamental-mode) ; for Emacs 20.4+
- (mapcar 'princ text)
+ (mapc 'princ text)
(goto-char (point-min))))
(funcall ask question))
(funcall ask question)))
@@ -7164,7 +7616,7 @@
address in `message-alternative-emails', looking at To, Cc and
From headers in the original article."
(require 'mail-utils)
- (let* ((fields '("To" "Cc"))
+ (let* ((fields '("To" "Cc" "From"))
(emails
(split-string
(mail-strip-quoted-names
@@ -7179,7 +7631,8 @@
(unless (or (not email) (equal email user-mail-address))
(message-remove-header "From")
(goto-char (point-max))
- (insert "From: " email "\n"))))
+ (insert "From: " (let ((user-mail-address email)) (message-make-from))
+ "\n"))))
(defun message-options-get (symbol)
(cdr (assq symbol message-options)))
@@ -7218,7 +7671,8 @@
(list message-hidden-headers)
message-hidden-headers))
(inhibit-point-motion-hooks t)
- (after-change-functions nil))
+ (after-change-functions nil)
+ (end-of-headers 0))
(when regexps
(save-excursion
(save-restriction
@@ -7227,11 +7681,17 @@
(while (not (eobp))
(if (not (message-hide-header-p regexps))
(message-next-header)
- (let ((begin (point)))
+ (let ((begin (point))
+ header header-len)
(message-next-header)
- (add-text-properties
- begin (point)
- '(invisible t message-hidden t))))))))))
+ (setq header (buffer-substring begin (point))
+ header-len (- (point) begin))
+ (delete-region begin (point))
+ (goto-char (1+ end-of-headers))
+ (insert header)
+ (setq end-of-headers
+ (+ end-of-headers header-len))))))))
+ (narrow-to-region (1+ end-of-headers) (point-max))))
(defun message-hide-header-p (regexps)
(let ((result nil)
@@ -7245,6 +7705,39 @@
(not result)
result)))
+(defun message-put-addresses-in-ecomplete ()
+ (dolist (header '("to" "cc" "from" "reply-to"))
+ (let ((value (message-field-value header)))
+ (dolist (string (mail-header-parse-addresses value 'raw))
+ (setq string
+ (gnus-replace-in-string
+ (gnus-replace-in-string string "^ +\\| +$" "") "\n" ""))
+ (ecomplete-add-item 'mail (car (mail-header-parse-address string))
+ string))))
+ (ecomplete-save))
+
+(defun message-display-abbrev (&optional choose)
+ "Display the next possible abbrev for the text before point."
+ (interactive (list t))
+ (when (and (memq (char-after (point-at-bol)) '(?C ?T ?\t ? ))
+ (message-point-in-header-p)
+ (save-excursion
+ (beginning-of-line)
+ (while (and (memq (char-after) '(?\t ? ))
+ (zerop (forward-line -1))))
+ (looking-at "To:\\|Cc:")))
+ (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))))
+ (when (and choose match)
+ (delete-region start end)
+ (insert match)))))
+
(when (featurep 'xemacs)
(require 'messagexmas)
(message-xmas-redefine))
- [Emacs-diffs] Changes to emacs/lisp/gnus/message.el,v,
Miles Bader <=