X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/4e14547fd4bfc7aa52ceac3dbefa50fc7c1e04e8..53080505af9e0641753909f057897b4203dd2269:/lisp/gnus/message.el diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 3f529047d2..760345b326 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -1,7 +1,7 @@ ;;; message.el --- composing mail and news messages ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: mail, news @@ -34,11 +34,12 @@ (eval-when-compile (require 'cl)) -(require 'hashcash) -(require 'canlock) (require 'mailheader) (require 'gmm-utils) -(require 'nnheader) +(require 'mail-utils) +;; Only for the trivial macros mail-header-from, mail-header-date +;; mail-header-references, mail-header-subject, mail-header-id +(eval-when-compile (require 'nnheader)) ;; This is apparently necessary even though things are autoloaded. ;; Because we dynamically bind mail-abbrev-mode-regexp, we'd better ;; require mailabbrev here. @@ -48,7 +49,6 @@ (require 'mail-parse) (require 'mml) (require 'rfc822) -(require 'ecomplete) (autoload 'mailclient-send-it "mailclient") ;; Emacs 22 or contrib/ @@ -249,6 +249,15 @@ included. Organization and User-Agent are optional." :link '(custom-manual "(message)Message Headers") :type '(repeat sexp)) +(defcustom message-prune-recipient-rules nil + "Rules for how to prune the list of recipients when doing wide replies. +This is a list of regexps and regexp matches." + :version "24.1" + :group 'message-mail + :group 'message-headers + :link '(custom-manual "(message)Wide Reply") + :type '(repeat regexp)) + (defcustom message-deletable-headers '(Message-ID Date Lines) "Headers to be deleted if they already exist and were generated by message previously." :group 'message-headers @@ -440,7 +449,7 @@ whitespace)." ;; Default to the value of `mail-interactive', available in all Emacsen ;; that Gnus supports. "Non-nil means when sending a message wait for and display errors. -nil means let mailer mail back a message to report errors." +A value of nil means let mailer mail back a message to report errors." :version "23.2" :group 'message-sending :group 'message-mail @@ -655,8 +664,6 @@ Done before generating the new subject of a forward." :link '(custom-manual "(message)Canceling News") :type 'string) -(defvar smtpmail-default-smtp-server) - (defun message-send-mail-function () "Return suitable value for the variable `message-send-mail-function'." (cond ((and (require 'sendmail) @@ -665,17 +672,21 @@ Done before generating the new subject of a forward." (executable-find sendmail-program)) 'message-send-mail-with-sendmail) ((and (locate-library "smtpmail") - (require 'smtpmail) + (boundp 'smtpmail-default-smtp-server) smtpmail-default-smtp-server) 'message-smtpmail-send-it) ((locate-library "mailclient") 'message-send-mail-with-mailclient) (t - (lambda () - (error "Don't know how to send mail. Please customize `message-send-mail-function'"))))) + (error "Don't know how to send mail. Please customize `message-send-mail-function'")))) ;; Useful to set in site-init.el -(defcustom message-send-mail-function (message-send-mail-function) +(defcustom message-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 'mailclient-send-it) + 'message-send-mail-with-mailclient) + (t (message-send-mail-function))) "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'. @@ -698,7 +709,7 @@ See also `send-mail-function'." :tag "Use Mailclient package") (function :tag "Other")) :group 'message-sending - :version "23.1" ;; No Gnus + :version "23.2" :initialize 'custom-initialize-default :link '(custom-manual "(message)Mail Variables") :group 'message-mail) @@ -859,8 +870,8 @@ If this is nil, use `user-mail-address'. If it is the symbol (defcustom message-qmail-inject-args nil "Arguments passed to qmail-inject programs. -This should be a list of strings, one string for each argument. It -may also be a function. +This should be a list of strings, one string for each argument. +It may also be a function. For e.g., if you wish to set the envelope sender address so that bounces go to the right place or to deal with listserv's usage of that address, you @@ -1139,6 +1150,8 @@ If stringp, use this; if non-nil, use no host name (user name only)." (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. (defvar message-reply-buffer nil) (defvar message-reply-headers nil "The headers of the current replied article. @@ -1163,11 +1176,7 @@ It is a vector of the following headers: :valid-regexp "^\\'" :error "All header lines must be newline terminated") -(defcustom message-default-headers - ;; Default to the value of `mail-default-headers' if available. - ;; Note: as for Emacs 21, XEmacs 21.4 and 21.5, it is unavailable - ;; unless sendmail.el is loaded. - (if (boundp 'mail-default-headers) mail-default-headers "") +(defcustom message-default-headers "" "*A string containing header lines to be inserted in outgoing messages. It is inserted before you edit the message, so you can edit or delete these lines." @@ -1176,8 +1185,24 @@ these lines." :link '(custom-manual "(message)Message Headers") :type 'message-header-lines) -(defcustom message-default-mail-headers "" +(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)) + ;; Use the value of `mail-default-headers' if available. + ;; Note: as for Emacs 21, XEmacs 21.4 and 21.5, it is + ;; unavailable unless sendmail.el is loaded. + (if (boundp 'mail-default-headers) + mail-default-headers)) "*A string of header lines to be inserted in outgoing mails." + :version "23.2" :group 'message-headers :group 'message-mail :link '(custom-manual "(message)Mail Headers") @@ -1261,7 +1286,7 @@ text and it replaces `self-insert-command' with the other command, e.g. :type '(repeat function)) (defcustom message-auto-save-directory - (file-name-as-directory (nnheader-concat message-directory "drafts")) + (file-name-as-directory (expand-file-name "drafts" message-directory)) "*Directory where Message auto-saves buffers if Gnus isn't running. If nil, Message won't auto-save." :group 'message-buffers @@ -1604,11 +1629,11 @@ If you'd like to make it possible to share draft files between XEmacs and Emacs, you may use `iso-2022-7bit' for this value at your own risk. Note that the coding-system `iso-2022-7bit' isn't suitable to all data.") -(defcustom message-send-mail-partially-limit 1000000 +(defcustom message-send-mail-partially-limit nil "The limitation of messages sent as message/partial. The lower bound of message size in characters, beyond which the message should be sent in several parts. If it is nil, the size is unlimited." - :version "21.1" + :version "24.1" :group 'message-buffers :link '(custom-manual "(message)Mail Variables") :type '(choice (const :tag "unlimited" nil) @@ -1723,6 +1748,7 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'." (defvar message-mime-part nil) (defvar message-posting-charset nil) (defvar message-inserted-headers nil) +(defvar message-inhibit-ecomplete nil) ;; Byte-compiler warning (defvar gnus-active-hashtb) @@ -1937,6 +1963,8 @@ is used by default." (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) @@ -1997,7 +2025,7 @@ see `message-narrow-to-headers-or-head'." (defmacro message-with-reply-buffer (&rest forms) "Evaluate FORMS in the reply buffer, if it exists." - `(when (and message-reply-buffer + `(when (and (bufferp message-reply-buffer) (buffer-name message-reply-buffer)) (with-current-buffer message-reply-buffer ,@forms))) @@ -2552,7 +2580,8 @@ Prefixed with one \\[universal-argument], display the Emacs MIME manual. With two \\[universal-argument]'s, display the EasyPG or PGG manual, depending on the value of `mml2015-use'." (interactive "p") - ;; Why not `info', which is in loaddefs.el? + ;; Don't use `info' because support for `(filename)nodename' is not + ;; available in XEmacs < 21.5.12. (Info-goto-node (format "(%s)Top" (cond ((eq arg 16) (require 'mml2015) @@ -2765,7 +2794,7 @@ PGG manual, depending on the value of `mml2015-use'." ;;; Forbidden properties ;; ;; We use `after-change-functions' to keep special text properties -;; that interfer with the normal function of message mode out of the +;; that interfere with the normal function of message mode out of the ;; buffer. (defcustom message-strip-special-text-properties t @@ -2829,6 +2858,8 @@ See also `message-forbidden-properties'." (inhibit-read-only t)) (remove-text-properties begin end message-forbidden-properties)))) +(autoload 'ecomplete-setup "ecomplete") ;; for Emacs <23. + ;;;###autoload (define-derived-mode message-mode text-mode "Message" "Major mode for editing mail and news to be sent. @@ -3178,7 +3209,7 @@ or in the synonym headers, defined by `message-header-synonyms'." "Widen the reply to include maximum recipients." (interactive) (let ((follow-to - (and message-reply-buffer + (and (bufferp message-reply-buffer) (buffer-name message-reply-buffer) (with-current-buffer message-reply-buffer (message-get-reply-headers t))))) @@ -3231,7 +3262,7 @@ or in the synonym headers, defined by `message-header-synonyms'." (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 +If a numeric argument or prefix arg is given, leave that number of lines before the signature intact." (interactive "P") (save-excursion @@ -3388,8 +3419,8 @@ Message buffers and is not meant to be called directly." ;; if message-signature-file contains a path. (not (file-name-directory message-signature-file))) - (nnheader-concat message-signature-directory - message-signature-file) + (expand-file-name message-signature-file + message-signature-directory) message-signature-file)) (file-exists-p signature-file)))) (when signature @@ -3673,9 +3704,16 @@ Really top post? "))) (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) + (if (bufferp message-reply-buffer) + (delete-windows-on message-reply-buffer t)) (push-mark (save-excursion - (insert-buffer-substring message-reply-buffer) + (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))) @@ -4063,7 +4101,8 @@ It should typically alter the sending method in some way or other." (run-hooks 'message-sent-hook)) (message "Sending...done") ;; Do ecomplete address snarfing. - (when (message-mail-alias-type-p 'ecomplete) + (when (and (message-mail-alias-type-p 'ecomplete) + (not message-inhibit-ecomplete)) (message-put-addresses-in-ecomplete)) ;; Mark the buffer as unmodified and delete auto-save. (set-buffer-modified-p nil) @@ -4385,6 +4424,8 @@ This function could be useful in `message-setup-hook'." (erase-buffer))) (kill-buffer tembuf)))) +(declare-function hashcash-wait-async "hashcash" (&optional buffer)) + (defun message-send-mail (&optional arg) (require 'mail-utils) (let* ((tembuf (message-generate-new-buffer-clone-locals " message temp")) @@ -4392,14 +4433,26 @@ This function could be useful in `message-setup-hook'." (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 (fboundp 'gnus-setup-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)) (when (and message-generate-hashcash (not (eq message-generate-hashcash 'opportunistic))) (message "Generating hashcash...") + (require 'hashcash) ;; Wait for calculations already started to finish... (hashcash-wait-async) ;; ...and do calculations not already done. mail-add-payment @@ -4521,6 +4574,7 @@ If you always want Gnus to send messages in one piece, set (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") @@ -4660,17 +4714,17 @@ to find out how to use this." (defun message-smtpmail-send-it () "Send the prepared message buffer with `smtpmail-send-it'. -This only differs from `smtpmail-send-it' that this command evaluates -`message-send-mail-hook' just before sending a message. It is useful -if your ISP requires the POP-before-SMTP authentication. See the Gnus -manual for details." +The only difference from `smtpmail-send-it' is that this command +evaluates `message-send-mail-hook' just before sending a message. +It is useful if your ISP requires the POP-before-SMTP +authentication. See the Gnus manual for details." (run-hooks 'message-send-mail-hook) (smtpmail-send-it)) (defun message-send-mail-with-mailclient () "Send the prepared message buffer with `mailclient-send-it'. -This only differs from `smtpmail-send-it' that this command evaluates -`message-send-mail-hook' just before sending a message." +The only difference from `mailclient-send-it' is that this +command evaluates `message-send-mail-hook' just before sending a message." (run-hooks 'message-send-mail-hook) (mailclient-send-it)) @@ -4684,10 +4738,14 @@ Do not use this for anything important, it is cryptographically weak." (prin1-to-string (recent-keys)) (prin1-to-string (garbage-collect)))))) +(defvar canlock-password) +(defvar canlock-password-for-verify) + (defun message-canlock-password () "The password used by message for cancel locks. This is the value of `canlock-password', if that option is non-nil. Otherwise, generate and save a value for `canlock-password' first." + (require 'canlock) (unless canlock-password (customize-save-variable 'canlock-password (message-canlock-generate)) (setq canlock-password-for-verify canlock-password)) @@ -4698,7 +4756,12 @@ Otherwise, generate and save a value for `canlock-password' first." (message-canlock-password) (canlock-insert-header))) +(autoload 'nnheader-get-report "nnheader") + +(declare-function gnus-setup-posting-charset "gnus-msg" (group)) + (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) @@ -5076,7 +5139,8 @@ Otherwise, generate and save a value for `canlock-password' first." "Denied posting -- the From looks strange: \"%s\"." from) nil) ((let ((addresses (rfc822-addresses from))) - (while (and addresses + ;; `rfc822-addresses' returns a string if parsing fails. + (while (and (consp addresses) (not (eq (string-to-char (car addresses)) ?\())) (setq addresses (cdr addresses))) addresses) @@ -5378,7 +5442,7 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'." (* 25 25))) (let ((tm (current-time))) (concat - (if (or (memq system-type '(ms-dos emx)) + (if (or (eq system-type 'ms-dos) ;; message-number-base36 doesn't handle bigints. (floatp (user-uid))) (let ((user (downcase (user-login-name)))) @@ -5436,7 +5500,7 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'." (defun message-make-references () "Return the References header for this message." (when message-reply-headers - (let ((message-id (mail-header-message-id message-reply-headers)) + (let ((message-id (mail-header-id message-reply-headers)) (references (mail-header-references message-reply-headers))) (if (or references message-id) (concat (or references "") (and references " ") @@ -5448,7 +5512,7 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'." (when message-reply-headers (let ((from (mail-header-from message-reply-headers)) (date (mail-header-date message-reply-headers)) - (msg-id (mail-header-message-id message-reply-headers))) + (msg-id (mail-header-id message-reply-headers))) (when from (let ((name (mail-extract-address-components from))) (concat @@ -5852,6 +5916,7 @@ Headers already prepared in the buffer are not modified." (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. @@ -6249,14 +6314,14 @@ between beginning of field and beginning of line." nil mua))) -(defun message-setup (headers &optional replybuffer actions +;; 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) (let ((mua (message-mail-user-agent)) - subject to field yank-action) + subject to field) (if (not (and message-this-is-mail mua)) - (message-setup-1 headers replybuffer actions) - (if replybuffer - (setq yank-action (list 'insert-buffer replybuffer))) + (message-setup-1 headers yank-action actions) (setq headers (copy-sequence headers)) (setq field (assq 'Subject headers)) (when field @@ -6273,7 +6338,11 @@ between beginning of field and beginning of line." (format "%s" (car item)) (cdr item))) headers) - continue switch-function yank-action actions))))) + 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. @@ -6300,12 +6369,16 @@ are not included." (push header result))) (nreverse result))) -(defun message-setup-1 (headers &optional replybuffer actions) +(defun message-setup-1 (headers &optional yank-action actions) (dolist (action actions) (condition-case nil (add-to-list 'message-send-actions `(apply ',(car action) ',(cdr action))))) - (setq message-reply-buffer replybuffer) + (setq message-reply-buffer + (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 @@ -6387,9 +6460,7 @@ are not included." (setq buffer-file-name (expand-file-name (concat (if (memq system-type - '(ms-dos ms-windows windows-nt - cygwin cygwin32 win32 w32 - mswindows)) + '(ms-dos windows-nt cygwin)) "message" "*message*") (format-time-string "-%Y%m%d-%H%M%S")) @@ -6436,7 +6507,7 @@ 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) replybuffer) + (let ((message-this-is-mail t)) (unless (message-mail-user-agent) (message-pop-to-buffer ;; Search for the existing message buffer if `continue' is non-nil. @@ -6447,15 +6518,11 @@ is a function used to switch to and display the mail buffer." message-generate-new-buffers))) (message-buffer-name "mail" to)) switch-function)) - ;; FIXME: message-mail should do something if YANK-ACTION is not - ;; insert-buffer. - (and (consp yank-action) (eq (car yank-action) 'insert-buffer) - (setq replybuffer (nth 1 yank-action))) (message-setup (nconc `((To . ,(or to "")) (Subject . ,(or subject ""))) (when other-headers other-headers)) - replybuffer send-actions continue switch-function) + yank-action send-actions continue switch-function) ;; FIXME: Should return nil if failure. t)) @@ -6493,7 +6560,7 @@ The function is called with one parameter, a cons cell ..." (defun message-get-reply-headers (wide &optional to-address address-headers) (let (follow-to mct never-mct to cc author mft recipients extra) - ;; Find all relevant headers we need. + ;; Find all relevant headers we need. (save-restriction (message-narrow-to-headers-or-head) ;; Gmane renames "To". Look at "Original-To", too, if it is present in @@ -6619,6 +6686,8 @@ want to get rid of this query permanently."))) (if recip (setq recipients (delq recip recipients)))))))) + (setq recipients (message-prune-recipients recipients)) + ;; 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))))) @@ -6632,6 +6701,22 @@ want to get rid of this query permanently."))) (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) + (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)))))))) + recipients) + (defcustom message-simplify-subject-functions '(message-strip-list-identifiers message-strip-subject-re @@ -7103,22 +7188,28 @@ Optional DIGEST will use digest to forward." (defun message-forward-make-body-plain (forward-buffer) (insert "\n-------------------- Start of forwarded message --------------------\n") - (let ((b (point)) e) - (insert - (with-temp-buffer - (mm-disable-multibyte) - (insert - (with-current-buffer forward-buffer - (mm-with-unibyte-current-buffer (buffer-string)))) - (mm-enable-multibyte) - (mime-to-mml) - (goto-char (point-min)) - (when (looking-at "From ") - (replace-match "X-From-Line: ")) - (buffer-string))) + (let ((b (point)) + (contents (with-current-buffer forward-buffer (buffer-string))) + e) + (unless (featurep 'xemacs) + (unless (mm-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))) + (unless (bolp) (insert "\n")) (setq e (point)) (insert - "\n-------------------- End of forwarded message --------------------\n") + "-------------------- End of forwarded message --------------------\n") (message-remove-ignored-headers b e))) (defun message-remove-ignored-headers (b e) @@ -7154,18 +7245,22 @@ 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) - (insert - (with-temp-buffer - (mm-disable-multibyte) - (insert - (with-current-buffer forward-buffer - (mm-with-unibyte-current-buffer (buffer-string)))) - (mm-enable-multibyte) - (mime-to-mml) - (goto-char (point-min)) - (when (looking-at "From ") - (replace-match "X-From-Line: ")) - (buffer-string))) + (let ((contents (with-current-buffer forward-buffer (buffer-string)))) + (unless (featurep 'xemacs) + (unless (mm-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)))) (save-restriction (narrow-to-region (point) (point)) (mml-insert-buffer forward-buffer) @@ -7357,6 +7452,7 @@ is for the internal use." (replace-match "X-From-Line: ")) ;; Send it. (let ((message-inhibit-body-encoding t) + (message-inhibit-ecomplete t) message-required-mail-headers message-generate-hashcash rfc2047-encode-encoded-words) @@ -7504,10 +7600,8 @@ which specify the range to operate on." (defun message-exchange-point-and-mark () "Exchange point and mark, but don't activate region if it was inactive." - (unless (prog1 - (message-mark-active-p) - (exchange-point-and-mark)) - (setq mark-active nil))) + (goto-char (prog1 (mark t) + (set-marker (mark-marker) (point))))) (defalias 'message-make-overlay 'make-overlay) (defalias 'message-delete-overlay 'delete-overlay) @@ -7712,37 +7806,44 @@ those headers." (point)) (skip-chars-backward "^, \t\n") (point)))) (completion-ignore-case t) - (string (buffer-substring b (progn (skip-chars-forward "^,\t\n ") - (point)))) - (hashtb (and (boundp 'gnus-active-hashtb) gnus-active-hashtb)) - (completions (all-completions string hashtb)) - comp) - (delete-region b (point)) - (cond - ((= (length completions) 1) - (if (string= (car completions) string) - (progn - (insert string) - (message "Only matching group")) - (insert (car completions)))) - ((and (setq comp (try-completion string hashtb)) - (not (string= comp string))) - (insert comp)) - (t - (insert string) - (if (not comp) - (message "No matching groups") - (save-selected-window - (pop-to-buffer "*Completions*") - (buffer-disable-undo) - (let ((buffer-read-only nil)) - (erase-buffer) - (let ((standard-output (current-buffer))) - (message-display-completion-list (sort completions 'string<) - string)) - (setq buffer-read-only nil) - (goto-char (point-min)) - (delete-region (point) (progn (forward-line 3) (point)))))))))) + (e (progn (skip-chars-forward "^,\t\n ") (point))) + (hashtb (and (boundp 'gnus-active-hashtb) gnus-active-hashtb))) + (message-completion-in-region e b hashtb))) + +(defalias 'message-completion-in-region + (if (fboundp 'completion-in-region) + 'completion-in-region + (lambda (e b hashtb) + (let* ((string (buffer-substring b e)) + (completions (all-completions string hashtb)) + comp) + (delete-region b (point)) + (cond + ((= (length completions) 1) + (if (string= (car completions) string) + (progn + (insert string) + (message "Only matching group")) + (insert (car completions)))) + ((and (setq comp (try-completion string hashtb)) + (not (string= comp string))) + (insert comp)) + (t + (insert string) + (if (not comp) + (message "No matching groups") + (save-selected-window + (pop-to-buffer "*Completions*") + (buffer-disable-undo) + (let ((buffer-read-only nil)) + (erase-buffer) + (let ((standard-output (current-buffer))) + (message-display-completion-list (sort completions 'string<) + string)) + (setq buffer-read-only nil) + (goto-char (point-min)) + (delete-region (point) + (progn (forward-line 3) (point)))))))))))) (defun message-expand-name () (cond ((and (memq 'eudc message-expand-name-databases) @@ -7964,7 +8065,11 @@ From headers in the original article." (not result) result))) +(declare-function ecomplete-add-item "ecomplete" (type key text)) +(declare-function ecomplete-save "ecomplete" ()) + (defun message-put-addresses-in-ecomplete () + (require 'ecomplete) (dolist (header '("to" "cc" "from" "reply-to")) (let ((value (message-field-value header))) (dolist (string (mail-header-parse-addresses value 'raw)) @@ -7975,6 +8080,8 @@ From headers in the original article." string)))) (ecomplete-save)) +(autoload 'ecomplete-display-matches "ecomplete") + (defun message-display-abbrev (&optional choose) "Display the next possible abbrev for the text before point." (interactive (list t)) @@ -8151,5 +8258,4 @@ Used in `message-simplify-recipients'." ;; coding: iso-8859-1 ;; End: -;; arch-tag: 94b32cac-4504-4b6c-8181-030ebf380ee0 ;;; message.el ends here