-;;; message.el --- composing mail and news messages
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000
+;;; message.el --- composing mail and news messages -*- coding: iso-latin-1 -*-
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
(defcustom message-send-rename-function nil
"Function called to rename the buffer after sending it."
:group 'message-buffers
- :type 'function)
+ :type '(choice function (const nil)))
(defcustom message-fcc-handler-function 'message-output
"*A function called to save outgoing articles.
(defcustom message-from-style 'default
"*Specifies how \"From\" headers look.
-If `nil', they contain just the return address like:
+If nil, they contain just the return address like:
king@grassland.com
If `parens', they look like:
king@grassland.com (Elvis Parsley)
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."
+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'."
:group 'message-news
- :type '(repeat sexp))
+ :type '(repeat sexp)) ; Fixme: improve this
(defcustom message-required-news-headers
'(From Newsgroups Subject Date Message-ID
:type 'boolean)
(defcustom message-generate-new-buffers 'unique
- "*Non-nil means that a new message buffer will be created whenever `message-setup' is called.
+ "*Non-nil means create a new message buffer whenever `message-setup' is called.
If this is a function, call that function with three parameters: The type,
the to address and the group name. (Any of these may be nil.) The function
should return the new buffer name."
:group 'message-buffers
:type 'boolean)
-(defvar gnus-local-organization)
+(eval-when-compile
+ (defvar gnus-local-organization))
(defcustom message-user-organization
(or (and (boundp 'gnus-local-organization)
(stringp gnus-local-organization)
(defcustom message-make-forward-subject-function
'message-forward-subject-author-subject
- "*A list of functions that are called to generate a subject header for forwarded messages.
+ "*List of functions called to generate subject headers for forwarded messages.
The subject generated by the previous function is passed into each
successive function.
The provided functions are:
-* message-forward-subject-author-subject (Source of article (author or
+* `message-forward-subject-author-subject' (Source of article (author or
newsgroup)), in brackets followed by the subject
-* message-forward-subject-fwd (Subject of article with 'Fwd:' prepended
+* `message-forward-subject-fwd' (Subject of article with 'Fwd:' prepended
to it."
:group 'message-forwarding
:type '(radio (function-item message-forward-subject-author-subject)
- (function-item message-forward-subject-fwd)))
+ (function-item message-forward-subject-fwd)
+ (repeat :tag "List of functions" function)))
(defcustom message-forward-as-mime t
"*If non-nil, forward messages as an inline/rfc822 MIME section. Otherwise, directly inline the old message in the forwarded message."
+ :version "21.1"
:group 'message-forwarding
:type 'boolean)
(defcustom message-forward-show-mml t
"*If non-nil, forward messages are shown as mml. Otherwise, forward messages are unchanged."
+ :version "21.1"
:group 'message-forwarding
:type 'boolean)
(defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus"
"*All headers that match this regexp will be deleted when forwarding a message."
+ :version "21.1"
:group 'message-forwarding
:type '(choice (const :tag "None" nil)
regexp))
variable `mail-header-separator'.
Valid values include `message-send-mail-with-sendmail' (the default),
-`message-send-mail-with-mh', `message-send-mail-with-qmail' and
-`smtpmail-send-it'."
+`message-send-mail-with-mh', `message-send-mail-with-qmail',
+`smtpmail-send-it' and `feedmail-send-it'.
+
+See also `send-mail-function'."
:type '(radio (function-item message-send-mail-with-sendmail)
(function-item message-send-mail-with-mh)
(function-item message-send-mail-with-qmail)
(function-item smtpmail-send-it)
+ (function-item feedmail-send-it)
(function :tag "Other"))
:group 'message-sending
:group 'message-mail)
:type 'function)
(defcustom message-reply-to-function nil
- "Function that should return a list of headers.
+ "If non-nil, function that should return a list of headers.
This function should pick out addresses from the To, Cc, and From headers
and respond with new To and Cc headers."
:group 'message-interface
- :type 'function)
+ :type '(choice function (const nil)))
(defcustom message-wide-reply-to-function nil
- "Function that should return a list of headers.
+ "If non-nil, function that should return a list of headers.
This function should pick out addresses from the To, Cc, and From headers
and respond with new To and Cc headers."
:group 'message-interface
- :type 'function)
+ :type '(choice function (const nil)))
(defcustom message-followup-to-function nil
- "Function that should return a list of headers.
+ "If non-nil, function that should return a list of headers.
This function should pick out addresses from the To, Cc, and From headers
and respond with new To and Cc headers."
:group 'message-interface
- :type 'function)
+ :type '(choice function (const nil)))
(defcustom message-use-followup-to 'ask
"*Specifies what to do with Followup-To header.
(const ask)))
(defcustom message-sendmail-f-is-evil nil
- "*Non-nil means that \"-f username\" should not be added to the sendmail command line.
+ "*Non-nil means don't add \"-f username\" to the sendmail command line.
Doing so would be even more evil than leaving it out."
:group 'message-sending
:type 'boolean)
Folding `References' makes ancient versions of INN create incorrect
NOV lines.")
-(defvar gnus-post-method)
-(defvar gnus-select-method)
+(eval-when-compile
+ (defvar gnus-post-method)
+ (defvar gnus-select-method))
(defcustom message-post-method
(cond ((and (boundp 'gnus-post-method)
(listp gnus-post-method)
;;;###autoload
(defcustom message-signature-file "~/.signature"
- "*File containing the text inserted at end of message buffer."
- :type 'file
+ "*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."
+ :type '(choice file (const :tags "None" nil))
:group 'message-insertion)
(defcustom message-distribution-function nil
"*Function called to return a Distribution header."
:group 'message-news
:group 'message-headers
- :type 'function)
+ :type '(choice function (const nil)))
(defcustom message-expires 14
"Number of days before your article expires."
(define-widget 'message-header-lines 'text
"All header lines must be LFD terminated."
- :format "%t:%n%v"
+ :format "%{%t%}:%n%v"
:valid-regexp "^\\'"
:error "All header lines must be newline terminated")
PREDICATE returns non-nil. FUNCTION is called with one parameter --
the prefix.")
-(defvar message-mail-alias-type 'abbrev
+(defcustom message-mail-alias-type 'abbrev
"*What alias expansion type to use in Message buffers.
The default is `abbrev', which uses mailabbrev. nil switches
-mail aliases off.")
+mail aliases off."
+ :group 'message
+ :link '(custom-manual "(message)Mail Aliases")
+ :type '(choice (const :tag "Use Mailabbrev" abbrev)
+ (const :tag "No expansion" nil)))
(defcustom message-auto-save-directory
- (nnheader-concat message-directory "drafts/")
+ (file-name-as-directory (nnheader-concat message-directory "drafts"))
"*Directory where Message auto-saves buffers if Gnus isn't running.
If nil, Message won't auto-save."
:group 'message-buffers
- :type 'directory)
+ :type '(choice directory (const :tag "Don't auto-save" nil)))
(defcustom message-buffer-naming-style 'unique
"*The way new message buffers are named.
Valid valued are `unique' and `unsent'."
+ :version "21.1"
:group 'message-buffers
:type '(choice (const :tag "unique" unique)
(const :tag "unsent" unsent)))
-(defcustom message-default-charset nil
- "Default charset used in non-MULE XEmacsen."
+(defcustom message-default-charset
+ (and (not (mm-multibyte-p)) 'iso-8859-1)
+ "Default charset used in non-MULE Emacsen.
+If nil, you might be asked to input the charset."
+ :version "21.1"
:group 'message
:type 'symbol)
-(defcustom message-dont-reply-to-names
+(defcustom message-dont-reply-to-names
(and (boundp 'rmail-dont-reply-to-names) rmail-dont-reply-to-names)
"*A regexp specifying names to prune when doing wide replies.
A value of nil means exclude your own name only."
+ :version "21.1"
:group 'message
:type '(choice (const :tag "Yourself" nil)
regexp))
(defvar message-mode-abbrev-table text-mode-abbrev-table
"Abbrev table used in Message mode buffers.
Defaults to `text-mode-abbrev-table'.")
-(defgroup message-headers nil
- "Message headers."
- :link '(custom-manual "(message)Variables")
- :group 'message)
(defface message-header-to-face
'((((class color)
(background dark))
- (:foreground "green2" :bold t))
+ (:foreground "green2" :weight bold))
(((class color)
(background light))
- (:foreground "MidnightBlue" :bold t))
+ (:foreground "MidnightBlue" :weight bold))
(t
- (:bold t :italic t)))
+ (:weight bold :slant italic)))
"Face used for displaying From headers."
:group 'message-faces)
(defface message-header-cc-face
'((((class color)
(background dark))
- (:foreground "green4" :bold t))
+ (:foreground "green4" :weight bold))
(((class color)
(background light))
(:foreground "MidnightBlue"))
(t
- (:bold t)))
+ (:weight bold)))
"Face used for displaying Cc headers."
:group 'message-faces)
(:foreground "green3"))
(((class color)
(background light))
- (:foreground "navy blue" :bold t))
+ (:foreground "navy blue" :weight bold))
(t
- (:bold t)))
+ (:weight bold)))
"Face used for displaying subject headers."
:group 'message-faces)
(defface message-header-newsgroups-face
'((((class color)
(background dark))
- (:foreground "yellow" :bold t :italic t))
+ (:foreground "yellow" :weight bold :slant italic))
(((class color)
(background light))
- (:foreground "blue4" :bold t :italic t))
+ (:foreground "blue4" :weight bold :slant italic))
(t
- (:bold t :italic t)))
+ (:weight bold :slant italic)))
"Face used for displaying newsgroups headers."
:group 'message-faces)
(background light))
(:foreground "steel blue"))
(t
- (:bold t :italic t)))
+ (:weight bold :slant italic)))
"Face used for displaying newsgroups headers."
:group 'message-faces)
(background light))
(:foreground "cornflower blue"))
(t
- (:bold t)))
+ (:weight bold)))
"Face used for displaying header names."
:group 'message-faces)
(background light))
(:foreground "blue"))
(t
- (:bold t)))
+ (:weight bold)))
"Face used for displaying X-Header headers."
:group 'message-faces)
(background light))
(:foreground "brown"))
(t
- (:bold t)))
+ (:weight bold)))
"Face used for displaying the separator."
:group 'message-faces)
(background light))
(:foreground "red"))
(t
- (:bold t)))
+ (:weight bold)))
"Face used for displaying cited text names."
:group 'message-faces)
(background light))
(:foreground "ForestGreen"))
(t
- (:bold t)))
+ (:weight bold)))
"Face used for displaying MML."
:group 'message-faces)
(defvar message-font-lock-keywords
- (let* ((cite-prefix "A-Za-z")
+ (let* ((cite-prefix "[:alpha:]")
(cite-suffix (concat cite-prefix "0-9_.@-"))
- (content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)"))
+ (content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)\n?"))
`((,(concat "^\\([Tt]o:\\)" content)
(1 'message-header-name-face)
(2 'message-header-to-face nil t))
(unbold-region b e)
(ununderline-region b e))))
"Alist of mail and news faces for facemenu.
-The cdr of ech entry is a function for applying the face to a region.")
+The cdr of each entry is a function for applying the face to a region.")
(defcustom message-send-hook nil
"Hook run before sending messages."
(defcustom message-send-mail-partially-limit 1000000
"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."
+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"
:group 'message-buffers
:type '(choice (const :tag "unlimited" nil)
(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."
+ :group 'message-headers
+ :type '(choice (const :tag "Always use primary" nil)
+ regexp))
+
+(defcustom message-mail-user-agent nil
+ "Like `mail-user-agent'.
+Except if it is nil, use Gnus native MUA; if it is t, use
+`mail-user-agent'."
+ :type '(radio (const :tag "Gnus native"
+ :format "%t\n"
+ nil)
+ (const :tag "`mail-user-agent'"
+ :format "%t\n"
+ t)
+ (function-item :tag "Default Emacs mail"
+ :format "%t\n"
+ sendmail-user-agent)
+ (function-item :tag "Emacs interface to MH"
+ :format "%t\n"
+ mh-e-user-agent)
+ (function :tag "Other"))
+ :version "21.1"
+ :group 'message)
+
;;; Internal variables.
+(defvar message-sending-message "Sending...")
(defvar message-buffer-list nil)
(defvar message-this-is-news nil)
(defvar message-this-is-mail nil)
(defvar message-posting-charset nil)
;; Byte-compiler warning
-(defvar gnus-active-hashtb)
-(defvar gnus-read-active-file)
+(eval-when-compile
+ (defvar gnus-active-hashtb)
+ (defvar gnus-read-active-file))
;;; Regexp matching the delimiter of messages in UNIX mail format
;;; (UNIX From lines), minus the initial ^. It should be a copy
(autoload 'gnus-request-post "gnus-int")
(autoload 'gnus-alive-p "gnus-util")
(autoload 'gnus-group-name-charset "gnus-group")
- (autoload 'rmail-output "rmail"))
+ (autoload 'rmail-output "rmailout"))
\f
;;;
(defmacro message-y-or-n-p (question show &rest text)
- "Ask QUESTION, displaying the rest of the arguments in a temp. buffer if SHOW"
+ "Ask QUESTION, displaying remaining args in a temporary buffer if SHOW."
`(message-talkative-question 'y-or-n-p ,question ,show ,@text))
-;; Delete the current line (and the next N lines.);
(defmacro message-delete-line (&optional n)
+ "Delete the current line (and the next N lines)."
`(delete-region (progn (beginning-of-line) (point))
(progn (forward-line ,(or n 1)) (point))))
(defun message-unquote-tokens (elems)
- "Remove double quotes (\") from strings in list."
+ "Remove double quotes (\") from strings in list ELEMS."
(mapcar (lambda (item)
(while (string-match "^\\(.*\\)\"\\(.*\\)$" item)
- (setq item (concat (match-string 1 item)
+ (setq item (concat (match-string 1 item)
(match-string 2 item))))
item)
elems))
(defun message-fetch-reply-field (header)
- "Fetch FIELD from the message we're replying to."
+ "Fetch field HEADER from the message we're replying to."
(when (and message-reply-buffer
(buffer-name message-reply-buffer))
(save-excursion
(byte-code-function-p form)))
(defun message-strip-list-identifiers (subject)
- "Remove list identifiers in `gnus-list-identifiers'."
+ "Remove list identifiers in `gnus-list-identifiers' from string SUBJECT."
(require 'gnus-sum) ; for gnus-list-identifiers
(let ((regexp (if (stringp gnus-list-identifiers)
gnus-list-identifiers
(mapconcat 'identity gnus-list-identifiers " *\\|"))))
- (if (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp
+ (if (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp
" *\\)\\)+\\(Re: +\\)?\\)") subject)
(concat (substring subject 0 (match-beginning 1))
(or (match-string 3 subject)
subject)))
(defun message-strip-subject-re (subject)
- "Remove \"Re:\" from subject lines."
+ "Remove \"Re:\" from subject lines in string SUBJECT."
(if (string-match message-subject-re-regexp subject)
(substring subject (match-end 0))
subject))
(defun message-remove-header (header &optional is-regexp first reverse)
"Remove HEADER in the narrowed buffer.
-If REGEXP, HEADER is a regular expression.
+If IS-REGEXP, HEADER is a regular expression.
If FIRST, only remove the first instance of the header.
Return the number of headers removed."
(goto-char (point-min))
(point-max)))
(goto-char (point-min)))
-(defun message-narrow-to-head ()
- "Narrow the buffer to the head of the message.
-Point is left at the beginning of the narrowed-to region."
- (widen)
+(defun message-narrow-to-head-1 ()
+ "Like `message-narrow-to-head'. Don't widen."
(narrow-to-region
(goto-char (point-min))
(if (search-forward "\n\n" nil 1)
(point-max)))
(goto-char (point-min)))
+(defun message-narrow-to-head ()
+ "Narrow the buffer to the head of the message.
+Point is left at the beginning of the narrowed-to region."
+ (widen)
+ (message-narrow-to-head-1))
+
(defun message-narrow-to-headers-or-head ()
"Narrow the buffer to the head of the message."
(widen)
["Kill To Signature" message-kill-to-signature t]
["Newline and Reformat" message-newline-and-reformat t]
["Rename buffer" message-rename-buffer t]
- ["Spellcheck" ispell-message t]
- ["Attach file as MIME" mml-attach-file t]
+ ["Spellcheck" ispell-message
+ :help "Spellcheck this message"]
+ ["Attach file as MIME" mml-attach-file
+ :help "Attach a file at point"]
"----"
- ["Send Message" message-send-and-exit t]
- ["Abort Message" message-dont-send t]
- ["Kill Message" message-kill-buffer t]))
+ ["Send Message" message-send-and-exit
+ :help "Send this message"]
+ ["Abort Message" message-dont-send
+ :help "File this draft message and exit"]
+ ["Kill Message" message-kill-buffer
+ :help "Delete this message without sending"]))
(easy-menu-define
message-mode-field-menu message-mode-map ""
["Body" message-goto-body t]
["Signature" message-goto-signature t]))
-(defvar facemenu-add-face-function)
-(defvar facemenu-remove-face-function)
+(eval-when-compile
+ (defvar facemenu-add-face-function)
+ (defvar facemenu-remove-face-function))
;;;###autoload
(defun message-mode ()
"Major mode for editing mail and news to be sent.
-Like Text Mode but with these additional commands:
-C-c C-s message-send (send the message) C-c C-c message-send-and-exit
-C-c C-d Pospone sending the message C-c C-k Kill the message
+Like Text Mode but with these additional commands:\\<message-mode-map>
+C-c C-s `message-send' (send the message) C-c C-c `message-send-and-exit'
+C-c C-d Postpone sending the message C-c C-k Kill the message
C-c C-f move to a header field (and create it if there isn't):
C-c C-f C-t move to To C-c C-f C-s move to Subject
C-c C-f C-c move to Cc C-c C-f C-b move to Bcc
C-c C-f C-u move to Summary C-c C-f C-n move to Newsgroups
C-c C-f C-k move to Keywords C-c C-f C-d move to Distribution
C-c C-f C-f move to Followup-To
-C-c C-t message-insert-to (add a To header to a news followup)
-C-c C-n message-insert-newsgroups (add a Newsgroup header to a news reply)
-C-c C-b message-goto-body (move to beginning of message text).
-C-c C-i message-goto-signature (move to the beginning of the signature).
-C-c C-w message-insert-signature (insert `message-signature-file' file).
-C-c C-y message-yank-original (insert current message, if any).
-C-c C-q message-fill-yanked-message (fill what was yanked).
-C-c C-e message-elide-region (elide the text between point and mark).
-C-c C-v message-delete-not-region (remove the text outside the region).
-C-c C-z message-kill-to-signature (kill the text up to the signature).
-C-c C-r message-caesar-buffer-body (rot13 the message body).
-C-c C-a mml-attach-file (attach a file as MIME).
-M-RET message-newline-and-reformat (break the line and reformat)."
+C-c C-t `message-insert-to' (add a To header to a news followup)
+C-c C-n `message-insert-newsgroups' (add a Newsgroup header to a news reply)
+C-c C-b `message-goto-body' (move to beginning of message text).
+C-c C-i `message-goto-signature' (move to the beginning of the signature).
+C-c C-w `message-insert-signature' (insert `message-signature-file' file).
+C-c C-y `message-yank-original' (insert current message, if any).
+C-c C-q `message-fill-yanked-message' (fill what was yanked).
+C-c C-e `message-elide-region' (elide the text between point and mark).
+C-c C-v `message-delete-not-region' (remove the text outside the region).
+C-c C-z `message-kill-to-signature' (kill the text up to the signature).
+C-c C-r `message-caesar-buffer-body' (rot13 the message body).
+C-c C-a `mml-attach-file' (attach a file as MIME).
+M-RET `message-newline-and-reformat' (break the line and reformat)."
(interactive)
(if (local-variable-p 'mml-buffer-list (current-buffer))
(mml-destroy-buffers))
(error "Face %s not configured for %s mode" face mode-name)))
"")
facemenu-remove-face-function t)
- (make-local-variable 'paragraph-separate)
- (make-local-variable 'paragraph-start)
- ;; `-- ' precedes the signature. `-----' appears at the start of the
- ;; lines that delimit forwarded messages.
- ;; Lines containing just >= 3 dashes, perhaps after whitespace,
- ;; are also sometimes used and should be separators.
- (setq paragraph-start
- (concat (regexp-quote mail-header-separator)
- "$\\|[ \t]*[a-z0-9A-Z]*>+[ \t]*$\\|[ \t]*$\\|"
- "-- $\\|---+$\\|"
- page-delimiter
- ;;!!! Uhm... shurely this can't be right?
- "[> " (regexp-quote message-yank-prefix) "]+$"))
- (setq paragraph-separate paragraph-start)
(make-local-variable 'message-reply-headers)
(setq message-reply-headers nil)
(make-local-variable 'message-newsreader)
(set (make-local-variable 'message-sent-message-via) nil)
(set (make-local-variable 'message-checksum) nil)
(set (make-local-variable 'message-mime-part) 0)
+ (message-setup-fill-variables)
+ ;; Allow using comment commands to add/remove quoting.
+ (set (make-local-variable 'comment-start) message-yank-prefix)
;;(when (fboundp 'mail-hist-define-keys)
;; (mail-hist-define-keys))
(if (featurep 'xemacs)
(message-setup-toolbar)
(set (make-local-variable 'font-lock-defaults)
- '(message-font-lock-keywords t)))
+ '(message-font-lock-keywords t))
+ (if (boundp 'message-tool-bar-map)
+ (set (make-local-variable 'tool-bar-map) message-tool-bar-map)))
(easy-menu-add message-mode-menu message-mode-map)
(easy-menu-add message-mode-field-menu message-mode-map)
;; Allow mail alias things.
(if (fboundp 'mail-abbrevs-setup)
(mail-abbrevs-setup)
(mail-aliases-setup)))
- (message-set-auto-save-file-name)
- (make-local-variable 'adaptive-fill-regexp)
- (setq adaptive-fill-regexp
- (concat "[ \t]*[-a-z0-9A-Z]*\\(>[ \t]*\\)+[ \t]*\\|" adaptive-fill-regexp))
- (unless (boundp 'adaptive-fill-first-line-regexp)
- (setq adaptive-fill-first-line-regexp nil))
- (make-local-variable 'adaptive-fill-first-line-regexp)
- (setq adaptive-fill-first-line-regexp
- (concat "[ \t]*[-a-z0-9A-Z]*\\(>[ \t]*\\)+[ \t]*\\|"
- adaptive-fill-first-line-regexp))
- (make-local-variable 'auto-fill-inhibit-regexp)
- (setq auto-fill-inhibit-regexp "^[A-Z][^: \n\t]+:")
+ (unless buffer-file-name
+ (message-set-auto-save-file-name))
(mm-enable-multibyte)
(make-local-variable 'indent-tabs-mode) ;Turn off tabs for indentation.
(setq indent-tabs-mode nil)
(mml-mode)
(run-hooks 'text-mode-hook 'message-mode-hook))
+(defun message-setup-fill-variables ()
+ "Setup message fill variables."
+ (make-local-variable 'paragraph-separate)
+ (make-local-variable 'paragraph-start)
+ (make-local-variable 'adaptive-fill-regexp)
+ (unless (boundp 'adaptive-fill-first-line-regexp)
+ (setq adaptive-fill-first-line-regexp nil))
+ (make-local-variable 'adaptive-fill-first-line-regexp)
+ (make-local-variable 'auto-fill-inhibit-regexp)
+ (let ((quote-prefix-regexp
+ (concat
+ "[ \t]*" ; possible initial space
+ "\\(\\(" (regexp-quote message-yank-prefix) "\\|" ; user's prefix
+ "\\w+>\\|" ; supercite-style prefix
+ "[|:>]" ; standard prefix
+ "\\)[ \t]*\\)+"))) ; possible space after each prefix
+ (setq paragraph-start
+ (concat
+ (regexp-quote mail-header-separator) "$\\|"
+ "[ \t]*$\\|" ; blank lines
+ "-- $\\|" ; signature delimiter
+ "---+$\\|" ; delimiters for forwarded messages
+ page-delimiter "$\\|" ; spoiler warnings
+ ".*wrote:$\\|" ; attribution lines
+ quote-prefix-regexp "$")) ; empty lines in quoted text
+ (setq paragraph-separate paragraph-start)
+ (setq adaptive-fill-regexp
+ (concat quote-prefix-regexp "\\|" adaptive-fill-regexp))
+ (setq adaptive-fill-first-line-regexp
+ (concat quote-prefix-regexp "\\|"
+ adaptive-fill-first-line-regexp))
+ (setq auto-fill-inhibit-regexp "^[A-Z][^: \n\t]+:")))
+
\f
;;;
;;; Various commands
(defun message-delete-not-region (beg end)
- "Delete everything in the body of the current message that is outside of the region."
+ "Delete everything in the body of the current message outside of the region."
(interactive "r")
(save-excursion
(goto-char end)
(defun message-newline-and-reformat ()
"Insert four newlines, and then reformat if inside quoted text."
(interactive)
+ ;; The Latin-1 angle quote looks pretty dubious. -- fx
(let ((prefix "[]>»|:}+ \t]*")
- (supercite-thing "[-._a-zA-Z0-9]*[>]+[ \t]*")
+ (supercite-thing "[-._[:alnum:]]*[>]+[ \t]*")
quoted point)
(unless (bolp)
(save-excursion
(forward-line 1)))
(defun message-insert-signature (&optional force)
- "Insert a signature. See documentation for the `message-signature' variable."
+ "Insert a signature. See documentation for variable `message-signature'."
(interactive (list 0))
(let* ((signature
(cond
(or (bolp) (insert "\n")))))
(defun message-elide-region (b e)
- "Elide the text between point and mark.
+ "Elide the text in the region.
An ellipsis (from `message-elide-ellipsis') will be inserted where the
text was killed."
(interactive "r")
(defvar message-caesar-translation-table nil)
(defun message-caesar-region (b e &optional n)
- "Caesar rotation of region by N, default 13, for decrypting netnews."
+ "Caesar rotate region B to E by N, default 13, for decrypting netnews."
(interactive
(list
(min (point) (or (mark t) (point)))
(substring table (+ ?a 26) 255))))
(defun message-caesar-buffer-body (&optional rotnum)
- "Caesar rotates all letters in the current buffer by 13 places.
-Used to encode/decode possiblyun offensive messages (commonly in net.jokes).
+ "Caesar rotate all letters in the current buffer by 13 places.
+Used to encode/decode possibly offensive messages (commonly in rec.humor).
With prefix arg, specifies the number of places to rotate each letter forward.
Mail and USENET news headers are not rotated."
(interactive (if current-prefix-arg
message-cite-function)
(delete-windows-on message-reply-buffer t)
(insert-buffer message-reply-buffer)
- (funcall message-cite-function)
+ (unless arg
+ (funcall message-cite-function))
(message-exchange-point-and-mark)
(unless (bolp)
(insert ?\n))
(while (looking-at "^[ \t]*$")
(forward-line -1))
(forward-line 1)
- (delete-region (point) end))
+ (delete-region (point) end)
+ (unless (search-backward "\n\n" start t)
+ ;; Insert a blank line if it is peeled off.
+ (insert "\n")))
(goto-char start)
(while functions
(funcall (pop functions)))
(insert "\n"))
(funcall message-citation-line-function))))
-(defvar mail-citation-hook) ;Compiler directive
+(eval-when-compile (defvar mail-citation-hook)) ;Compiler directive
(defun message-cite-original ()
"Cite function in the standard Message manner."
(if (and (boundp 'mail-citation-hook)
(funcall message-citation-line-function)))))
(defun message-insert-citation-line ()
- "Function that inserts a simple citation line."
+ "Insert a simple citation line."
(when message-reply-headers
(insert (mail-header-from message-reply-headers) " writes:\n\n")))
(message-do-actions actions))))
(defun message-bury (buffer)
- "Bury this mail buffer."
+ "Bury this mail BUFFER."
(let ((newbuf (other-buffer buffer)))
(bury-buffer buffer)
(if (and (fboundp 'frame-parameters)
(put-text-property (point-min) (point-max) 'read-only nil))
(message-fix-before-sending)
(run-hooks 'message-send-hook)
- (message "Sending...")
+ (message message-sending-message)
(let ((alist message-send-method-alist)
(success t)
elem sent)
(while (and success
(setq elem (pop alist)))
- (when (or (not (funcall (cadr elem)))
- (and (or (not (memq (car elem)
- message-sent-message-via))
- (y-or-n-p
- (format
- "Already sent message via %s; resend? "
- (car elem))))
- (setq success (funcall (caddr elem) arg))))
- (setq sent t)))
+ (when (funcall (cadr elem))
+ (when (and (or (not (memq (car elem)
+ message-sent-message-via))
+ (y-or-n-p
+ (format
+ "Already sent message via %s; resend? "
+ (car elem))))
+ (setq success (funcall (caddr elem) arg)))
+ (setq sent t))))
(unless (or sent (not success))
(error "No methods specified to send by"))
(when (and success sent)
(defun message-send-mail-partially ()
"Sendmail as message/partial."
+ ;; replace the header delimiter with a blank line
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "\n"))
+ (replace-match "\n")
+ (run-hooks 'message-send-mail-hook)
(let ((p (goto-char (point-min)))
(tembuf (message-generate-new-buffer-clone-locals " message temp"))
(curbuf (current-buffer))
(set-buffer tembuf)
(erase-buffer)
;; Avoid copying text props.
- (insert (format
- "%s" (save-excursion
- (set-buffer mailbuf)
- (buffer-string))))
+ (insert (with-current-buffer mailbuf
+ (buffer-substring-no-properties (point-min) (point-max))))
;; Remove some headers.
(message-encode-message-body)
(save-restriction
;; require one newline at the end.
(or (= (preceding-char) ?\n)
(insert ?\n))
- (when
+ (when
(save-restriction
(message-narrow-to-headers)
(and news
(or (message-fetch-field "cc")
(message-fetch-field "to"))
- (string= "text/plain"
- (car
- (mail-header-parse-content-type
- (message-fetch-field "content-type"))))))
+ (let ((content-type (message-fetch-field "content-type")))
+ (or
+ (not content-type)
+ (string= "text/plain"
+ (car
+ (mail-header-parse-content-type
+ content-type)))))))
(message-insert-courtesy-copy))
(if (or (not message-send-mail-partially-limit)
(< (point-max) message-send-mail-partially-limit)
- (not (y-or-n-p "The message size is too large, should it be sent partially?")))
+ (not (y-or-n-p "The message size is too large, should it be sent partially? ")))
(mm-with-unibyte-current-buffer
(funcall message-send-mail-function))
(message-send-mail-partially)))
message-syntax-checks)
message-syntax-checks))
(message-this-is-news t)
- (message-posting-charset (gnus-setup-posting-charset
+ (message-posting-charset (gnus-setup-posting-charset
(save-restriction
(message-narrow-to-headers-or-head)
(message-fetch-field "Newsgroups"))))
(buffer-disable-undo)
(erase-buffer)
;; Avoid copying text props.
- (insert (format
- "%s" (save-excursion
- (set-buffer messbuf)
- (buffer-string))))
+ (insert (with-current-buffer messbuf
+ (buffer-substring-no-properties
+ (point-min) (point-max))))
(message-encode-message-body)
;; Remove some headers.
(save-restriction
;;;
(defun message-check-element (type)
- "Returns non-nil if this type is not to be checked."
+ "Return non-nil if this TYPE is not to be checked."
(if (eq message-syntax-checks 'dont-check-for-anything-just-trust-me)
t
(let ((able (assq type message-syntax-checks)))
t
(y-or-n-p
(format
- "Really post to %s unknown group%s: %s "
+ "Really post to %s unknown group%s: %s? "
(if (= (length errors) 1) "this" "these")
(if (= (length errors) 1) "" "s")
(mapconcat 'identity errors ", ")))))))
(kill-buffer (current-buffer)))))
(defun message-output (filename)
- "Append this article to Unix/babyl mail file.."
+ "Append this article to Unix/babyl mail file FILENAME."
(if (and (file-readable-p filename)
(mail-file-babyl-p filename))
(gnus-output-to-rmail filename t)
(mail-header-references message-reply-headers)
(mail-header-subject message-reply-headers)
psubject
- (mail-header-subject message-reply-headers)
(not (string=
(message-strip-subject-re
(mail-header-subject message-reply-headers))
(defun message-make-in-reply-to ()
"Return the In-Reply-To header for this message."
(when message-reply-headers
- (let ((from (mail-header-from message-reply-headers))
- (date (mail-header-date message-reply-headers)))
- (when from
- (let ((stop-pos
- (string-match " *at \\| *@ \\| *(\\| *<" from)))
- (concat (if (and stop-pos
- (not (zerop stop-pos)))
- (substring from 0 stop-pos) from)
- "'s message of \""
- (if (or (not date) (string= date ""))
- "(unknown date)" date)
- "\""))))))
+ (mail-header-message-id message-reply-headers)))
(defun message-make-distribution ()
"Make a Distribution header."
(goto-char (point-max)))))
(defun message-shorten-1 (list cut surplus)
- ;; Cut SURPLUS elements out of LIST, beginning with CUTth one.
+ "Cut SURPLUS elements out of LIST, beginning with CUTth one."
(setcdr (nthcdr (- cut 2) list)
(nthcdr (+ (- cut 2) surplus 1) list)))
(setq message-buffer-list
(nconc message-buffer-list (list (current-buffer))))))
-(defvar mc-modes-alist)
-(defun message-setup (headers &optional replybuffer actions)
+(defun message-mail-user-agent ()
+ (let ((mua (cond
+ ((not message-mail-user-agent) nil)
+ ((eq message-mail-user-agent t) mail-user-agent)
+ (t message-mail-user-agent))))
+ (if (memq mua '(message-user-agent gnus-user-agent))
+ nil
+ mua)))
+
+(defun message-setup (headers &optional replybuffer actions switch-function)
+ (let ((mua (message-mail-user-agent))
+ subject to field yank-action)
+ (if (not (and message-this-is-mail mua))
+ (message-setup-1 headers replybuffer actions)
+ (if replybuffer
+ (setq yank-action (list 'insert-buffer replybuffer)))
+ (setq headers (copy-sequence headers))
+ (setq field (assq 'Subject headers))
+ (when field
+ (setq subject (cdr field))
+ (setq headers (delq field headers)))
+ (setq field (assq 'To headers))
+ (when field
+ (setq to (cdr field))
+ (setq headers (delq field headers)))
+ (let ((mail-user-agent mua))
+ (compose-mail to subject
+ (mapcar (lambda (item)
+ (cons
+ (format "%s" (car item))
+ (cdr item)))
+ headers)
+ nil switch-function yank-action actions)))))
+
+(eval-when-compile (defvar mc-modes-alist))
+(defun message-setup-1 (headers &optional replybuffer actions)
(when (and (boundp 'mc-modes-alist)
(not (assq 'message-mode mc-modes-alist)))
(push '(message-mode (encrypt . mc-encrypt-message)
(sign . mc-sign-message))
mc-modes-alist))
- (when actions
- (setq message-send-actions actions))
+ (dolist (action actions)
+ (condition-case nil
+ (add-to-list 'message-send-actions
+ `(apply ',(car action) ',(cdr action)))))
(setq message-reply-buffer replybuffer)
(goto-char (point-min))
;; Insert all the headers.
(message-insert-signature)
(save-restriction
(message-narrow-to-headers)
+ (if message-alternative-emails
+ (message-use-alternative-email-as-from))
(run-hooks 'message-header-setup-hook))
(set-buffer-modified-p nil)
(setq buffer-undo-list nil)
(defun message-set-auto-save-file-name ()
"Associate the message buffer with a file in the drafts directory."
(when message-auto-save-directory
+ (unless (file-directory-p
+ (directory-file-name message-auto-save-directory))
+ (make-directory message-auto-save-directory t))
(if (gnus-alive-p)
(setq message-draft-article
(nndraft-request-associate-buffer "drafts"))
"Start editing a mail message to be sent.
OTHER-HEADERS is an alist of header/value pairs."
(interactive)
- (let ((message-this-is-mail t))
- (message-pop-to-buffer (message-buffer-name "mail" to))
+ (let ((message-this-is-mail t) replybuffer)
+ (unless (message-mail-user-agent)
+ (message-pop-to-buffer (message-buffer-name "mail" to)))
+ ;; 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)))))
+ (when other-headers other-headers))
+ replybuffer send-actions)
+ ;; FIXME: Should return nil if failure.
+ t))
;;;###autoload
(defun message-news (&optional newsgroups subject)
(message-this-is-mail t)
gnus-warning)
(save-restriction
- (message-narrow-to-head)
+ (message-narrow-to-head-1)
;; Allow customizations to have their say.
(if (not wide)
;; This is a regular reply.
(unless follow-to
(setq follow-to (message-get-reply-headers wide to-address))))
- (message-pop-to-buffer
- (message-buffer-name
- (if wide "wide reply" "reply") from
- (if wide to-address nil)))
+ (unless (message-mail-user-agent)
+ (message-pop-to-buffer
+ (message-buffer-name
+ (if wide "wide reply" "reply") from
+ (if wide to-address nil))))
(setq message-reply-headers
(vector 0 subject from date message-id references 0 0 ""))
(save-excursion
;; Get header info from original article.
(save-restriction
- (message-narrow-to-head)
+ (message-narrow-to-head-1)
(setq from (message-fetch-field "from")
sender (message-fetch-field "sender")
newsgroups (message-fetch-field "newsgroups")
(message-pop-to-buffer (message-buffer-name "supersede"))
(insert-buffer-substring cur)
(mime-to-mml)
- (message-narrow-to-head)
+ (message-narrow-to-head-1)
;; Remove unwanted headers.
(when message-ignored-supersedes-headers
(message-remove-header message-ignored-supersedes-headers t))
;;; Washing Subject:
(defun message-wash-subject (subject)
- "Remove junk like \"Re:\", \"(fwd)\", etc. that was added to the subject by previous forwarders, replyers, etc."
+ "Remove junk like \"Re:\", \"(fwd)\", etc. added to subject string SUBJECT.
+Previous forwarders, replyers, etc. may add it."
(with-temp-buffer
- (insert-string subject)
+ (insert subject)
(goto-char (point-min))
;; strip Re/Fwd stuff off the beginning
(while (re-search-forward
;;; Forwarding messages.
+(defvar message-forward-decoded-p nil
+ "Non-nil means the original message is decoded.")
+
(defun message-forward-subject-author-subject (subject)
- "Generate a subject for a forwarded message.
+ "Generate a SUBJECT for a forwarded message.
The form is: [Source] Subject, where if the original message was mail,
Source is the sender, and if the original message was news, Source is
the list of newsgroups is was posted to."
(concat "["
- (or (message-fetch-field
- (if (message-news-p) "newsgroups" "from"))
- "(nowhere)")
+ (let ((prefix
+ (or (message-fetch-field "newsgroups")
+ (message-fetch-field "from")
+ "(nowhere)")))
+ (if message-forward-decoded-p
+ prefix
+ (mail-decode-encoded-word-string prefix)))
"] " subject))
(defun message-forward-subject-fwd (subject)
- "Generate a subject for a forwarded message.
+ "Generate a SUBJECT for a forwarded message.
The form is: Fwd: Subject, where Subject is the original subject of
the message."
(concat "Fwd: " subject))
"Return a Subject header suitable for the message in the current buffer."
(save-excursion
(save-restriction
- (current-buffer)
- (message-narrow-to-head)
+ (message-narrow-to-head-1)
(let ((funcs message-make-forward-subject-function)
- (subject (if message-wash-forwarded-subjects
- (message-wash-subject
- (or (message-fetch-field "Subject") ""))
- (or (message-fetch-field "Subject") ""))))
+ (subject (message-fetch-field "Subject")))
+ (setq subject
+ (if subject
+ (if message-forward-decoded-p
+ subject
+ (mail-decode-encoded-word-string subject))
+ ""))
+ (if message-wash-forwarded-subjects
+ (setq subject (message-wash-subject subject)))
;; Make sure funcs is a list.
(and funcs
(not (listp funcs))
(setq funcs (cdr funcs)))
subject))))
+(eval-when-compile
+ (defvar gnus-article-decoded-p))
+
+
;;;###autoload
(defun message-forward (&optional news digest)
"Forward the current message via mail.
Optional DIGEST will use digest to forward."
(interactive "P")
(let* ((cur (current-buffer))
- (subject (if message-forward-show-mml
- (message-make-forward-subject)
- (mail-decode-encoded-word-string
- (message-make-forward-subject))))
- art-beg)
+ (message-forward-decoded-p
+ (if (local-variable-p 'gnus-article-decoded-p (current-buffer))
+ gnus-article-decoded-p ;; In an article buffer.
+ message-forward-decoded-p))
+ (subject (message-make-forward-subject)))
(if news
(message-news nil subject)
(message-mail nil subject))
- ;; Put point where we want it before inserting the forwarded
- ;; message.
- (if message-forward-before-signature
- (message-goto-body)
- (goto-char (point-max)))
+ (message-forward-make-body cur digest)))
+
+;;;###autoload
+(defun message-forward-make-body (forward-buffer &optional digest)
+ ;; Put point where we want it before inserting the forwarded
+ ;; message.
+ (if message-forward-before-signature
+ (message-goto-body)
+ (goto-char (point-max)))
+ (if message-forward-as-mime
+ (if digest
+ (insert "\n<#multipart type=digest>\n")
+ (if message-forward-show-mml
+ (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n")
+ (insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n")))
+ (insert "\n-------------------- Start of forwarded message --------------------\n"))
+ (let ((b (point)) e)
+ (if digest
+ (if message-forward-as-mime
+ (insert-buffer-substring forward-buffer)
+ (mml-insert-buffer forward-buffer))
+ (if (and message-forward-show-mml
+ (not message-forward-decoded-p))
+ (insert
+ (with-temp-buffer
+ (mm-disable-multibyte) ;; Must copy buffer in unibyte mode
+ (insert
+ (with-current-buffer forward-buffer
+ (mm-string-as-unibyte (buffer-string))))
+ (mm-enable-multibyte)
+ (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)
+ (goto-char (point-min))
+ (when (looking-at "From ")
+ (replace-match "X-From-Line: "))
+ (goto-char (point-max)))))
+ (setq e (point))
(if message-forward-as-mime
(if digest
- (insert "\n<#multipart type=digest>\n")
+ (insert "<#/multipart>\n")
(if message-forward-show-mml
- (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n")
- (insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n")))
- (insert "\n-------------------- Start of forwarded message --------------------\n"))
- (let ((b (point)) e)
- (if digest
- (if message-forward-as-mime
- (insert-buffer-substring cur)
- (mml-insert-buffer cur))
- (if message-forward-show-mml
- (insert-buffer-substring cur)
- (mm-with-unibyte-current-buffer
- (mml-insert-buffer cur))))
- (setq e (point))
- (if message-forward-as-mime
- (if digest
- (insert "<#/multipart>\n")
- (if message-forward-show-mml
- (insert "<#/mml>\n")
- (insert "<#/part>\n")))
- (insert "\n-------------------- End of forwarded message --------------------\n"))
- (if (and digest message-forward-as-mime)
- (save-restriction
- (narrow-to-region b e)
- (goto-char b)
- (narrow-to-region (point)
- (or (search-forward "\n\n" nil t) (point)))
- (delete-region (point-min) (point-max)))
- (when (and (not current-prefix-arg)
- message-forward-ignored-headers)
- (save-restriction
- (narrow-to-region b e)
- (goto-char b)
- (narrow-to-region (point)
- (or (search-forward "\n\n" nil t) (point)))
- (message-remove-header message-forward-ignored-headers t)))))
- (message-position-point)))
+ (insert "<#/mml>\n")
+ (insert "<#/part>\n")))
+ (insert "\n-------------------- End of forwarded message --------------------\n"))
+ (if (and digest message-forward-as-mime)
+ (save-restriction
+ (narrow-to-region b e)
+ (goto-char b)
+ (narrow-to-region (point)
+ (or (search-forward "\n\n" nil t) (point)))
+ (delete-region (point-min) (point-max)))
+ (when (and (not current-prefix-arg)
+ message-forward-ignored-headers)
+ (save-restriction
+ (narrow-to-region b e)
+ (goto-char b)
+ (narrow-to-region (point)
+ (or (search-forward "\n\n" nil t) (point)))
+ (message-remove-header message-forward-ignored-headers t)))))
+ (message-position-point))
+
+;;;###autoload
+(defun message-forward-rmail-make-body (forward-buffer)
+ (save-window-excursion
+ (set-buffer forward-buffer)
+ (if (rmail-msg-is-pruned)
+ (rmail-msg-restore-non-pruned-header)))
+ (message-forward-make-body forward-buffer))
+
+;;;###autoload
+(defun message-insinuate-rmail ()
+ "Let RMAIL uses message to forward."
+ (interactive)
+ (setq rmail-enable-mime-composing t)
+ (setq rmail-insert-mime-forwarded-message-function
+ 'message-forward-rmail-make-body))
;;;###autoload
(defun message-resend (address)
(let ((cur (current-buffer))
beg)
;; We first set up a normal mail buffer.
- (set-buffer (get-buffer-create " *message resend*"))
- (erase-buffer)
- (message-setup `((To . ,address)))
+ (unless (message-mail-user-agent)
+ (set-buffer (get-buffer-create " *message resend*"))
+ (erase-buffer))
+ (let ((message-this-is-mail t))
+ (message-setup `((To . ,address))))
;; Insert our usual headers.
(message-generate-headers '(From Date To))
(message-narrow-to-headers)
(mm-enable-multibyte)
(mime-to-mml)
(save-restriction
- (message-narrow-to-head)
+ (message-narrow-to-head-1)
(message-remove-header message-ignored-bounced-headers t)
(goto-char (point-max))
(insert mail-header-separator))
(defun message-mail-other-window (&optional to subject)
"Like `message-mail' command, but display mail buffer in another window."
(interactive)
- (let ((pop-up-windows t)
- (special-display-buffer-names nil)
- (special-display-regexps nil)
- (same-window-buffer-names nil)
- (same-window-regexps nil))
- (message-pop-to-buffer (message-buffer-name "mail" to)))
+ (unless (message-mail-user-agent)
+ (let ((pop-up-windows t)
+ (special-display-buffer-names nil)
+ (special-display-regexps nil)
+ (same-window-buffer-names nil)
+ (same-window-regexps nil))
+ (message-pop-to-buffer (message-buffer-name "mail" to))))
(let ((message-this-is-mail t))
- (message-setup `((To . ,(or to "")) (Subject . ,(or subject ""))))))
+ (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))
+ nil nil 'switch-to-buffer-other-window)))
;;;###autoload
(defun message-mail-other-frame (&optional to subject)
"Like `message-mail' command, but display mail buffer in another frame."
(interactive)
- (let ((pop-up-frames t)
- (special-display-buffer-names nil)
- (special-display-regexps nil)
- (same-window-buffer-names nil)
- (same-window-regexps nil))
- (message-pop-to-buffer (message-buffer-name "mail" to)))
+ (unless (message-mail-user-agent)
+ (let ((pop-up-frames t)
+ (special-display-buffer-names nil)
+ (special-display-regexps nil)
+ (same-window-buffer-names nil)
+ (same-window-regexps nil))
+ (message-pop-to-buffer (message-buffer-name "mail" to))))
(let ((message-this-is-mail t))
- (message-setup `((To . ,(or to "")) (Subject . ,(or subject ""))))))
+ (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))
+ nil nil 'switch-to-buffer-other-frame)))
;;;###autoload
(defun message-news-other-window (&optional newsgroups subject)
(defalias 'message-exchange-point-and-mark 'exchange-point-and-mark)
;; Support for toolbar
-(when (string-match "XEmacs\\|Lucid" emacs-version)
- (require 'messagexmas))
+(eval-when-compile (defvar tool-bar-map))
+(if (featurep 'xemacs)
+ (require 'messagexmas)
+ (when (and
+ (condition-case nil (require 'tool-bar) (error nil))
+ (fboundp 'tool-bar-add-item-from-menu)
+ tool-bar-mode)
+ (defvar message-tool-bar-map
+ (let ((tool-bar-map (copy-keymap tool-bar-map)))
+ ;; 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))
+
+ (tool-bar-add-item-from-menu
+ 'message-send-and-exit "mail_send" message-mode-map)
+ (tool-bar-add-item-from-menu
+ 'message-kill-buffer "close" message-mode-map)
+ (tool-bar-add-item-from-menu
+ 'message-dont-send "cancel" message-mode-map)
+ (tool-bar-add-item-from-menu
+ 'mml-attach-file "attach" message-mode-map)
+ (tool-bar-add-item-from-menu
+ 'ispell-message "spell" message-mode-map)
+ tool-bar-map))))
;;; Group name completion.
(message-expand-group)
(tab-to-tab-stop)))
-(defvar gnus-active-hashtb)
(defun message-expand-group ()
"Expand the group name under point."
(let* ((b (save-excursion
(list list))))
(defun message-generate-new-buffer-clone-locals (name &optional varstr)
- "Create and return a buffer with a name based on NAME using generate-new-buffer.
+ "Create and return a buffer with name based on NAME using `generate-new-buffer.'
Then clone the local variables and values from the old buffer to the
new one, cloning only the locals having a substring matching the
regexp varstr."
(cdr local)))))
locals)))
-;;; Miscellaneous functions
-
-;; stolen (and renamed) from nnheader.el
-(if (fboundp 'subst-char-in-string)
- (defsubst message-replace-chars-in-string (string from to)
- (subst-char-in-string from to string))
- (defun message-replace-chars-in-string (string from to)
- "Replace characters in STRING from FROM to TO."
- (let ((string (substring string 0)) ;Copy string.
- (len (length string))
- (idx 0))
- ;; Replace all occurrences of FROM with TO.
- (while (< idx len)
- (when (= (aref string idx) from)
- (aset string idx to))
- (setq idx (1+ idx)))
- string)))
-
;;;
;;; MIME functions
;;;
(defvar message-inhibit-body-encoding nil)
(defun message-encode-message-body ()
- (unless message-inhibit-body-encoding
+ (unless message-inhibit-body-encoding
(let ((mail-parse-charset (or mail-parse-charset
message-default-charset))
(case-fold-search t)
;; /usr/bin/mail.
(unless content-type-p
(goto-char (point-min))
- (re-search-forward "^MIME-Version:")
- (forward-line 1)
- (insert "Content-Type: text/plain; charset=us-ascii\n")))))
+ ;; For unknown reason, MIME-Version doesn't exist.
+ (when (re-search-forward "^MIME-Version:" nil t)
+ (forward-line 1)
+ (insert "Content-Type: text/plain; charset=us-ascii\n"))))))
(defun message-read-from-minibuffer (prompt)
"Read from the minibuffer while providing abbrev expansion."
(let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook))
(read-string prompt))))
+(defun message-use-alternative-email-as-from ()
+ (require 'mail-utils)
+ (let* ((fields '("To" "Cc"))
+ (emails
+ (split-string
+ (mail-strip-quoted-names
+ (mapconcat 'message-fetch-reply-field fields ","))
+ "[ \f\t\n\r\v,]+"))
+ email)
+ (while emails
+ (if (string-match message-alternative-emails (car emails))
+ (setq email (car emails)
+ emails nil))
+ (pop emails))
+ (unless (or (not email) (equal email user-mail-address))
+ (goto-char (point-max))
+ (insert "From: " email "\n"))))
+
(provide 'message)
(run-hooks 'message-load-hook)