;;; message.el --- composing mail and news messages
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
-;; Free Software Foundation, Inc.
+
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;; 2005, 2006 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: mail, news
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
(defvar gnus-list-identifiers)) ; gnus-sum is required where necessary
(require 'canlock)
(require 'mailheader)
+(require 'gmm-utils)
(require 'nnheader)
;; This is apparently necessary even though things are autoloaded.
;; Because we dynamically bind mail-abbrev-mode-regexp, we'd better
(put 'user-full-name 'custom-type 'string)
(defgroup message-various nil
- "Various Message Variables"
+ "Various Message Variables."
:link '(custom-manual "(message)Various Message Variables")
:group 'message)
(defgroup message-buffers nil
- "Message Buffers"
+ "Message Buffers."
:link '(custom-manual "(message)Message Buffers")
:group 'message)
(defgroup message-sending nil
- "Message Sending"
+ "Message Sending."
:link '(custom-manual "(message)Sending Variables")
:group 'message)
(defgroup message-interface nil
- "Message Interface"
+ "Message Interface."
:link '(custom-manual "(message)Interface")
:group 'message)
(defgroup message-forwarding nil
- "Message Forwarding"
+ "Message Forwarding."
:link '(custom-manual "(message)Forwarding")
:group 'message-interface)
(defgroup message-insertion nil
- "Message Insertion"
+ "Message Insertion."
:link '(custom-manual "(message)Insertion")
:group 'message)
(defgroup message-headers nil
- "Message Headers"
+ "Message Headers."
:link '(custom-manual "(message)Message Headers")
:group 'message)
(defgroup message-news nil
- "Composing News Messages"
+ "Composing News Messages."
:group 'message)
(defgroup message-mail nil
- "Composing Mail Messages"
+ "Composing Mail Messages."
:group 'message)
(defgroup message-faces nil
Don't touch this variable unless you really know what you're doing.
-Checks include `subject-cmsg', `multiple-headers', `sendsys',
-`message-id', `from', `long-lines', `control-chars', `size',
-`new-text', `quoting-style', `redirected-followup', `signature',
-`approved', `sender', `empty', `empty-headers', `message-id', `from',
-`subject', `shorten-followup-to', `existing-newsgroups',
-`buffer-file-name', `unchanged', `newsgroups', `reply-to',
-`continuation-headers', `long-header-lines', `invisible-text' and
-`illegible-text'."
+Checks include `approved', `continuation-headers', `control-chars',
+`empty', `existing-newsgroups', `from', `illegible-text',
+`invisible-text', `long-header-lines', `long-lines', `message-id',
+`multiple-headers', `new-text', `newsgroups', `quoting-style',
+`repeated-newsgroups', `reply-to', `sender', `sendsys', `shoot',
+`shorten-followup-to', `signature', `size', `subject', `subject-cmsg'
+and `valid-newsgroups'."
:group 'message-news
:type '(repeat sexp)) ; Fixme: improve this
(set-keymap-parent map minibuffer-local-map)
map)
"Keymap for `message-read-from-minibuffer'."
- :version "22.1")
+ :version "22.1"
+ :group 'message-various)
;;;###autoload
(defcustom message-citation-line-function 'message-insert-citation-line
table)
"Syntax table used while in Message mode.")
-(defface message-header-to-face
+(defface message-header-to
'((((class color)
(background dark))
(:foreground "green2" :bold t))
(:bold t :italic t)))
"Face used for displaying From headers."
:group 'message-faces)
+;; backward-compatibility alias
+(put 'message-header-to-face 'face-alias 'message-header-to)
-(defface message-header-cc-face
+(defface message-header-cc
'((((class color)
(background dark))
(:foreground "green4" :bold t))
(:bold t)))
"Face used for displaying Cc headers."
:group 'message-faces)
+;; backward-compatibility alias
+(put 'message-header-cc-face 'face-alias 'message-header-cc)
-(defface message-header-subject-face
+(defface message-header-subject
'((((class color)
(background dark))
(:foreground "green3"))
(:bold t)))
"Face used for displaying subject headers."
:group 'message-faces)
+;; backward-compatibility alias
+(put 'message-header-subject-face 'face-alias 'message-header-subject)
-(defface message-header-newsgroups-face
+(defface message-header-newsgroups
'((((class color)
(background dark))
(:foreground "yellow" :bold t :italic t))
(:bold t :italic t)))
"Face used for displaying newsgroups headers."
:group 'message-faces)
+;; backward-compatibility alias
+(put 'message-header-newsgroups-face 'face-alias 'message-header-newsgroups)
-(defface message-header-other-face
+(defface message-header-other
'((((class color)
(background dark))
(:foreground "#b00000"))
(:bold t :italic t)))
"Face used for displaying newsgroups headers."
:group 'message-faces)
+;; backward-compatibility alias
+(put 'message-header-other-face 'face-alias 'message-header-other)
-(defface message-header-name-face
+(defface message-header-name
'((((class color)
(background dark))
(:foreground "DarkGreen"))
(:bold t)))
"Face used for displaying header names."
:group 'message-faces)
+;; backward-compatibility alias
+(put 'message-header-name-face 'face-alias 'message-header-name)
-(defface message-header-xheader-face
+(defface message-header-xheader
'((((class color)
(background dark))
(:foreground "blue"))
(:bold t)))
"Face used for displaying X-Header headers."
:group 'message-faces)
+;; backward-compatibility alias
+(put 'message-header-xheader-face 'face-alias 'message-header-xheader)
-(defface message-separator-face
+(defface message-separator
'((((class color)
(background dark))
(:foreground "blue3"))
(:bold t)))
"Face used for displaying the separator."
:group 'message-faces)
+;; backward-compatibility alias
+(put 'message-separator-face 'face-alias 'message-separator)
-(defface message-cited-text-face
+(defface message-cited-text
'((((class color)
(background dark))
(:foreground "red"))
(:bold t)))
"Face used for displaying cited text names."
:group 'message-faces)
+;; backward-compatibility alias
+(put 'message-cited-text-face 'face-alias 'message-cited-text)
-(defface message-mml-face
+(defface message-mml
'((((class color)
(background dark))
(:foreground "ForestGreen"))
(:bold t)))
"Face used for displaying MML."
:group 'message-faces)
+;; backward-compatibility alias
+(put 'message-mml-face 'face-alias 'message-mml)
(defun message-font-lock-make-header-matcher (regexp)
(let ((form
(let ((content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)\n?"))
`((,(message-font-lock-make-header-matcher
(concat "^\\([Tt]o:\\)" content))
- (1 'message-header-name-face)
- (2 'message-header-to-face nil t))
+ (1 'message-header-name)
+ (2 'message-header-to nil t))
(,(message-font-lock-make-header-matcher
(concat "^\\(^[GBF]?[Cc][Cc]:\\|^[Rr]eply-[Tt]o:\\)" content))
- (1 'message-header-name-face)
- (2 'message-header-cc-face nil t))
+ (1 'message-header-name)
+ (2 'message-header-cc nil t))
(,(message-font-lock-make-header-matcher
(concat "^\\([Ss]ubject:\\)" content))
- (1 'message-header-name-face)
- (2 'message-header-subject-face nil t))
+ (1 'message-header-name)
+ (2 'message-header-subject nil t))
(,(message-font-lock-make-header-matcher
(concat "^\\([Nn]ewsgroups:\\|Followup-[Tt]o:\\)" content))
- (1 'message-header-name-face)
- (2 'message-header-newsgroups-face nil t))
+ (1 'message-header-name)
+ (2 'message-header-newsgroups nil t))
(,(message-font-lock-make-header-matcher
(concat "^\\([A-Z][^: \n\t]+:\\)" content))
- (1 'message-header-name-face)
- (2 'message-header-other-face nil t))
+ (1 'message-header-name)
+ (2 'message-header-other nil t))
(,(message-font-lock-make-header-matcher
(concat "^\\(X-[A-Za-z0-9-]+:\\|In-Reply-To:\\)" content))
- (1 'message-header-name-face)
- (2 'message-header-name-face))
+ (1 'message-header-name)
+ (2 'message-header-name))
,@(if (and mail-header-separator
(not (equal mail-header-separator "")))
`((,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$")
- 1 'message-separator-face))
+ 1 'message-separator))
nil)
((lambda (limit)
(re-search-forward (concat "^\\("
message-cite-prefix-regexp
"\\).*")
limit t))
- (0 'message-cited-text-face))
+ (0 'message-cited-text))
("<#/?\\(multipart\\|part\\|external\\|mml\\|secure\\)[^>]*>"
- (0 'message-mml-face))))
+ (0 'message-mml))))
"Additional expressions to highlight in Message mode.")
(integer 1000000)))
(defcustom message-alternative-emails nil
- "A regexp to match the alternative email addresses.
-The first matched address (not primary one) is used in the From field."
+ "*Regexp matching alternative email addresses.
+The first address in the To, Cc or From headers of the original
+article matching this variable is used as the From field of
+outgoing messages.
+
+This variable has precedence over posting styles and anything that runs
+off `message-setup-hook'."
:group 'message-headers
:link '(custom-manual "(message)Message Headers")
:type '(choice (const :tag "Always use primary" nil)
:type 'boolean)
(defcustom message-user-fqdn nil
- "*Domain part of Messsage-Ids."
+ "*Domain part of Message-Ids."
:version "22.1"
:group 'message-headers
:link '(custom-manual "(message)News Headers")
(file-error))
(mm-coding-system-p 'utf-8)
(executable-find idna-program)
- 'ask)
- "Whether to encode non-ASCII in domain names into ASCII according to IDNA."
+ (string= (idna-to-ascii "räksmörgås")
+ "xn--rksmrgs-5wao1o")
+ t)
+ "Whether to encode non-ASCII in domain names into ASCII according to IDNA.
+GNU Libidn, and in particular the elisp package \"idna.el\" and
+the external program \"idn\", must be installed for this
+functionality to work."
:version "22.1"
:group 'message-headers
:link '(custom-manual "(message)IDNA")
(defcustom message-valid-fqdn-regexp
(concat "[a-z0-9][-.a-z0-9]+\\." ;; [hostname.subdomain.]domain.
;; valid TLDs:
- "\\([a-z][a-z]" ;; two letter country TDLs
- "\\|biz\\|com\\|edu\\|gov\\|int\\|mil\\|net\\|org"
- "\\|aero\\|coop\\|info\\|name\\|museum"
- "\\|arpa\\|pro\\|uucp\\|bitnet\\|bofh" ;; old style?
- "\\)")
+ "\\([a-z][a-z]\\|" ;; two letter country TDLs
+ "aero\\|arpa\\|bitnet\\|biz\\|bofh\\|"
+ "cat\\|com\\|coop\\|edu\\|gov\\|"
+ "info\\|int\\|jobs\\|"
+ "mil\\|mobi\\|museum\\|name\\|net\\|"
+ "org\\|pro\\|travel\\|uucp\\)")
+ ;; http://en.wikipedia.org/wiki/List_of_Internet_top-level_domains
+ ;; http://en.wikipedia.org/wiki/GTLD
+ ;; `in the process of being approved': .asia .post .tel .sex
+ ;; "dead" nato bitnet uucp
"Regular expression that matches a valid FQDN."
;; see also: gnus-button-valid-fqdn-regexp
:version "22.1"
;;; Suggested by Jonas Steverud @ www.dtek.chalmers.se/~d4jonas/
-;;;###autoload
(defun message-change-subject (new-subject)
"Ask for NEW-SUBJECT header, append (was: <Old Subject>)."
;; <URL:http://www.landfield.com/usefor/drafts/draft-ietf-usefor-useage--1.02.unpaged>
" (was: "
old-subject ")\n")))))))))
-;;;###autoload
(defun message-mark-inserted-region (beg end)
"Mark some region in the current article with enclosing tags.
See `message-mark-insert-begin' and `message-mark-insert-end'."
(goto-char beg)
(insert message-mark-insert-begin)))
-;;;###autoload
(defun message-mark-insert-file (file)
"Insert FILE at point, marking it with enclosing tags.
See `message-mark-insert-begin' and `message-mark-insert-end'."
(goto-char p)
(insert message-mark-insert-begin)))
-;;;###autoload
(defun message-add-archive-header ()
"Insert \"X-No-Archive: Yes\" in the header and a note in the body.
The note can be customized using `message-archive-note'. When called with a
(message-add-header message-archive-header)
(message-sort-headers)))
-;;;###autoload
(defun message-cross-post-followup-to-header (target-group)
"Mangles FollowUp-To and Newsgroups header to point to TARGET-GROUP.
With prefix-argument just set Follow-Up, don't cross-post."
(insert (concat "\nFollowup-To: " target-group)))
(setq message-cross-post-old-target target-group))
-;;;###autoload
(defun message-cross-post-insert-note (target-group cross-post in-old
old-groups)
"Insert a in message body note about a set Followup or Crosspost.
(insert (concat message-followup-to-note target-group "\n"))
(insert (concat message-cross-post-note target-group "\n")))))
-;;;###autoload
(defun message-cross-post-followup-to (target-group)
"Crossposts message and set Followup-To to TARGET-GROUP.
With prefix-argument just set Follow-Up, don't cross-post."
;;; Reduce To: to Cc: or Bcc: header
-;;;###autoload
(defun message-reduce-to-to-cc ()
"Replace contents of To: header with contents of Cc: or Bcc: header."
(interactive)
(1+ max)))))
(message-sort-headers-1))))
+(defun message-info (&optional arg)
+ "Display the Message manual.
+
+Prefixed with one \\[universal-argument], display the Emacs MIME manual.
+Prefixed with two \\[universal-argument]'s, display the PGG manual."
+ (interactive "p")
+ (cond ((eq arg 16) (Info-goto-node "(pgg)Top"))
+ ((eq arg 4) (Info-goto-node "(emacs-mime)Top"))
+ (t (Info-goto-node "(message)Top"))))
\f
'(:help "Ask, then arrange to send message at that time"))]
["Kill Message" message-kill-buffer
,@(if (featurep 'xemacs) '(t)
- '(:help "Delete this message without sending"))]))
+ '(:help "Delete this message without sending"))]
+ "----"
+ ["Message manual" message-info
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Display the Message manual"))]))
(easy-menu-define
message-mode-field-menu message-mode-map ""
(set (make-local-variable 'font-lock-defaults)
'(message-font-lock-keywords t))
(if (boundp 'tool-bar-map)
- (set (make-local-variable 'tool-bar-map) (message-tool-bar-map))))
+ (set (make-local-variable 'tool-bar-map) (message-make-tool-bar))))
(easy-menu-add message-mode-menu message-mode-map)
(easy-menu-add message-mode-field-menu message-mode-map)
(gnus-make-local-hook 'after-change-functions)
(or (search-forward (concat "\n" mail-header-separator "\n") nil t)
(search-forward-regexp "[^:]+:\\([^\n]\\|\n[ \t]\\)+\n\n" nil t)))
+(defun message-in-body-p ()
+ "Return t if point is in the message body."
+ (let ((body (save-excursion (message-goto-body) (point))))
+ (>= (point) body)))
+
(defun message-goto-eoh ()
"Move point to the end of the headers."
(interactive)
(message-carefully-insert-headers headers)))
(defcustom message-header-synonyms
- '((To Cc Bcc))
+ '((To Cc Bcc)
+ (Original-To))
"List of lists of header synonyms.
E.g., if this list contains a member list with elements `Cc' and `To',
then `message-carefully-insert-headers' will not insert a `To' header
(when (and message-reply-buffer
message-cite-function)
(delete-windows-on message-reply-buffer t)
- (insert-buffer message-reply-buffer)
+ (push-mark (save-excursion
+ (insert-buffer-substring message-reply-buffer)
+ (point)))
(unless arg
(funcall message-cite-function))
(message-exchange-point-and-mark)
(message-narrow-to-head-1)
(vector 0
(or (message-fetch-field "subject") "none")
- (message-fetch-field "from")
+ (or (message-fetch-field "from") "nobody")
(message-fetch-field "date")
(message-fetch-field "message-id" t)
(message-fetch-field "references")
(message-narrow-to-head-1)
(vector 0
(or (message-fetch-field "subject") "none")
- (message-fetch-field "from")
+ (or (message-fetch-field "from") "nobody")
(message-fetch-field "date")
(message-fetch-field "message-id" t)
(message-fetch-field "references")
(defun message-insert-citation-line ()
"Insert a simple citation line."
(when message-reply-headers
- (insert (mail-header-from message-reply-headers) " writes:\n\n")))
+ (insert (mail-header-from message-reply-headers) " writes:")
+ (newline)
+ (newline)))
(defun message-position-on-field (header &rest afters)
(let ((case-fold-search t))
(file-exists-p auto-save-file-name))
(and file-name
(file-exists-p file-name)))
- (yes-or-no-p (format "Remove the backup file%s? "
- (if modified " too" ""))))
+ (progn
+ ;; If the message buffer has lived in a dedicated window,
+ ;; `kill-buffer' has killed the frame. Thus the
+ ;; `yes-or-no-p' may show up in a lowered frame. Make sure
+ ;; that the user can see the question by raising the
+ ;; current frame:
+ (raise-frame)
+ (yes-or-no-p (format "Remove the backup file%s? "
+ (if modified " too" "")))))
(ignore-errors
(delete-file auto-save-file-name))
(let ((message-draft-article draft-article))
"Bury this mail BUFFER."
(let ((newbuf (other-buffer buffer)))
(bury-buffer buffer)
- (if (and (fboundp 'frame-parameters)
- (cdr (assq 'dedicated (frame-parameters)))
+ (if (and (window-dedicated-p (selected-window))
(not (null (delq (selected-frame) (visible-frame-list)))))
(delete-frame (selected-frame))
(switch-to-buffer newbuf))))
(when (let ((char (char-after)))
(or (< (mm-char-int char) 128)
(and (mm-multibyte-p)
- ;; Fixme: Wrong for Emacs 22 and for things
- ;; like undecable utf-8. Should at least
+ ;; FIXME: Wrong for Emacs 23 (unicode) and for
+ ;; things like undecable utf-8. Should at least
;; use find-coding-systems-region.
(memq (char-charset char)
'(eight-bit-control eight-bit-graphic
(let ((message-deletable-headers
(if news nil message-deletable-headers)))
(message-generate-headers headers))
+ ;; Check continuation headers.
+ (message-check 'continuation-headers
+ (goto-char (point-min))
+ (while (re-search-forward "^[^ \t\n][^ \t\n:]*[ \t\n]" nil t)
+ (goto-char (match-beginning 0))
+ (if (y-or-n-p "Fix continuation lines? ")
+ (insert " ")
+ (forward-line 1)
+ (unless (y-or-n-p "Send anyway? ")
+ (error "Failed to send the message")))))
;; Let the user do all of the above.
(run-hooks 'message-header-hook))
(unwind-protect
'call-process-region
(append
(list (point-min) (point-max)
- (if (boundp 'sendmail-program)
- sendmail-program
- "/usr/lib/sendmail")
+ (cond ((boundp 'sendmail-program)
+ sendmail-program)
+ ((file-exists-p "/usr/sbin/sendmail")
+ "/usr/sbin/sendmail")
+ ((file-exists-p "/usr/lib/sendmail")
+ "/usr/lib/sendmail")
+ ((file-exists-p "/usr/ucblib/sendmail")
+ "/usr/ucblib/sendmail")
+ (t "fakemail"))
nil errbuf nil "-oi")
;; Always specify who from,
;; since some systems have broken sendmails.
(zerop
(length
(setq to (completing-read
- "Followups to (default: no Followup-To header) "
+ "Followups to (default no Followup-To header): "
(mapcar #'list
(cons "poster"
(message-tokenize-header
(message-check 'continuation-headers
(goto-char (point-min))
(let ((do-posting t))
- (while (re-search-forward "^[^ \t\n][^:\n]*$" nil t)
+ (while (re-search-forward "^[^ \t\n][^ \t\n:]*[ \t\n]" nil t)
+ (goto-char (match-beginning 0))
(if (y-or-n-p "Fix continuation lines? ")
- (progn
- (goto-char (match-beginning 0))
- (insert " "))
+ (insert " ")
+ (forward-line 1)
(unless (y-or-n-p "Send anyway? ")
(setq do-posting nil))))
do-posting))
(* 25 25)))
(let ((tm (current-time)))
(concat
- (if (memq system-type '(ms-dos emx vax-vms))
+ (if (or (memq system-type '(ms-dos emx vax-vms))
+ ;; message-number-base36 doesn't handle bigints.
+ (floatp (user-uid)))
(let ((user (downcase (user-login-name))))
(while (string-match "[^a-z0-9_]" user)
(aset user (match-beginning 0) ?_))
(let ((field (message-fetch-field header))
rhs ace address)
(when field
- (dolist (address (mail-header-parse-addresses field))
- (setq address (car address)
- rhs (downcase (or (cadr (split-string address "@")) ""))
- ace (downcase (idna-to-ascii rhs)))
+ (dolist (rhs
+ (mm-delete-duplicates
+ (mapcar (lambda (rhs) (or (cadr (split-string rhs "@")) ""))
+ (mapcar 'downcase
+ (mapcar
+ 'car (mail-header-parse-addresses field))))))
+ (setq ace (downcase (idna-to-ascii rhs)))
(when (and (not (equal rhs ace))
(or (not (eq message-use-idna 'ask))
- (y-or-n-p (format "Replace %s with %s? " rhs ace))))
+ (y-or-n-p (format "Replace %s with %s in %s:? "
+ rhs ace header))))
(goto-char (point-min))
(while (re-search-forward (concat "^" header ":") nil t)
(message-narrow-to-field)
(message-narrow-to-head)
(message-idna-to-ascii-rhs-1 "From")
(message-idna-to-ascii-rhs-1 "To")
+ (message-idna-to-ascii-rhs-1 "Reply-To")
+ (message-idna-to-ascii-rhs-1 "Mail-Reply-To")
+ (message-idna-to-ascii-rhs-1 "Mail-Followup-To")
(message-idna-to-ascii-rhs-1 "Cc")))))
(defun message-generate-headers (headers)
;; The element is a symbol. We insert the value
;; of this symbol, if any.
(symbol-value header))
- ((not (message-check-element header))
+ ((not (message-check-element
+ (intern (downcase (symbol-name header)))))
;; We couldn't generate a value for this header,
;; so we just ask the user.
(read-from-minibuffer
(defun message-headers-to-generate (headers included-headers excluded-headers)
"Return a list that includes all headers from HEADERS.
-If INCLUDED-HEADERS is a list, just include those headers. If if is
+If INCLUDED-HEADERS is a list, just include those headers. If it is
t, include all headers. In any case, headers from EXCLUDED-HEADERS
are not included."
(let ((result nil)
(when message-default-mail-headers
(insert message-default-mail-headers)
(or (bolp) (insert ?\n)))
- (save-restriction
- (message-narrow-to-headers)
- (if message-alternative-emails
- (message-use-alternative-email-as-from)))
(when message-generate-headers-first
(message-generate-headers
(message-headers-to-generate
(set-buffer-modified-p nil)
(setq buffer-undo-list nil)
(run-hooks 'message-setup-hook)
+ ;; Do this last to give it precedence over posting styles, etc.
+ (when (message-mail-p)
+ (save-restriction
+ (message-narrow-to-headers)
+ (if message-alternative-emails
+ (message-use-alternative-email-as-from))))
(message-position-point)
(undo-boundary))
(setq message-id (message-fetch-field "message-id" t)
references (message-fetch-field "references")
date (message-fetch-field "date")
- from (message-fetch-field "from")
+ from (or (message-fetch-field "from") "nobody")
subject (or (message-fetch-field "subject") "none"))
(when gnus-list-identifiers
(setq subject (message-strip-list-identifiers subject)))
(defun message-is-yours-p ()
"Non-nil means current article is yours.
-If you have added 'cancel-messages to 'message-shoot-gnksa-feet', all articles
+If you have added 'cancel-messages to `message-shoot-gnksa-feet', all articles
are yours except those that have Cancel-Lock header not belonging to you.
-Instead of shooting GNKSA feet, you should modify 'message-alternative-emails'
+Instead of shooting GNKSA feet, you should modify `message-alternative-emails'
regexp to match all of yours addresses."
;; Canlock-logic as suggested by Per Abrahamsen
;; <abraham@dina.kvl.dk>
;; Support for toolbar
(eval-when-compile
- (defvar tool-bar-map)
(defvar tool-bar-mode))
-(defun message-tool-bar-local-item-from-menu (command icon in-map &optional from-map &rest props)
- ;; We need to make tool bar entries in local keymaps with
- ;; `tool-bar-local-item-from-menu' in Emacs > 21.3
- (if (fboundp 'tool-bar-local-item-from-menu)
- ;; This is for Emacs 21.3
- (tool-bar-local-item-from-menu command icon in-map from-map props)
- (tool-bar-add-item-from-menu command icon from-map props)))
-
-(defun message-tool-bar-map ()
- (or message-tool-bar-map
- (setq message-tool-bar-map
- (and
- (condition-case nil (require 'tool-bar) (error nil))
- (fboundp 'tool-bar-add-item-from-menu)
+;; Note: The :set function in the `message-tool-bar*' variables will only
+;; affect _new_ message buffers. We might add a function that walks thru all
+;; message-mode buffers and force the update.
+(defun message-tool-bar-update (&optional symbol value)
+ "Update message mode toolbar.
+Setter function for custom variables."
+ (setq-default message-tool-bar-map nil)
+ (when symbol
+ ;; When used as ":set" function:
+ (set-default symbol value)))
+
+(defcustom message-tool-bar (if (eq gmm-tool-bar-style 'gnome)
+ 'message-tool-bar-gnome
+ 'message-tool-bar-retro)
+ "Specifies the message mode tool bar.
+
+It can be either a list or a symbol refering to a list. See
+`gmm-tool-bar-from-list' for the format of the list. The
+default key map is `message-mode-map'.
+
+Pre-defined symbols include `message-tool-bar-gnome' and
+`message-tool-bar-retro'."
+ :type '(repeat gmm-tool-bar-list-item)
+ :type '(choice (const :tag "GNOME style" message-tool-bar-gnome)
+ (const :tag "Retro look" message-tool-bar-retro)
+ (repeat :tag "User defined list" gmm-tool-bar-item)
+ (symbol))
+ :version "22.1" ;; Gnus 5.10.9
+ :initialize 'custom-initialize-default
+ :set 'message-tool-bar-update
+ :group 'message)
+
+(defcustom message-tool-bar-gnome
+ '((ispell-message "spell" nil
+ :visible (or (not (boundp 'flyspell-mode))
+ (not flyspell-mode)))
+ (flyspell-buffer "spell" t
+ :visible (and (boundp 'flyspell-mode)
+ flyspell-mode)
+ :help "Flyspell whole buffer")
+ (gmm-ignore "separator")
+ (message-send-and-exit "mail/send")
+ (message-dont-send "mail/save-draft")
+ (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)
+ (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"))
+ "List of items for the message tool bar (GNOME style).
+
+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
+ :initialize 'custom-initialize-default
+ :set 'message-tool-bar-update
+ :group 'message)
+
+(defcustom message-tool-bar-retro
+ '(;; Old Emacs 21 icon for consistency.
+ (message-send-and-exit "gnus/mail_send")
+ (message-kill-buffer "close")
+ (message-dont-send "cancel")
+ (mml-attach-file "attach" mml-mode-map)
+ (ispell-message "spell")
+ (mml-preview "preview" mml-mode-map)
+ (message-insert-importance-high "gnus/important")
+ (message-insert-importance-low "gnus/unimportant")
+ (message-insert-disposition-notification-to "gnus/receipt"))
+ "List of items for the message tool bar (retro style).
+
+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
+ :initialize 'custom-initialize-default
+ :set 'message-tool-bar-update
+ :group 'message)
+
+(defcustom message-tool-bar-zap-list
+ '(new-file open-file dired kill-buffer write-file
+ print-buffer customize help)
+ "List of icon items from the global tool bar.
+These items are not displayed on the message mode tool bar.
+
+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
+ :initialize 'custom-initialize-default
+ :set 'message-tool-bar-update
+ :group 'message)
+
+(defvar image-load-path)
+
+(defun message-make-tool-bar (&optional force)
+ "Make a message mode tool bar from `message-tool-bar-list'.
+When FORCE, rebuild the tool bar."
+ (when (and (not (featurep 'xemacs))
+ (boundp 'tool-bar-mode)
tool-bar-mode
- (let ((tool-bar-map (copy-keymap tool-bar-map))
- (load-path (mm-image-load-path)))
- ;; Zap some items which aren't so relevant and take
- ;; up space.
- (dolist (key '(print-buffer kill-buffer save-buffer
- write-file dired open-file))
- (define-key tool-bar-map (vector key) nil))
- (message-tool-bar-local-item-from-menu
- 'message-send-and-exit "mail_send" tool-bar-map message-mode-map)
- (message-tool-bar-local-item-from-menu
- 'message-kill-buffer "close" tool-bar-map message-mode-map)
- (message-tool-bar-local-item-from-menu
- 'message-dont-send "cancel" tool-bar-map message-mode-map)
- (message-tool-bar-local-item-from-menu
- 'mml-attach-file "attach" tool-bar-map mml-mode-map)
- (message-tool-bar-local-item-from-menu
- 'ispell-message "spell" tool-bar-map message-mode-map)
- (message-tool-bar-local-item-from-menu
- 'mml-preview "preview"
- tool-bar-map mml-mode-map)
- (message-tool-bar-local-item-from-menu
- 'message-insert-importance-high "important"
- tool-bar-map message-mode-map)
- (message-tool-bar-local-item-from-menu
- 'message-insert-importance-low "unimportant"
- tool-bar-map message-mode-map)
- (message-tool-bar-local-item-from-menu
- 'message-insert-disposition-notification-to "receipt"
- tool-bar-map message-mode-map)
- tool-bar-map)))))
+ (or (not message-tool-bar-map) force))
+ (setq message-tool-bar-map
+ (let* ((load-path
+ (gmm-image-load-path-for-library "message"
+ "mail/save-draft.xpm"
+ nil t))
+ (image-load-path (cons (car load-path)
+ (when (boundp 'image-load-path)
+ image-load-path))))
+ (gmm-tool-bar-from-list message-tool-bar
+ message-tool-bar-zap-list
+ 'message-mode-map))))
+ message-tool-bar-map)
;;; Group name completion.
:version "22.1"
:group 'message
:link '(custom-manual "(message)Various Commands")
- :type 'function)
+ :type '(choice (const nil)
+ function))
(defun message-tab ()
"Complete names according to `message-completion-alist'.
(lookup-key global-map "\t")
'indent-relative))))
+(eval-and-compile
+ (condition-case nil
+ (with-temp-buffer
+ (let ((standard-output (current-buffer)))
+ (eval '(display-completion-list nil "")))
+ (defalias 'message-display-completion-list 'display-completion-list))
+ (error ;; Don't use `wrong-number-of-arguments' here because of XEmacs.
+ (defun message-display-completion-list (completions &optional ignore)
+ "Display the list of completions, COMPLETIONS, using `standard-output'."
+ (display-completion-list completions)))))
+
(defun message-expand-group ()
"Expand the group name under point."
(let* ((b (save-excursion
(let ((buffer-read-only nil))
(erase-buffer)
(let ((standard-output (current-buffer)))
- (display-completion-list (sort completions 'string<)))
+ (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))))))))))
(read-string prompt initial-contents))))
(defun message-use-alternative-email-as-from ()
+ "Set From field of the outgoing message to the first matching
+address in `message-alternative-emails', looking at To, Cc and
+From headers in the original article."
(require 'mail-utils)
(let* ((fields '("To" "Cc"))
(emails
emails nil))
(pop emails))
(unless (or (not email) (equal email user-mail-address))
+ (message-remove-header "From")
(goto-char (point-max))
(insert "From: " email "\n"))))