;;; 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 <larsi@gnus.org>
;; Keywords: mail, news
:group 'message-interface
:type 'regexp)
-(defcustom message-from-style
- (if (featurep 'xemacs) 'default mail-from-style)
+(defcustom message-from-style mail-from-style
+;; Default to the value of `mail-from-style', available in all Emacsen
+;; that Gnus supports.
"*Specifies how \"From\" headers look.
If nil, they contain just the return address like:
Otherwise, most addresses look like `angles', but they look like
`parens' if `angles' would need quoting and `parens' would not."
+ :version "23.2"
:type '(choice (const :tag "simple" nil)
(const parens)
(const angles)
:link '(custom-manual "(message)Various Commands")
:group 'message-various)
-(defcustom message-interactive (if (featurep 'xemacs) t mail-interactive)
+(defcustom message-interactive mail-interactive
+;; 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."
+ :version "23.2"
:group 'message-sending
:group 'message-mail
:link '(custom-manual "(message)Sending Variables")
:type 'regexp)
(defcustom message-cite-prefix-regexp
- (cond ((not (featurep 'xemacs))
+ ;; Default to the value of `mail-citation-prefix-regexp' if available.
+ ;; Note: as for Emacs 21, XEmacs 21.4 and 21.5, it is unavailable
+ ;; unless sendmail.el is loaded.
+ (cond ((boundp 'mail-citation-prefix-regexp)
mail-citation-prefix-regexp)
((string-match "[[:digit:]]" "1")
;; Support POSIX? XEmacs 21.5.27 doesn't.
non-word-constituents
"]\\)+>+\\|[ \t]*[]>|}]\\)+")))))
"*Regexp matching the longest possible citation prefix on a line."
- :version "22.1"
+ :version "23.2"
:group 'message-insertion
:link '(custom-manual "(message)Insertion Variables")
:type 'regexp
:type 'boolean)
(defcustom message-sendmail-envelope-from
- (if (featurep 'xemacs) nil mail-envelope-from)
+ ;; Default to the value of `mail-envelope-from' if available.
+ ;; Note: as for Emacsen that Gnus supports, except for SXEmacs, it is
+ ;; unavailable unless sendmail.el is loaded.
+ (if (boundp 'mail-envelope-from) mail-envelope-from)
"*Envelope-from when sending mail with sendmail.
-This only has an effect if `mail-specify-envelope-from' is non-nil.
If this is nil, use `user-mail-address'. If it is the symbol
`header', use the From: header of the message."
- :version "22.1"
+ :version "23.2"
:type '(choice (string :tag "From name")
(const :tag "Use From: header from message" header)
(const :tag "Use `user-mail-address'" nil))
:version "23.1" ;; No Gnus
:group 'message-insertion)
-(defcustom message-yank-prefix (if (featurep 'xemacs) "> " mail-yank-prefix)
+(defcustom message-yank-prefix
+ ;; Default to the value of `mail-yank-prefix' if available.
+ ;; Note: as for Emacs 21, it is unavailable unless sendmail.el is loaded.
+ (if (boundp 'mail-yank-prefix) mail-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' and `message-yank-empty-prefix'."
+ :version "23.2"
:type 'string
:link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
:group 'message-insertion)
(defcustom message-indentation-spaces
- (if (featurep 'xemacs) 3 mail-indentation-spaces)
+ ;; Default to the value of `mail-indentation-spaces' if available.
+ ;; Note: as for Emacs 21, XEmacs 21.4 and 21.5, it is unavailable
+ ;; unless sendmail.el is loaded.
+ (if (boundp 'mail-indentation-spaces) mail-indentation-spaces 3)
"*Number of spaces to insert at the beginning of each cited line.
Used by `message-yank-original' via `message-yank-cite'."
+ :version "23.2"
:group 'message-insertion
:link '(custom-manual "(message)Insertion Variables")
:type 'integer)
:link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
-(defcustom message-signature (if (featurep 'xemacs) t mail-signature)
+(defcustom message-signature mail-signature
+ ;; Default to the value of `mail-signature', available in all Emacsen
+ ;; that Gnus supports.
"*String to be inserted at the end of the message buffer.
If t, the `message-signature-file' file will be inserted instead.
If a function, the result from the function will be used instead.
If a form, the result from the form will be used instead."
+ :version "23.2"
:type 'sexp
:link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
(defcustom message-signature-file
- (if (featurep 'xemacs) "~/.signature" mail-signature-file)
+ ;; Default to the value of `mail-signature-file' if available.
+ ;; Note: as for Emacs 21, XEmacs 21.4 and 21.5, it is unavailable
+ ;; unless sendmail.el is loaded.
+ (if (boundp 'mail-signature-file) mail-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 a path is specified, the value of `message-signature-directory' is ignored,
even if set."
+ :version "23.2"
:type '(choice file (const :tags "None" nil))
:link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
(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.
:error "All header lines must be newline terminated")
(defcustom message-default-headers
- (if (featurep 'xemacs) "" mail-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 "")
"*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."
+ :version "23.2"
:group 'message-headers
: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)
+ ""))
"*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")
(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)))
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)
;;; 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
"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)))))
(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)))
;; But some systems are more broken with -f, so
;; we'll let users override this.
(and (null message-sendmail-f-is-evil)
- mail-specify-envelope-from
(list "-f" (message-sendmail-envelope-from)))
;; These mean "report errors by mail"
;; and "deliver in background".
"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)
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
(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.
(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
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.
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))
(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)
(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)