-;;; message.el --- composing mail and news messages -*- coding: iso-latin-1 -*-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001
+;;; message.el --- composing mail and news messages
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
(eval-when-compile
(require 'cl)
(defvar gnus-list-identifiers)) ; gnus-sum is required where necessary
+(require 'canlock)
(require 'mailheader)
(require 'nnheader)
-;; This is apparently necessary even though things are autoloaded:
+;; This is apparently necessary even though things are autoloaded.
+;; Because we dynamically bind mail-abbrev-mode-regexp, we'd better
+;; require mailabbrev here.
(if (featurep 'xemacs)
- (require 'mail-abbrevs))
+ (require 'mail-abbrevs)
+ (require 'mailabbrev))
(require 'mail-parse)
(require 'mml)
(require 'rfc822)
+(eval-and-compile
+ (autoload 'sha1 "sha1-el"))
(defgroup message '((user-mail-address custom-variable)
(user-full-name custom-variable))
(function :tag "Other"))
:group 'message-sending)
+(defcustom message-fcc-externalize-attachments nil
+ "If non-nil, attachments are included as external parts in Fcc copies."
+ :type 'boolean
+ :group 'message-sending)
+
(defcustom message-courtesy-message
"The following message is a courtesy copy of an article\nthat has been posted to %s as well.\n\n"
"*This is inserted at the start of a mailed copy of a posted message.
(const default))
:group 'message-headers)
-(defcustom message-syntax-checks nil
+(defcustom message-insert-canlock t
+ "Whether to insert a Cancel-Lock header in news postings."
+ :version "21.3"
+ :group 'message-headers
+ :type 'boolean)
+
+(defcustom message-syntax-checks
+ (if message-insert-canlock '((sender . disabled)) nil)
;; Guess this one shouldn't be easy to customize...
"*Controls what syntax checks should not be performed on outgoing posts.
To disable checking of long signatures, for instance, add
:type 'sexp)
(defcustom message-ignored-news-headers
- "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:"
+ "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:"
"*Regexp of headers to be removed unconditionally before posting."
:group 'message-news
:group 'message-headers
:type 'regexp)
(defcustom message-ignored-mail-headers
- "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:"
+ "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:"
"*Regexp of headers to be removed unconditionally before mailing."
:group 'message-mail
:group 'message-headers
:type 'regexp)
-(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:"
+(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:"
"*Header lines matching this regexp will be deleted before posting.
It's best to delete old Path and Date headers before posting to avoid
any confusion."
:group 'message-interface
:type 'regexp)
-(defcustom message-subject-re-regexp "^[ \t]*\\([Rr][Ee]:[ \t]*\\)*[ \t]*"
+(defcustom message-subject-re-regexp
+ "^[ \t]*\\([Rr][Ee]\\(\\[[0-9]*\\]\\)*:[ \t]*\\)*[ \t]*"
"*Regexp matching \"Re: \" in the subject line."
:group 'message-various
:type 'regexp)
(if (string-match "[[:digit:]]" "1") ;; support POSIX?
"\\([ \t]*[-_.[:word:]]+>+\\|[ \t]*[]>»|:}+]\\)+"
;; ?-, ?_ or ?. MUST NOT be in syntax entry w.
- "\\([ \t]*\\(\\w\\|[-_.]\\)+>+\\|[ \t]*[]>»|:}+]\\)+")
+ (let ((old-table (syntax-table))
+ non-word-constituents)
+ (set-syntax-table text-mode-syntax-table)
+ (setq non-word-constituents
+ (concat
+ (if (string-match "\\w" "-") "" "-")
+ (if (string-match "\\w" "_") "" "_")
+ (if (string-match "\\w" ".") "" ".")))
+ (set-syntax-table old-table)
+ (if (equal non-word-constituents "")
+ "\\([ \t]*\\(\\w\\)+>+\\|[ \t]*[]>»|:}+]\\)+"
+ (concat "\\([ \t]*\\(\\w\\|["
+ non-word-constituents
+ "]\\)+>+\\|[ \t]*[]>»|:}+]\\)+"))))
"*Regexp matching the longest possible citation prefix on a line."
:group 'message-insertion
:type 'regexp)
(const use)
(const ask)))
+(defcustom message-subscribed-address-functions nil
+ "*Specifies functions for determining list subscription.
+If nil, do not attempt to determine list subscribtion with functions.
+If non-nil, this variable contains a list of functions which return
+regular expressions to match lists. These functions can be used in
+conjunction with `message-subscribed-regexps' and
+`message-subscribed-addresses'."
+ :group 'message-interface
+ :type '(repeat sexp))
+
+(defcustom message-subscribed-address-file nil
+ "*A file containing addresses the user is subscribed to.
+If nil, do not look at any files to determine list subscriptions. If
+non-nil, each line of this file should be a mailing list address."
+ :group 'message-interface
+ :type 'string)
+
+(defcustom message-subscribed-addresses nil
+ "*Specifies a list of addresses the user is subscribed to.
+If nil, do not use any predefined list subscriptions. This list of
+addresses can be used in conjuction with
+`message-subscribed-address-functions' and `message-subscribed-regexps'."
+ :group 'message-interface
+ :type '(repeat string))
+
+(defcustom message-subscribed-regexps nil
+ "*Specifies a list of addresses the user is subscribed to.
+If nil, do not use any predefined list subscriptions. This list of
+regular expressions can be used in conjuction with
+`message-subscribed-address-functions' and `message-subscribed-addresses'."
+ :group 'message-interface
+ :type '(repeat regexp))
+
+(defcustom message-allow-no-recipients 'ask
+ "Specifies what to do when there are no recipients other than Gcc/Fcc.
+If it is the symbol `always', the posting is allowed. If it is the
+symbol `never', the posting is not allowed. If it is the symbol
+`ask', you are prompted."
+ :group 'message-interface
+ :type '(choice (const always)
+ (const never)
+ (const ask)))
+
(defcustom message-sendmail-f-is-evil nil
"*Non-nil means don't add \"-f username\" to the sendmail command line.
Doing so would be even more evil than leaving it out."
(defcustom message-qmail-inject-args nil
"Arguments passed to qmail-inject programs.
-This should be a list of strings, one string for each argument.
+This should be a list of strings, one string for each argument. It
+may also be a function.
For e.g., if you wish to set the envelope sender address so that bounces
go to the right place or to deal with listserv's usage of that address, you
might set this variable to '(\"-f\" \"you@some.where\")."
:group 'message-sending
- :type '(repeat string))
+ :type '(choice (function)
+ (repeat string)))
(defvar message-cater-to-broken-inn t
"Non-nil means Gnus should not fold the `References' header.
:type 'function
:group 'message-insertion)
-(defvar message-abbrevs-loaded nil)
-
;;;###autoload
(defcustom message-signature t
"*String to be inserted at the end of the message buffer.
(sexp :tag "none" :format "%t" t)))
(defvar message-reply-buffer nil)
-(defvar message-reply-headers nil)
+(defvar message-reply-headers nil
+ "The headers of the current replied article.
+It is a vector of the following headers:
+\[number subject from date id references chars lines xref extra].")
(defvar message-newsreader nil)
(defvar message-mailer nil)
(defvar message-sent-message-via nil)
:group 'message-buffers
: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
(and (not (mm-multibyte-p)) 'iso-8859-1)
"Default charset used in non-MULE Emacsen.
candidates:
`empty-article' Allow you to post an empty article;
`quoted-text-only' Allow you to post quoted text only;
-`multiple-copies' Allow you to post multiple copies.")
-;; `cancel-messages' Allow you to cancel or supersede others' messages.
+`multiple-copies' Allow you to post multiple copies;
+`cancel-messages' Allow you to cancel or supersede messages from
+ your other email addresses.")
(defsubst message-gnksa-enable-p (feature)
(or (not (listp message-shoot-gnksa-feet))
nil)
(,(concat "^\\(" message-cite-prefix-regexp "\\).*")
(0 'message-cited-text-face))
- ("<#/?\\(multipart\\|part\\|external\\|mml\\).*>"
+ ("<#/?\\(multipart\\|part\\|external\\|mml\\|secure\\)[^>]*>"
(0 'message-mml-face))))
"Additional expressions to highlight in Message mode.")
:type '(choice (const :tag "Always use primary" nil)
regexp))
+(defcustom message-hierarchical-addresses nil
+ "A list of hierarchical mail address definitions.
+
+Inside each entry, the first address is the \"top\" address, and
+subsequent addresses are subaddresses; this is used to indicate that
+mail sent to the first address will automatically be delivered to the
+subaddresses. So if the first address appears in the recipient list
+for a message, the subaddresses will be removed (if present) before
+the mail is sent. All addresses in this structure should be
+downcased."
+ :group 'message-headers
+ :type '(repeat (repeat string)))
+
(defcustom message-mail-user-agent nil
"Like `mail-user-agent'.
Except if it is nil, use Gnus native MUA; if it is t, use
recipients?\" before a wide reply to multiple recipients. If the user
answers yes, reply to all recipients as usual. If the user answers
no, only reply back to the author."
+ :version "21.3"
:group 'message-headers
:type 'boolean)
;; can be removed, e.g.
;; From: joe@y.z (Joe K
;; User)
- ;; can yield `From joe@y.z (Joe K Fri Mar 22 08:11:15 1996', and
+ ;; can yield `From joe@y.z (Joe K Fri Mar 22 08:11:15 1996', and
;; From: Joe User
;; <joe@y.z>
;; can yield `From Joe User Fri Mar 22 08:11:15 1996'.
(autoload 'gnus-point-at-bol "gnus-util")
(autoload 'gnus-output-to-rmail "gnus-util")
(autoload 'gnus-output-to-mail "gnus-util")
- (autoload 'mail-abbrev-in-expansion-header-p "mailabbrev")
(autoload 'nndraft-request-associate-buffer "nndraft")
(autoload 'nndraft-request-expire-articles "nndraft")
(autoload 'gnus-open-server "gnus-int")
(define-key message-mode-map "\C-c?" 'describe-mode)
(define-key message-mode-map "\C-c\C-f\C-t" 'message-goto-to)
+ (define-key message-mode-map "\C-c\C-f\C-o" 'message-goto-from)
(define-key message-mode-map "\C-c\C-f\C-b" 'message-goto-bcc)
(define-key message-mode-map "\C-c\C-f\C-w" 'message-goto-fcc)
(define-key message-mode-map "\C-c\C-f\C-c" 'message-goto-cc)
(define-key message-mode-map "\C-c\C-f\C-n" 'message-goto-newsgroups)
(define-key message-mode-map "\C-c\C-f\C-d" 'message-goto-distribution)
(define-key message-mode-map "\C-c\C-f\C-f" 'message-goto-followup-to)
+ (define-key message-mode-map "\C-c\C-f\C-m" 'message-goto-mail-followup-to)
(define-key message-mode-map "\C-c\C-f\C-k" 'message-goto-keywords)
(define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary)
+ (define-key message-mode-map "\C-c\C-f\C-i" 'message-insert-or-toggle-importance)
+ (define-key message-mode-map "\C-c\C-f\C-a" 'message-gen-unsubscribed-mft)
(define-key message-mode-map "\C-c\C-b" 'message-goto-body)
(define-key message-mode-map "\C-c\C-i" 'message-goto-signature)
(define-key message-mode-map "\C-c\C-t" 'message-insert-to)
(define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups)
+ (define-key message-mode-map "\C-c\C-l" 'message-to-list-only)
+
+ (define-key message-mode-map "\C-c\C-u" 'message-insert-or-toggle-importance)
+ (define-key message-mode-map "\C-c\M-n" 'message-insert-disposition-notification-to)
(define-key message-mode-map "\C-c\C-y" 'message-yank-original)
(define-key message-mode-map "\C-c\M-\C-y" 'message-yank-buffer)
(define-key message-mode-map "\C-c\C-a" 'mml-attach-file)
+ (define-key message-mode-map "\C-a" 'message-beginning-of-line)
(define-key message-mode-map "\t" 'message-tab)
(define-key message-mode-map "\M-;" 'comment-region))
["Kill To Signature" message-kill-to-signature t]
["Newline and Reformat" message-newline-and-reformat t]
["Rename buffer" message-rename-buffer t]
+ ["Flag As Important" message-insert-importance-high
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Mark this message as important"))]
+ ["Flag As Unimportant" message-insert-importance-low
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Mark this message as unimportant"))]
+ ["Request Receipt"
+ message-insert-disposition-notification-to
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Request a Disposition Notification of this article"))]
["Spellcheck" ispell-message
,@(if (featurep 'xemacs) '(t)
'(:help "Spellcheck this message"))]
["Fetch Newsgroups" message-insert-newsgroups t]
"----"
["To" message-goto-to t]
+ ["From" message-goto-from t]
["Subject" message-goto-subject t]
["Cc" message-goto-cc t]
["Reply-To" message-goto-reply-to t]
["Keywords" message-goto-keywords t]
["Newsgroups" message-goto-newsgroups t]
["Followup-To" message-goto-followup-to t]
+ ["Mail-Followup-To" message-goto-mail-followup-to t]
["Distribution" message-goto-distribution t]
["Body" message-goto-body t]
["Signature" message-goto-signature t]))
(defvar facemenu-add-face-function)
(defvar facemenu-remove-face-function))
+;;; Forbidden properties
+;;
+;; We use `after-change-functions' to keep special text properties
+;; that interfer with the normal function of message mode out of the
+;; buffer.
+
+(defcustom message-strip-special-text-properties t
+ "Strip special properties from the message buffer.
+
+Emacs has a number of special text properties which can break message
+composing in various ways. If this option is set, message will strip
+these properties from the message composition buffer. However, some
+packages requires these properties to be present in order to work.
+If you use one of these packages, turn this option off, and hope the
+message composition doesn't break too bad."
+ :group 'message-various
+ :type 'boolean)
+
+(defconst message-forbidden-properties
+ ;; No reason this should be clutter up customize. We make it a
+ ;; property list (rather than a list of property symbols), to be
+ ;; directly useful for `remove-text-properties'.
+ '(field nil read-only nil intangible nil invisible nil
+ mouse-face nil modification-hooks nil insert-in-front-hooks nil
+ insert-behind-hooks nil point-entered nil point-left nil)
+ ;; Other special properties:
+ ;; category, face, display: probably doesn't do any harm.
+ ;; fontified: is used by font-lock.
+ ;; syntax-table, local-map: I dunno.
+ ;; We need to add XEmacs names to the list.
+ "Property list of with properties.forbidden in message buffers.
+The values of the properties are ignored, only the property names are used.")
+
+(defun message-tamago-not-in-use-p (pos)
+ "Return t when tamago version 4 is not in use at the cursor position.
+Tamago version 4 is a popular input method for writing Japanese text.
+It uses the properties `intangible', `invisible', `modification-hooks'
+and `read-only' when translating ascii or kana text to kanji text.
+These properties are essential to work, so we should never strip them."
+ (not (and (boundp 'egg-modefull-mode)
+ (symbol-value 'egg-modefull-mode)
+ (or (memq (get-text-property pos 'intangible)
+ '(its-part-1 its-part-2))
+ (get-text-property pos 'egg-end)
+ (get-text-property pos 'egg-lang)
+ (get-text-property pos 'egg-start)))))
+
+(defun message-strip-forbidden-properties (begin end &optional old-length)
+ "Strip forbidden properties between BEGIN and END, ignoring the third arg.
+This function is intended to be called from `after-change-functions'.
+See also `message-forbidden-properties'."
+ (when (and message-strip-special-text-properties
+ (message-tamago-not-in-use-p begin))
+ (remove-text-properties begin end message-forbidden-properties)))
+
;;;###autoload
(define-derived-mode message-mode text-mode "Message"
"Major mode for editing mail and news to be sent.
C-c C-f C-w move to Fcc C-c C-f C-r move to Reply-To
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-o move to From (\"Originator\")
C-c C-f C-f move to Followup-To
+ C-c C-f C-m move to Mail-Followup-To
+ C-c C-f C-i cycle through Importance values
C-c C-t `message-insert-to' (add a To header to a news followup)
+C-c C-l `message-to-list-only' (removes all but list address in to/cc)
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-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).
+C-c C-u `message-insert-or-toggle-importance' (insert or cycle importance).
+C-c M-n `message-insert-disposition-notification-to' (request receipt).
M-RET `message-newline-and-reformat' (break the line and reformat)."
+ (setq local-abbrev-table text-mode-abbrev-table)
(set (make-local-variable 'message-reply-buffer) nil)
(make-local-variable 'message-send-actions)
(make-local-variable 'message-exit-actions)
(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)
+ ;; make-local-hook is harmless though obsolete in Emacs 21.
+ ;; Emacs 20 and XEmacs need make-local-hook.
+ (make-local-hook 'after-change-functions)
+ ;; Mmmm... Forbidden properties...
+ (add-hook 'after-change-functions 'message-strip-forbidden-properties
+ nil 'local)
;; Allow mail alias things.
(when (eq message-mail-alias-type 'abbrev)
(if (fboundp 'mail-abbrevs-setup)
(mail-abbrevs-setup)
(mail-aliases-setup)))
- (message-set-auto-save-file-name)
- (mm-enable-multibyte)
+ (unless buffer-file-name
+ (message-set-auto-save-file-name))
+ (unless (buffer-base-buffer)
+ ;; Don't enable multibyte on an indirect buffer. Maybe enabling
+ ;; multibyte is not necessary at all. -- zsh
+ (mm-enable-multibyte))
(set (make-local-variable 'indent-tabs-mode) nil) ;No tabs for indentation.
(mml-mode))
(interactive)
(message-position-on-field "To"))
+(defun message-goto-from ()
+ "Move point to the From header."
+ (interactive)
+ (message-position-on-field "From"))
+
(defun message-goto-subject ()
"Move point to the Subject header."
(interactive)
(interactive)
(message-position-on-field "Followup-To" "Newsgroups"))
+(defun message-goto-mail-followup-to ()
+ "Move point to the Mail-Followup-To header."
+ (interactive)
+ (message-position-on-field "Mail-Followup-To" "From"))
+
(defun message-goto-keywords ()
"Move point to the Keywords header."
(interactive)
(goto-char (point-max))
nil))
+(defun message-gen-unsubscribed-mft (&optional include-cc)
+ "Insert a reasonable MFT header in a post to an unsubscribed list.
+When making original posts to a mailing list you are not subscribed to,
+you have to type in a MFT header by hand. The contents, usually, are
+the addresses of the list and your own address. This function inserts
+such a header automatically. It fetches the contents of the To: header
+in the current mail buffer, and appends the current user-mail-address.
+
+If the optional argument `include-cc' is non-nil, the addresses in the
+Cc: header are also put into the MFT."
+
+ (interactive "P")
+ (message-remove-header "Mail-Followup-To")
+ (let* ((cc (and include-cc (message-fetch-field "Cc")))
+ (tos (if cc
+ (concat (message-fetch-field "To") "," cc)
+ (message-fetch-field "To"))))
+ (message-goto-mail-followup-to)
+ (insert (concat tos ", " user-mail-address))))
+
\f
(defun message-insert-to (&optional force)
(if not-break
(setq point nil)
(if bolp
- (insert "\n")
- (insert "\n\n"))
+ (newline)
+ (newline)
+ (newline))
(setq point (point))
- (insert "\n\n")
+ ;; (newline 2) doesn't mark both newline's as hard, so call
+ ;; newline twice. -jas
+ (newline)
+ (newline)
(delete-region (point) (re-search-forward "[ \t]*"))
(when (and quoted (not bolp))
(insert quoted leading-space)))
(message-newline-and-reformat arg t)
t))
+;; Is it better to use `mail-header-end'?
+(defun message-point-in-header-p ()
+ "Return t if point is in the header."
+ (save-excursion
+ (let ((p (point)))
+ (goto-char (point-min))
+ (not (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "\n")
+ p t)))))
+
(defun message-do-auto-fill ()
"Like `do-auto-fill', but don't fill in message header."
- (when (> (point) (save-excursion
- (goto-char (point-min))
- (if (re-search-forward
- (concat "^" (regexp-quote mail-header-separator)
- "\n") nil t)
- (match-beginning 0)
- (point-max))))
+ (unless (message-point-in-header-p)
(do-auto-fill)))
(defun message-insert-signature (&optional force)
(goto-char (point-max))
(or (bolp) (insert "\n")))))
+(defun message-insert-importance-high ()
+ "Insert header to mark message as important."
+ (interactive)
+ (save-excursion
+ (message-remove-header "Importance")
+ (message-goto-eoh)
+ (insert "Importance: high\n")))
+
+(defun message-insert-importance-low ()
+ "Insert header to mark message as unimportant."
+ (interactive)
+ (save-excursion
+ (message-remove-header "Importance")
+ (message-goto-eoh)
+ (insert "Importance: low\n")))
+
+(defun message-insert-or-toggle-importance ()
+ "Insert a \"Importance: high\" header, or cycle through the header values.
+The three allowed values according to RFC 1327 are `high', `normal'
+and `low'."
+ (interactive)
+ (save-excursion
+ (let ((valid '("high" "normal" "low"))
+ (new "high")
+ cur)
+ (when (setq cur (message-fetch-field "Importance"))
+ (message-remove-header "Importance")
+ (setq new (cond ((string= cur "high")
+ "low")
+ ((string= cur "low")
+ "normal")
+ (t
+ "high"))))
+ (message-goto-eoh)
+ (insert (format "Importance: %s\n" new)))))
+
+(defun message-insert-disposition-notification-to ()
+ "Request a disposition notification (return receipt) to this message.
+Note that this should not be used in newsgroups."
+ (interactive)
+ (save-excursion
+ (message-remove-header "Disposition-Notification-To")
+ (message-goto-eoh)
+ (insert (format "Disposition-Notification-To: %s\n"
+ (or (message-fetch-field "From") (message-make-from))))))
+
(defun message-elide-region (b e)
"Elide the text in the region.
An ellipsis (from `message-elide-ellipsis') will be inserted where the
(while (< (point) (mark t))
(if (or (looking-at ">") (looking-at "^$"))
(insert message-yank-cited-prefix)
- (insert message-yank-prefix))
- (forward-line 1))))
+ (insert message-yank-prefix))
+ (forward-line 1))))
(goto-char start)))
(defun message-yank-original (&optional arg)
t)))
(defun message-dont-send ()
- "Don't send the message you have been editing."
+ "Don't send the message you have been editing.
+Instead, just auto-save the buffer and then bury it."
(interactive)
(set-buffer-modified-p t)
(save-buffer)
(interactive)
(when (or (not (buffer-modified-p))
(yes-or-no-p "Message modified; kill anyway? "))
- (let ((actions message-kill-actions))
+ (let ((actions message-kill-actions)
+ (draft-article message-draft-article)
+ (auto-save-file-name buffer-auto-save-file-name)
+ (file-name buffer-file-name)
+ (modified (buffer-modified-p)))
(setq buffer-file-name nil)
(kill-buffer (current-buffer))
+ (when (and (or (and auto-save-file-name
+ (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" ""))))
+ (ignore-errors
+ (delete-file auto-save-file-name))
+ (let ((message-draft-article draft-article))
+ (message-disassociate-draft)))
(message-do-actions actions))))
(defun message-bury (buffer)
(message message-sending-message)
(let ((alist message-send-method-alist)
(success t)
- elem sent
+ elem sent dont-barf-on-no-method
(message-options message-options))
(message-options-set-recipient)
(while (and success
(error "Denied posting -- multiple copies")))
(setq success (funcall (caddr elem) arg)))
(setq sent t))))
- (unless (or sent (not success))
+ (unless (or sent
+ (not success)
+ (let ((fcc (message-fetch-field "Fcc"))
+ (gcc (message-fetch-field "Gcc")))
+ (when (or fcc gcc)
+ (or (eq message-allow-no-recipients 'always)
+ (and (not (eq message-allow-no-recipients 'never))
+ (setq dont-barf-on-no-method
+ (gnus-y-or-n-p
+ (format "No receiver, perform %s anyway? "
+ (cond ((and fcc gcc) "Fcc and Gcc")
+ (fcc "Fcc")
+ (t "Gcc"))))))))))
(error "No methods specified to send by"))
- (when (and success sent)
+ (when (or dont-barf-on-no-method
+ (and success sent))
(message-do-fcc)
(save-excursion
(run-hooks 'message-sent-hook))
(put 'message-check 'lisp-indent-function 1)
(put 'message-check 'edebug-form-spec '(form body))
+(defun message-text-with-property (prop)
+ "Return a list of all points where the text has PROP."
+ (let ((points nil)
+ (point (point-min)))
+ (save-excursion
+ (while (< point (point-max))
+ (when (get-text-property point prop)
+ (push point points))
+ (incf point)))
+ (nreverse points)))
+
(defun message-fix-before-sending ()
"Do various things to make the message nice before sending it."
;; Make sure there's a newline at the end of the message.
(insert "\n"))
;; Delete all invisible text.
(message-check 'invisible-text
- (when (text-property-any (point-min) (point-max) 'invisible t)
- (put-text-property (point-min) (point-max) 'invisible nil)
- (unless (yes-or-no-p
- "Invisible text found and made visible; continue posting? ")
- (error "Invisible text found and made visible")))))
+ (let ((points (message-text-with-property 'invisible)))
+ (when points
+ (goto-char (car points))
+ (dolist (point points)
+ (add-text-properties point (1+ point)
+ '(invisible nil highlight t)))
+ (unless (yes-or-no-p
+ "Invisible text found and made visible; continue posting? ")
+ (error "Invisible text found and made visible")))))
+ (message-check 'illegible-text
+ (let (found choice)
+ (message-goto-body)
+ (skip-chars-forward mm-7bit-chars)
+ (while (not (eobp))
+ (when (let ((char (char-after)))
+ (or (< (mm-char-int char) 128)
+ (and (mm-multibyte-p)
+ (memq (char-charset char)
+ '(eight-bit-control eight-bit-graphic
+ control-1)))))
+ (add-text-properties (point) (1+ (point)) '(highlight t))
+ (setq found t))
+ (forward-char)
+ (skip-chars-forward mm-7bit-chars))
+ (when found
+ (setq choice
+ (gnus-multiple-choice
+ "Illegible text found. Continue posting? "
+ '((?d "Remove and continue posting")
+ (?r "Replace with dots and continue posting")
+ (?i "Ignore and continue posting")
+ (?e "Continue editing"))))
+ (if (eq choice ?e)
+ (error "Illegible text found"))
+ (message-goto-body)
+ (skip-chars-forward mm-7bit-chars)
+ (while (not (eobp))
+ (when (let ((char (char-after)))
+ (or (< (mm-char-int char) 128)
+ (and (mm-multibyte-p)
+ (memq (char-charset char)
+ '(eight-bit-control eight-bit-graphic
+ control-1)))))
+ (if (eq choice ?i)
+ (remove-text-properties (point) (1+ (point)) '(highlight t))
+ (delete-char 1)
+ (if (eq choice ?r)
+ (insert "."))))
+ (forward-char)
+ (skip-chars-forward mm-7bit-chars))))))
(defun message-add-action (action &rest types)
"Add ACTION to be performed when doing an exit of type TYPES."
+ (while types
+ (add-to-list (intern (format "message-%s-actions" (pop types)))
+ action)))
+
+(defun message-delete-action (action &rest types)
+ "Delete ACTION from lists of actions performed when doing an exit of type TYPES."
(let (var)
(while types
(set (setq var (intern (format "message-%s-actions" (pop types))))
- (nconc (symbol-value var) (list action))))))
+ (delq action (symbol-value var))))))
(defun message-do-actions (actions)
"Perform all actions in ACTIONS."
(message-posting-charset
(if (fboundp 'gnus-setup-posting-charset)
(gnus-setup-posting-charset nil)
- message-posting-charset)))
+ message-posting-charset))
+ (headers message-required-mail-headers))
(save-restriction
(message-narrow-to-headers)
+ ;; Generate the Mail-Followup-To header if the header is not there...
+ (if (and (or message-subscribed-regexps
+ message-subscribed-addresses
+ message-subscribed-address-file
+ message-subscribed-address-functions)
+ (not (mail-fetch-field "mail-followup-to")))
+ (setq headers
+ (cons
+ (cons "Mail-Followup-To" (message-make-mft))
+ message-required-mail-headers))
+ ;; otherwise, delete the MFT header if the field is empty
+ (when (equal "" (mail-fetch-field "mail-followup-to"))
+ (message-remove-header "^Mail-Followup-To:")))
;; Insert some headers.
(let ((message-deletable-headers
(if news nil message-deletable-headers)))
- (message-generate-headers message-required-mail-headers))
+ (message-generate-headers headers))
;; Let the user do all of the above.
(run-hooks 'message-header-hook))
(unwind-protect
(save-excursion
(set-buffer tembuf)
(erase-buffer)
- ;; Avoid copying text props.
+ ;; Avoid copying text props (except hard newlines).
(insert (with-current-buffer mailbuf
- (buffer-substring-no-properties (point-min) (point-max))))
+ (mml-buffer-substring-no-properties-except-hard-newlines
+ (point-min) (point-max))))
;; Remove some headers.
(message-encode-message-body)
(save-restriction
(message-insert-courtesy-copy))
(if (or (not message-send-mail-partially-limit)
(< (point-max) message-send-mail-partially-limit)
- (not (y-or-n-p "Message exceeds message-send-mail-partially-limit, send in parts? ")))
+ (not (message-y-or-n-p
+ "The message size is too large, split? "
+ t
+ "\
+The message size, " (/ (point-max) 1000) "KB, is too large.
+
+Some mail gateways (MTA's) bounce large messages. To avoid the
+problem, answer `y', and the message will be split into several
+smaller pieces, the size of each is about "
+(/ message-send-mail-partially-limit 1000)
+"KB except the last
+one.
+
+However, some mail readers (MUA's) can't read split messages, i.e.,
+mails in message/partially format. Answer `n', and the message will be
+sent in one piece.
+
+The size limit is controlled by `message-send-mail-partially-limit'.
+If you always want Gnus to send messages in one piece, set
+`message-send-mail-partially-limit' to `nil'.
+")))
(mm-with-unibyte-current-buffer
(message "Sending via mail...")
(funcall (or message-send-mail-real-function
;; free for -inject-arguments -- a big win for the user and for us
;; since we don't have to play that double-guessing game and the user
;; gets full control (no gestapo'ish -f's, for instance). --sj
- message-qmail-inject-args))
+ (if (message-functionp message-qmail-inject-args)
+ (funcall message-qmail-inject-args)
+ message-qmail-inject-args)))
;; qmail-inject doesn't say anything on it's stdout/stderr,
;; we have to look at the retval instead
(0 nil)
;; Pass it on to mh.
(mh-send-letter)))
+(defun message-canlock-generate ()
+ "Return a string that is non-trival to guess.
+Do not use this for anything important, it is cryptographically weak."
+ (sha1 (concat (message-unique-id)
+ (format "%x%x%x" (random) (random t) (random))
+ (prin1-to-string (recent-keys))
+ (prin1-to-string (garbage-collect)))))
+
+(defun message-canlock-password ()
+ "The password used by message for cancel locks.
+This is the value of `canlock-password', if that option is non-nil.
+Otherwise, generate and save a value for `canlock-password' first."
+ (unless canlock-password
+ (customize-save-variable 'canlock-password (message-canlock-generate)))
+ canlock-password)
+
+(defun message-insert-canlock ()
+ (when message-insert-canlock
+ (message-canlock-password)
+ (canlock-insert-header)))
+
(defun message-send-news (&optional arg)
(let* ((tembuf (message-generate-new-buffer-clone-locals " *message temp*"))
(case-fold-search nil)
;; -- Per Abrahamsen <abraham@dina.kvl.dk> 2001-10-08.
(group-field-charset
(gnus-group-name-charset method newsgroups-field))
- (followup-field-charset
+ (followup-field-charset
(gnus-group-name-charset method (or followup-field "")))
(rfc2047-header-encoding-alist
(append (when group-field-charset
(message-narrow-to-headers)
;; Insert some headers.
(message-generate-headers message-required-news-headers)
+ (message-insert-canlock)
;; Let the user do all of the above.
(run-hooks 'message-header-hook))
;; Note: This check will be disabled by the ".*" default value for
(set-buffer tembuf)
(buffer-disable-undo)
(erase-buffer)
- ;; Avoid copying text props.
- (insert (with-current-buffer messbuf
- (buffer-substring-no-properties
- (point-min) (point-max))))
+ ;; Avoid copying text props (except hard newlines).
+ (insert
+ (with-current-buffer messbuf
+ (mml-buffer-substring-no-properties-except-hard-newlines
+ (point-min) (point-max))))
(message-encode-message-body)
;; Remove some headers.
(save-restriction
(backward-char 1))
(run-hooks 'message-send-news-hook)
(gnus-open-server method)
- (message "Sending news with %s..." (gnus-server-string method))
+ (message "Sending news via %s..." (gnus-server-string method))
(setq result (let ((mail-header-separator ""))
(gnus-request-post method))))
(kill-buffer tembuf))
(zerop
(length
(setq to (completing-read
- "Followups to: (default all groups) "
+ "Followups to (default: no Followup-To header) "
(mapcar (lambda (g) (list g))
(cons "poster"
(message-tokenize-header
;; KLUDGE to handle nnvirtual groups. Doing this right
;; would probably involve a new nnoo function.
;; -- Per Abrahamsen <abraham@dina.kvl.dk>, 2001-10-17.
- (method (if (and (consp post-method)
+ (method (if (and (consp post-method)
(eq (car post-method) 'nnvirtual)
gnus-message-group-art)
(let ((group (car (nnvirtual-find-group-art
post-method))
(known-groups
(mapcar (lambda (n)
- (gnus-group-name-decode
+ (gnus-group-name-decode
(gnus-group-real-name n)
(gnus-group-name-charset method n)))
(gnus-groups-from-server method)))
"Process Fcc headers in the current buffer."
(let ((case-fold-search t)
(buf (current-buffer))
- list file)
+ list file
+ (mml-externalize-attachments message-fcc-externalize-attachments))
(save-excursion
(save-restriction
(message-narrow-to-headers)
(aset user (match-beginning 0) ?_))
user)
(message-number-base36 (user-uid) -1))
- (message-number-base36 (+ (car tm)
+ (message-number-base36 (+ (car tm)
(lsh (% message-unique-id-char 25) 16)) 4)
(message-number-base36 (+ (nth 1 tm)
(lsh (/ message-unique-id-char 25) 16)) 4)
(aset tmp (1- (match-end 0)) ?-))
(string-match "[\\()]" tmp)))))
(insert fullname)
- (goto-char (point-min))
- ;; Look for a character that cannot appear unquoted
- ;; according to RFC 822.
- (when (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" nil 1)
- ;; Quote fullname, escaping specials.
- (goto-char (point-min))
- (insert "\"")
- (while (re-search-forward "[\"\\]" nil 1)
- (replace-match "\\\\\\&" t))
- (insert "\""))
(insert " <" login ">"))
(t ; 'parens or default
(insert login " (")
(match-string 1 user-mail))
;; Default to this bogus thing.
(t
- (concat system-name ".i-did-not-set--mail-host-address--so-shoot-me")))))
+ (concat system-name ".i-did-not-set--mail-host-address--so-tickle-me")))))
(defun message-make-host-name ()
"Return the name of the host."
(or mail-host-address
(message-make-fqdn)))
+(defun message-to-list-only ()
+ (interactive)
+ (let ((listaddr (message-make-mft t)))
+ (when listaddr
+ (save-excursion
+ (message-remove-header "to")
+ (message-remove-header "cc")
+ (message-position-on-field "To" "X-Draft-From")
+ (insert listaddr)))))
+
+(defun message-make-mft (&optional only-show-subscribed)
+ "Return the Mail-Followup-To header. If passed the optional
+argument `only-show-subscribed' only return the subscribed address (and
+not the additional To and Cc header contents)."
+ (let* ((case-fold-search t)
+ (to (message-fetch-field "To"))
+ (cc (message-fetch-field "cc"))
+ (msg-recipients (concat to (and to cc ", ") cc))
+ (recipients
+ (mapcar 'mail-strip-quoted-names
+ (message-tokenize-header msg-recipients)))
+ (file-regexps
+ (if message-subscribed-address-file
+ (let (begin end item re)
+ (save-excursion
+ (with-temp-buffer
+ (insert-file-contents message-subscribed-address-file)
+ (while (not (eobp))
+ (setq begin (point))
+ (forward-line 1)
+ (setq end (point))
+ (if (bolp) (setq end (1- end)))
+ (setq item (regexp-quote (buffer-substring begin end)))
+ (if re (setq re (concat re "\\|" item))
+ (setq re (concat "\\`\\(" item))))
+ (and re (list (concat re "\\)\\'"))))))))
+ (mft-regexps (apply 'append message-subscribed-regexps
+ (mapcar 'regexp-quote
+ message-subscribed-addresses)
+ file-regexps
+ (mapcar 'funcall
+ message-subscribed-address-functions))))
+ (save-match-data
+ (let ((subscribed-lists nil)
+ (list
+ (loop for recipient in recipients
+ when (loop for regexp in mft-regexps
+ when (string-match regexp recipient) return t)
+ return recipient)))
+ (when list
+ (if only-show-subscribed
+ list
+ msg-recipients))))))
+
(defun message-generate-headers (headers)
"Prepare article HEADERS.
Headers already prepared in the buffer are not modified."
;; This header didn't exist, so we insert it.
(goto-char (point-max))
(insert (if (stringp header) header (symbol-name header))
- ": " value "\n")
+ ": " value)
+ ;; We check whether the value was ended by a
+ ;; newline. If now, we insert one.
+ (unless (bolp)
+ (insert "\n"))
(forward-line -1))
;; The value of this header was empty, so we clear
;; totally and insert the new value.
(forward-line 2)))
(sit-for 0)))
+(defun message-beginning-of-line (&optional n)
+ "Move point to beginning of header value or to beginning of line."
+ (interactive "p")
+ (if (message-point-in-header-p)
+ (let* ((here (point))
+ (bol (progn (beginning-of-line n) (point)))
+ (eol (gnus-point-at-eol))
+ (eoh (re-search-forward ": *" eol t)))
+ (if (or (not eoh) (equal here eoh))
+ (goto-char bol)
+ (goto-char eoh)))
+ (beginning-of-line n)))
+
(defun message-buffer-name (type &optional to group)
"Return a new (unique) buffer name based on TYPE and TO."
(cond
to group)
(if (not (or (null name)
(string-equal name "mail")
- (string-equal name "news")))
+ (string-equal name "posting")))
(setq name (concat "*sent " name "*"))
(message-narrow-to-headers)
(setq to (message-fetch-field "to"))
(or (car (mail-extract-address-components to))
to) "*"))
((and group (not (string= group "")))
- (concat "*sent news on " group "*"))
+ (concat "*sent posting on " group "*"))
(t "*sent mail*"))))
(unless (string-equal name (buffer-name))
(rename-buffer name t)))))
headers)
nil switch-function yank-action actions)))))
-;;;(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.
(setq message-draft-article
(nndraft-request-associate-buffer "drafts"))
(setq buffer-file-name (expand-file-name
- (if (memq system-type
- '(ms-dos ms-windows windows-nt
- cygwin32 win32 w32
+ (if (memq system-type
+ '(ms-dos ms-windows windows-nt
+ cygwin32 win32 w32
mswindows))
"message"
"*message*")
"Start editing a news article to be sent."
(interactive)
(let ((message-this-is-news t))
- (message-pop-to-buffer (message-buffer-name "news" nil newsgroups))
+ (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups))
(message-setup `((Newsgroups . ,(or newsgroups ""))
(Subject . ,(or subject ""))))))
;; Perhaps "Mail-Copies-To: never" removed the only address?
(if (string-equal recipients "")
(setq recipients author))
- ;; Convert string to a list of (("foo@bar" . "Name <foo@bar>") ...).
+ ;; Convert string to a list of (("foo@bar" . "Name <Foo@BAR>") ...).
(setq recipients
(mapcar
(lambda (addr)
- (cons (mail-strip-quoted-names addr) addr))
+ (cons (downcase (mail-strip-quoted-names addr)) addr))
(message-tokenize-header recipients)))
;; Remove first duplicates. (Why not all duplicates? Is this a bug?)
(let ((s recipients))
(while s
(setq recipients (delq (assoc (car (pop s)) s) recipients))))
+
+ ;; Remove hierarchical lists that are contained within each other,
+ ;; if message-hierarchical-addresses is defined.
+ (when message-hierarchical-addresses
+ (let ((plain-addrs (mapcar 'car recipients))
+ subaddrs recip)
+ (while plain-addrs
+ (setq subaddrs (assoc (car plain-addrs)
+ message-hierarchical-addresses)
+ plain-addrs (cdr plain-addrs))
+ (when subaddrs
+ (setq subaddrs (cdr subaddrs))
+ (while subaddrs
+ (setq recip (assoc (car subaddrs) recipients)
+ subaddrs (cdr subaddrs))
+ (if recip
+ (setq recipients (delq recip recipients))))))))
+
;; Build the header alist. Allow the user to be asked whether
;; or not to reply to all recipients in a wide reply.
(setq follow-to (list (cons 'To (cdr (pop recipients)))))
;; <abraham@dina.kvl.dk>
;;
;; IF article has cancel-lock THEN
- ;; IF we can load canlock THEN
- ;; IF we can verify it THEN
- ;; issue cancel
- ;; ELSE
- ;; error: cancellock: article is not yours
+ ;; IF we can verify it THEN
+ ;; issue cancel
;; ELSE
- ;; error: message is cancel locked
+ ;; error: cancellock: article is not yours
;; ELSE
;; Use old rules, comparing sender...
(if (message-fetch-field "Cancel-Lock")
- (if (ignore-errors (require 'canlock))
- (if (null (canlock-verify))
- t
- (error "Failed to verify Cancel-lock: This article is not yours"))
- (error "This article is cancel locked, the `canlock.el' library is required."))
+ (if (null (canlock-verify))
+ t
+ (error "Failed to verify Cancel-lock: This article is not yours"))
nil)
(message-gnksa-enable-p 'cancel-messages)
(and sender
(sender (message-fetch-field "sender"))
(from (message-fetch-field "from")))
;; Check whether the user owns the article that is to be superseded.
- (unless (or (message-gnksa-enable-p 'cancel-messages)
+ (unless (or
+ ;; Canlock-logic as suggested by Per Abrahamsen
+ ;; <abraham@dina.kvl.dk>
+ ;;
+ ;; IF article has cancel-lock THEN
+ ;; IF we can verify it THEN
+ ;; issue cancel
+ ;; ELSE
+ ;; error: cancellock: article is not yours
+ ;; ELSE
+ ;; Use old rules, comparing sender...
+ (if (message-fetch-field "Cancel-Lock")
+ (if (null (canlock-verify))
+ t
+ (error "Failed to verify Cancel-lock: This article is not yours"))
+ nil)
+ (message-gnksa-enable-p 'cancel-messages)
(and sender
(string-equal
(downcase sender)
"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
(not message-forward-decoded-p))
(insert
(with-temp-buffer
- (mm-disable-multibyte-mule4) ;; Must copy buffer in unibyte mode
+ (if (with-current-buffer forward-buffer
+ (mm-multibyte-p))
+ (insert-buffer-substring forward-buffer)
+ (mm-disable-multibyte-mule4)
(insert
(with-current-buffer forward-buffer
(mm-string-as-unibyte (buffer-string))))
- (mm-enable-multibyte-mule4)
- (mime-to-mml)
- (goto-char (point-min))
- (when (looking-at "From ")
- (replace-match "X-From-Line: "))
- (buffer-string)))
+ (mm-enable-multibyte-mule4))
+ (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)
;;;###autoload
(defun message-forward-rmail-make-body (forward-buffer)
- (with-current-buffer forward-buffer
- (let (rmail-enable-mime)
- (rmail-toggle-header 0)))
+ (save-window-excursion
+ (set-buffer forward-buffer)
+ ;; Rmail doesn't have rmail-msg-restore-non-pruned-header in Emacs
+ ;; 20. FIXIT, or we drop support for rmail in Emacs 20.
+ (if (rmail-msg-is-pruned)
+ (rmail-msg-restore-non-pruned-header)))
(message-forward-make-body forward-buffer))
;;;###autoload
"Let RMAIL uses message to forward."
(interactive)
(setq rmail-enable-mime-composing t)
- (setq rmail-insert-mime-forwarded-message-function
+ (setq rmail-insert-mime-forwarded-message-function
'message-forward-rmail-make-body))
;;;###autoload
(special-display-regexps nil)
(same-window-buffer-names nil)
(same-window-regexps nil))
- (message-pop-to-buffer (message-buffer-name "news" nil newsgroups)))
+ (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups)))
(let ((message-this-is-news t))
(message-setup `((Newsgroups . ,(or newsgroups ""))
(Subject . ,(or subject ""))))))
(special-display-regexps nil)
(same-window-buffer-names nil)
(same-window-regexps nil))
- (message-pop-to-buffer (message-buffer-name "news" nil newsgroups)))
+ (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups)))
(let ((message-this-is-news t))
(message-setup `((Newsgroups . ,(or newsgroups ""))
(Subject . ,(or subject ""))))))
(defun message-tool-bar-map ()
(or message-tool-bar-map
(setq message-tool-bar-map
- (and (fboundp 'tool-bar-add-item-from-menu)
- 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))
- (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
+ (and
+ (condition-case nil (require 'tool-bar) (error nil))
+ (fboundp 'tool-bar-add-item-from-menu)
+ 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))
+ (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)))))
+ (tool-bar-add-item-from-menu
+ 'mml-attach-file "attach" mml-mode-map)
+ (tool-bar-add-item-from-menu
+ 'ispell-message "spell" message-mode-map)
+ (tool-bar-add-item-from-menu
+ 'message-insert-importance-high "important"
+ message-mode-map)
+ (tool-bar-add-item-from-menu
+ 'message-insert-importance-low "unimportant"
+ message-mode-map)
+ (tool-bar-add-item-from-menu
+ 'message-insert-disposition-notification-to "receipt"
+ message-mode-map)
+ tool-bar-map)))))
;;; Group name completion.
-(defvar message-newgroups-header-regexp
+(defcustom message-newgroups-header-regexp
"^\\(Newsgroups\\|Followup-To\\|Posted-To\\|Gcc\\):"
- "Regexp that match headers that lists groups.")
+ "Regexp that match headers that lists groups."
+ :group 'message
+ :type 'regexp)
-(defvar message-completion-alist
+(defcustom message-completion-alist
(list (cons message-newgroups-header-regexp 'message-expand-group)
'("^\\(Resent-\\)?\\(To\\|B?Cc\\):" . message-expand-name))
- "Alist of (RE . FUN). Use FUN for completion on header lines matching RE.")
+ "Alist of (RE . FUN). Use FUN for completion on header lines matching RE."
+ :group 'message
+ :type '(alist :key-type regexp :value-type function))
-(defvar message-tab-body-function 'indent-relative
- "*Function to execute when `message-tab' (TAB) is executed in the body.")
+(defcustom message-tab-body-function nil
+ "*Function to execute when `message-tab' (TAB) is executed in the body.
+If nil, the function bound in `text-mode-map' or `global-map' is executed."
+ :group 'message
+ :type 'function)
(defun message-tab ()
"Complete names according to `message-completion-alist'.
-Do an `indent-relative' if not in those headers."
+Execute function specified by `message-tab-body-function' when not in
+those headers."
(interactive)
(let ((alist message-completion-alist))
(while (and alist
(let ((mail-abbrev-mode-regexp (caar alist)))
(not (mail-abbrev-in-expansion-header-p))))
(setq alist (cdr alist)))
- (funcall (or (cdar alist) message-tab-body-function))))
+ (funcall (or (cdar alist) message-tab-body-function
+ (lookup-key text-mode-map "\t")
+ (lookup-key global-map "\t")
+ 'indent-relative))))
(defun message-expand-group ()
"Expand the group name under point."
(message-narrow-to-headers-or-head)
(message-remove-first-header "Content-Type")
(message-remove-first-header "Content-Transfer-Encoding"))
- ;; We always make sure that the message has a Content-Type header.
- ;; This is because some broken MTAs and MUAs get awfully confused
- ;; when confronted with a message with a MIME-Version header and
- ;; without a Content-Type header. For instance, Solaris'
- ;; /usr/bin/mail.
+ ;; We always make sure that the message has a Content-Type
+ ;; header. This is because some broken MTAs and MUAs get
+ ;; awfully confused when confronted with a message with a
+ ;; MIME-Version header and without a Content-Type header. For
+ ;; instance, Solaris' /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)
+(defun message-read-from-minibuffer (prompt &optional initial-contents)
"Read from the minibuffer while providing abbrev expansion."
(if (fboundp 'mail-abbrevs-setup)
(let ((mail-abbrev-mode-regexp "")
(minibuffer-setup-hook 'mail-abbrevs-setup)
(minibuffer-local-map message-minibuffer-local-map))
- (read-from-minibuffer prompt))
+ (read-from-minibuffer prompt initial-contents))
(let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook)
(minibuffer-local-map message-minibuffer-local-map))
- (read-string prompt))))
+ (read-string prompt initial-contents))))
(defun message-use-alternative-email-as-from ()
(require 'mail-utils)
projects / gnus / blobdiff