X-Git-Url: https://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fmessage.el;h=44c99c0662008ffc55170b901b75c6466b33a672;hp=f87030e486924da5f7b4ebc6936810287ac52d83;hb=11fb97473a0d60aeab2116f037744f0badff0b9c;hpb=4ec149e93d1e982f635cb961d99ce6a394c7f6e0 diff --git a/lisp/message.el b/lisp/message.el index f87030e48..44c99c066 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -1,7 +1,6 @@ ;;; message.el --- composing mail and news messages -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1996-2011 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: mail, news @@ -130,6 +129,17 @@ :group 'message-buffers :type '(choice function (const nil))) +(defcustom message-cite-style nil + "The overall style to be used when yanking cited text. +Values are either `traditional' (cited text first), +`top-post' (cited text at the bottom), or nil (don't override the +individual message variables)." + :version "24.1" + :group 'message-various + :type '(choice (const :tag "None" :value nil) + (const :tag "Traditional" :value traditional) + (const :tag "Top-post" :value top-post))) + (defcustom message-fcc-handler-function 'message-output "*A function called to save outgoing articles. This function will be called with the name of the file to store the @@ -164,8 +174,8 @@ If this variable is nil, no such courtesy message will be added." ;; In Emacs 24.1 this defaults to the value of `mail-from-style' ;; that defaults to: ;; `angles' in Emacs 22.1~23.1, XEmacs 21.4, 21.5, and SXEmacs 22.1; - ;; `default' in Emacs 23.2, and 24.1 - "*Specifies how \"From\" headers look. + ;; `system-default' in Emacs 23.2, and 24.1 + "Specifies how \"From\" headers look. If nil, they contain just the return address like: king@grassland.com @@ -281,7 +291,7 @@ This is a list of regexps and regexp matches." regexp)) (defcustom message-ignored-mail-headers - "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:" + "^\\([GF]cc\\|Resent-Fcc\\|Xref\\|X-Draft-From\\|X-Gnus-Agent-Meta-Information\\):" "*Regexp of headers to be removed unconditionally before mailing." :group 'message-mail :group 'message-headers @@ -515,14 +525,9 @@ This is used by `message-kill-buffer'." :group 'message-buffers :type 'boolean) -(defvar gnus-local-organization) (defcustom message-user-organization - (or (and (boundp 'gnus-local-organization) - (stringp gnus-local-organization) - gnus-local-organization) - (getenv "ORGANIZATION") - t) - "*String to be used as an Organization header. + (or (getenv "ORGANIZATION") t) + "String to be used as an Organization header. If t, use `message-user-organization-file'." :group 'message-headers :type '(choice string @@ -903,11 +908,7 @@ variable isn't used." ;; create a dependence to `gnus.el'. :type 'sexp) -;; FIXME: This should be a temporary workaround until someone implements a -;; proper solution. If a crash happens while replying, the auto-save file -;; will *not* have a `References:' header if `message-generate-headers-first' -;; is nil. See: http://article.gmane.org/gmane.emacs.gnus.general/51138 -(defcustom message-generate-headers-first '(references) +(defcustom message-generate-headers-first nil "Which headers should be generated before starting to compose a message. If t, generate all required headers. This can also be a list of headers to generate. The variables `message-required-news-headers' and @@ -919,7 +920,6 @@ will not have a visible effect for those headers." :group 'message-headers :link '(custom-manual "(message)Message Headers") :type '(choice (const :tag "None" nil) - (const :tag "References" '(references)) (const :tag "All" t) (repeat (sexp :tag "Header")))) @@ -1169,6 +1169,8 @@ It is a vector of the following headers: (defvar message-checksum nil) (defvar message-send-actions nil "A list of actions to be performed upon successful sending of a message.") +(defvar message-return-action nil + "Action to return to the caller after sending or postphoning a message.") (defvar message-exit-actions nil "A list of actions to be performed upon exiting after sending a message.") (defvar message-kill-actions nil @@ -1231,14 +1233,11 @@ called and its result is inserted." (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)" system-configuration) (file-readable-p "/etc/sendmail.cf") - (let ((buffer (get-buffer-create " *temp*"))) - (unwind-protect - (with-current-buffer buffer - (insert-file-contents "/etc/sendmail.cf") - (goto-char (point-min)) - (let ((case-fold-search nil)) - (re-search-forward "^OR\\>" nil t))) - (kill-buffer buffer)))) + (with-temp-buffer + (insert-file-contents "/etc/sendmail.cf") + (goto-char (point-min)) + (let ((case-fold-search nil)) + (re-search-forward "^OR\\>" nil t)))) ;; According to RFC822, "The field-name must be composed of printable ;; ASCII characters (i. e., characters that have decimal values between ;; 33 and 126, except colon)", i. e., any chars except ctl chars, @@ -2820,7 +2819,7 @@ message composition doesn't break too bad." :link '(custom-manual "(message)Various Message Variables") :type 'boolean) -(defconst message-forbidden-properties +(defvar message-forbidden-properties ;; No reason this should be clutter up customize. We make it a ;; property list (rather than a list of property symbols), to be ;; directly useful for `remove-text-properties'. @@ -2912,6 +2911,7 @@ M-RET `message-newline-and-reformat' (break the line and reformat)." (set (make-local-variable 'message-reply-buffer) nil) (set (make-local-variable 'message-inserted-headers) nil) (set (make-local-variable 'message-send-actions) nil) + (set (make-local-variable 'message-return-action) nil) (set (make-local-variable 'message-exit-actions) nil) (set (make-local-variable 'message-kill-actions) nil) (set (make-local-variable 'message-postpone-actions) nil) @@ -2963,6 +2963,7 @@ M-RET `message-newline-and-reformat' (break the line and reformat)." (mail-aliases-setup)))) ((message-mail-alias-type-p 'ecomplete) (ecomplete-setup))) + (add-hook 'completion-at-point-functions 'message-completion-function nil t) (unless buffer-file-name (message-set-auto-save-file-name)) (unless (buffer-base-buffer) @@ -3091,18 +3092,27 @@ M-RET `message-newline-and-reformat' (break the line and reformat)." (interactive) (message-position-on-field "Summary" "Subject")) +(eval-when-compile + (defmacro message-called-interactively-p (kind) + (condition-case nil + (progn + (eval '(called-interactively-p 'any)) + ;; Emacs >=23.2 + `(called-interactively-p ,kind)) + ;; Emacs <23.2 + (wrong-number-of-arguments '(called-interactively-p)) + ;; XEmacs + (void-function '(interactive-p))))) + (defun message-goto-body () - "Move point to the beginning of the message body. -Return point." + "Move point to the beginning of the message body." (interactive) - (when (and (called-interactively-p) + (when (and (message-called-interactively-p 'any) (looking-at "[ \t]*\n")) (expand-abbrev)) (goto-char (point-min)) (or (search-forward (concat "\n" mail-header-separator "\n") nil t) - (search-forward-regexp "[^:]+:\\([^\n]\\|\n[ \t]\\)+\n\n" nil t)) - (while (looking-at "^<#secure") (forward-line 1)) - (point)) + (search-forward-regexp "[^:]+:\\([^\n]\\|\n[ \t]\\)+\n\n" nil t))) (defun message-in-body-p () "Return t if point is in the message body." @@ -3994,11 +4004,9 @@ The text will also be indented the normal way." (actions message-exit-actions)) (when (and (message-send arg) (buffer-name buf)) + (message-bury buf) (if message-kill-buffer-on-exit - (kill-buffer buf) - (bury-buffer buf) - (when (eq buf (current-buffer)) - (message-bury buf))) + (kill-buffer buf)) (message-do-actions actions) t))) @@ -4048,9 +4056,8 @@ Instead, just auto-save the buffer and then bury it." "Bury this mail BUFFER." (let ((newbuf (other-buffer buffer))) (bury-buffer buffer) - (if (and (window-dedicated-p (selected-window)) - (not (null (delq (selected-frame) (visible-frame-list))))) - (delete-frame (selected-frame)) + (if message-return-action + (apply (car message-return-action) (cdr message-return-action)) (switch-to-buffer newbuf)))) (defun message-send (&optional arg) @@ -4170,7 +4177,6 @@ not have PROP." (nreverse regions))) (defcustom message-bogus-addresses - ;; '("noreply" "nospam" "invalid") '("noreply" "nospam" "invalid" "@@" "[^[:ascii:]].*@" "[ \t]") "List of regexps of potentially bogus mail addresses. See `message-check-recipients' how to setup checking. @@ -4300,9 +4306,10 @@ matching entry in `message-bogus-addresses'." ;; FIXME: How about "foo@subdomain", when the MTA adds ".domain.tld"? (let (found) (mapc (lambda (address) - (setq address (cadr address)) + (setq address (or (cadr address) "")) (when - (or (not + (or (string= "" address) + (not (or (not (string-match "@" address)) (string-match @@ -4316,7 +4323,7 @@ matching entry in `message-bogus-addresses'." "\\|") message-bogus-addresses))) (string-match re address)))) - (push address found))) + (push address found))) ;; (mail-extract-address-components recipients t)) found)) @@ -4335,7 +4342,17 @@ This function could be useful in `message-setup-hook'." (and bog (not (y-or-n-p (format - "Address `%s' might be bogus. Continue? " bog))) + "Address `%s'%s might be bogus. Continue? " + bog + ;; If the encoded version of the email address + ;; is different from the unencoded version, + ;; then we likely have invisible characters or + ;; the like. Display the encoded version, + ;; too. + (let ((encoded (rfc2047-encode-string bog))) + (if (string= encoded bog) + "" + (format " (%s)" encoded)))))) (error "Bogus address")))))))) (custom-add-option 'message-setup-hook 'message-check-recipients) @@ -4378,7 +4395,7 @@ This function could be useful in `message-setup-hook'." (tembuf (message-generate-new-buffer-clone-locals " message temp")) (curbuf (current-buffer)) (id (message-make-message-id)) (n 1) - plist total header required-mail-headers) + plist total header) (while (not (eobp)) (if (< (point-max) (+ p message-send-mail-partially-limit)) (goto-char (point-max)) @@ -4710,6 +4727,8 @@ to find out how to use this." ;; should never happen (t (error "qmail-inject reported unknown failure")))) +(defvar mh-previous-window-config) + (defun message-send-mail-with-mh () "Send the prepared message buffer with mh." (let ((mh-previous-window-config nil) @@ -4930,8 +4949,7 @@ Otherwise, generate and save a value for `canlock-password' first." t)) ;; Check long header lines. (message-check 'long-header-lines - (let ((start (point)) - (header nil) + (let ((header nil) (length 0) found) (while (and (not found) @@ -4940,7 +4958,6 @@ Otherwise, generate and save a value for `canlock-password' first." (setq found t length (- (point) (match-beginning 0))) (setq header (match-string-no-properties 1))) - (setq start (match-beginning 0)) (forward-line 1)) (if found (y-or-n-p (format "Your %s header is too long (%d). Really post? " @@ -5783,7 +5800,7 @@ subscribed address (and not the additional To and Cc header contents)." (defun message-idna-to-ascii-rhs-1 (header) "Interactively potentially IDNA encode domain names in HEADER." (let ((field (message-fetch-field header)) - rhs ace address) + ace) (when field (dolist (rhs (mm-delete-duplicates @@ -5832,6 +5849,21 @@ See `message-idna-encode'." (message-idna-to-ascii-rhs-1 "Mail-Followup-To") (message-idna-to-ascii-rhs-1 "Cc"))))) +(defvar Date) +(defvar Message-ID) +(defvar Organization) +(defvar From) +(defvar Path) +(defvar Subject) +(defvar Newsgroups) +(defvar In-Reply-To) +(defvar References) +(defvar To) +(defvar Distribution) +(defvar Lines) +(defvar User-Agent) +(defvar Expires) + (defun message-generate-headers (headers) "Prepare article HEADERS. Headers already prepared in the buffer are not modified." @@ -6342,11 +6374,11 @@ between beginning of field and beginning of line." ;; 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) + continue switch-function return-action) (let ((mua (message-mail-user-agent)) subject to field) (if (not (and message-this-is-mail mua)) - (message-setup-1 headers yank-action actions) + (message-setup-1 headers yank-action actions return-action) (setq headers (copy-sequence headers)) (setq field (assq 'Subject headers)) (when field @@ -6394,11 +6426,12 @@ are not included." (push header result))) (nreverse result))) -(defun message-setup-1 (headers &optional yank-action actions) +(defun message-setup-1 (headers &optional yank-action actions return-action) (dolist (action actions) (condition-case nil (add-to-list 'message-send-actions `(apply ',(car action) ',(cdr action))))) + (setq message-return-action return-action) (setq message-reply-buffer (if (and (consp yank-action) (eq (car yank-action) 'insert-buffer)) @@ -6422,30 +6455,35 @@ are not included." (funcall message-default-headers) message-default-headers)) (or (bolp) (insert ?\n))) - (insert mail-header-separator "\n") + (let ((message-forbidden-properties nil)) + (insert (propertize (concat mail-header-separator "\n") + 'read-only t 'rear-nonsticky t 'intangible t))) (forward-line -1) - (when (message-news-p) - (when message-default-news-headers - (insert message-default-news-headers) - (or (bolp) (insert ?\n))) - (when message-generate-headers-first + ;; If a crash happens while replying, the auto-save file would *not* have a + ;; `References:' header if `message-generate-headers-first' was nil. + ;; Therefore, always generate it first. + (let ((message-generate-headers-first + (append message-generate-headers-first '(References)))) + (when (message-news-p) + (when message-default-news-headers + (insert message-default-news-headers) + (or (bolp) (insert ?\n))) (message-generate-headers (message-headers-to-generate - (append message-required-news-headers - message-required-headers) - message-generate-headers-first - '(Lines Subject))))) - (when (message-mail-p) - (when message-default-mail-headers - (insert message-default-mail-headers) - (or (bolp) (insert ?\n))) - (when message-generate-headers-first + (append message-required-news-headers + message-required-headers) + message-generate-headers-first + '(Lines Subject)))) + (when (message-mail-p) + (when message-default-mail-headers + (insert message-default-mail-headers) + (or (bolp) (insert ?\n))) (message-generate-headers (message-headers-to-generate - (append message-required-mail-headers - message-required-headers) - message-generate-headers-first - '(Lines Subject))))) + (append message-required-mail-headers + message-required-headers) + message-generate-headers-first + '(Lines Subject))))) (run-hooks 'message-signature-setup-hook) (message-insert-signature) (save-restriction @@ -6527,9 +6565,9 @@ are not included." ;;; ;;;###autoload -(defun message-mail (&optional to subject - other-headers continue switch-function - yank-action send-actions) +(defun message-mail (&optional to subject other-headers continue + switch-function yank-action send-actions + return-action &rest ignored) "Start editing a mail message to be sent. OTHER-HEADERS is an alist of header/value pairs. CONTINUE says whether to continue editing a message already being composed. SWITCH-FUNCTION @@ -6549,10 +6587,15 @@ is a function used to switch to and display the mail buffer." (message-setup (nconc `((To . ,(or to "")) (Subject . ,(or subject ""))) - (when other-headers other-headers)) - yank-action send-actions continue switch-function) - ;; FIXME: Should return nil if failure. - t)) + ;; C-h f compose-mail says that headers should be specified as + ;; (string . value); however all the rest of message expects + ;; headers to be symbols, not strings (eg message-header-format-alist). + ;; http://lists.gnu.org/archive/html/emacs-devel/2011-01/msg00337.html + ;; We need to convert any string input, eg from rmail-start-mail. + (dolist (h other-headers other-headers) + (if (stringp (car h)) (setcar h (intern (capitalize (car h))))))) + yank-action send-actions continue switch-function + return-action))) ;;;###autoload (defun message-news (&optional newsgroups subject) @@ -6784,7 +6827,7 @@ Useful functions to put in this list include: (interactive) (require 'gnus-sum) ; for gnus-list-identifiers (let ((cur (current-buffer)) - from subject date reply-to to cc + from subject date references message-id follow-to (inhibit-point-motion-hooks t) (message-this-is-mail t) @@ -7305,11 +7348,9 @@ Optional DIGEST will use digest to forward." (defun message-forward-make-body-digest-plain (forward-buffer) (insert "\n-------------------- Start of forwarded message --------------------\n") - (let ((b (point)) e) - (mml-insert-buffer forward-buffer) - (setq e (point)) - (insert - "\n-------------------- End of forwarded message --------------------\n"))) + (mml-insert-buffer forward-buffer) + (insert + "\n-------------------- End of forwarded message --------------------\n")) (defun message-forward-make-body-digest-mime (forward-buffer) (insert "\n<#multipart type=digest>\n") @@ -7429,6 +7470,8 @@ is for the internal use." (setq rmail-insert-mime-forwarded-message-function 'message-forward-rmail-make-body)) +(defvar message-inhibit-body-encoding nil) + ;;;###autoload (defun message-resend (address) "Resend the current article to ADDRESS." @@ -7680,24 +7723,22 @@ Pre-defined symbols include `message-tool-bar-gnome' and (defcustom message-tool-bar-gnome '((ispell-message "spell" nil + :vert-only t :visible (or (not (boundp 'flyspell-mode)) (not flyspell-mode))) (flyspell-buffer "spell" t + :vert-only t :visible (and (boundp 'flyspell-mode) flyspell-mode) :help "Flyspell whole buffer") - (gmm-ignore "separator") - (message-send-and-exit "mail/send") + (message-send-and-exit "mail/send" t :label "Send") (message-dont-send "mail/save-draft") - (message-kill-buffer "close") ;; stock_cancel - (mml-attach-file "attach" mml-mode-map) + (mml-attach-file "attach" mml-mode-map :vert-only t) (mml-preview "mail/preview" mml-mode-map) (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) - (gmm-customize-mode "preferences" t :help "Edit mode preferences") - (message-info "help" t :help "Message manual")) + (message-insert-disposition-notification-to "receipt" nil :visible nil)) "List of items for the message tool bar (GNOME style). See `gmm-tool-bar-from-list' for details on the format of the list." @@ -7783,7 +7824,7 @@ When FORCE, rebuild the tool bar." :type '(alist :key-type regexp :value-type function)) (defcustom message-expand-name-databases - (list 'bbdb 'eudc) + '(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 @@ -7805,15 +7846,27 @@ If nil, the function bound in `text-mode-map' or `global-map' is executed." Execute function specified by `message-tab-body-function' when not in those headers." (interactive) + (cond + ((if (and (boundp 'completion-fail-discreetly) + (fboundp 'completion-at-point)) + (let ((completion-fail-discreetly t)) (completion-at-point)) + (funcall (or (message-completion-function) #'ignore))) + ;; Completion was performed; nothing else to do. + nil) + (message-tab-body-function (funcall message-tab-body-function)) + (t (funcall (or (lookup-key text-mode-map "\t") + (lookup-key global-map "\t") + 'indent-relative))))) + +(defvar mail-abbrev-mode-regexp) + +(defun message-completion-function () (let ((alist message-completion-alist)) (while (and alist (let ((mail-abbrev-mode-regexp (caar alist))) (not (mail-abbrev-in-expansion-header-p)))) (setq alist (cdr alist))) - (funcall (or (cdar alist) message-tab-body-function - (lookup-key text-mode-map "\t") - (lookup-key global-map "\t") - 'indent-relative)))) + (cdar alist))) (eval-and-compile (condition-case nil @@ -7884,7 +7937,12 @@ those headers." (eudc-expand-inline)) ((and (memq 'bbdb message-expand-name-databases) (fboundp 'bbdb-complete-name)) - (bbdb-complete-name)) + (let ((starttick (buffer-modified-tick))) + (or (bbdb-complete-name) + ;; Apparently, bbdb-complete-name can return nil even when + ;; completion took place. So let's double check the buffer was + ;; not modified. + (/= starttick (buffer-modified-tick))))) (t (expand-abbrev)))) @@ -7945,8 +8003,6 @@ regexp VARSTR." ;;; MIME functions ;;; -(defvar message-inhibit-body-encoding nil) - (defun message-encode-message-body () (unless message-inhibit-body-encoding (let ((mail-parse-charset (or mail-parse-charset