-;;; 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>
(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)
(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
: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)
(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."
- :group 'message-headers
- :type 'boolean)
-
-(defcustom message-insert-canlock t
- "Whether to insert a Cancel-Lock header in news postings."
+ :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-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 "\M-q" 'message-fill-paragraph)
(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
+ ["Flag As Important" message-insert-importance-high
,@(if (featurep 'xemacs) '(t)
'(:help "Mark this message as important"))]
- ["Flag as unimportant" message-insert-importance-low
+ ["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]
;;
;; We use `after-change-functions' to keep special text properties
;; that interfer with the normal function of message mode out of the
-;; buffer.
+;; buffer.
(defcustom message-strip-special-text-properties t
"Strip special properties from the message buffer.
:group 'message-various
:type 'boolean)
-(defconst message-forbidden-properties
+(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
+ '(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)
+ 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.
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 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)
(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.
+ ;; 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
+ (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)
(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-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)
(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)
(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."
(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)
;; -- 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
(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-make-mft ()
- "Return the Mail-Followup-To header."
- (let* ((msg-recipients (message-options-get 'message-recipients))
+(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)))
(setq end (point))
(if (bolp) (setq end (1- end)))
(setq item (regexp-quote (buffer-substring begin end)))
- (if re (setq re (concat re "\\)\\|\\(" item))
+ (if re (setq re (concat re "\\|" item))
(setq re (concat "\\`\\(" item))))
(and re (list (concat re "\\)\\'"))))))))
(mft-regexps (apply 'append message-subscribed-regexps
(mapcar 'funcall
message-subscribed-address-functions))))
(save-match-data
- (when (eval (apply 'append '(or)
- (mapcar
- (function (lambda (regexp)
- (mapcar
- (function (lambda (recipient)
- `(string-match ,regexp
- ,recipient)))
- recipients)))
- mft-regexps)))
- msg-recipients))))
+ (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.
;; 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.
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)))))
(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)))))
(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)
(defun message-forward-rmail-make-body (forward-buffer)
(save-window-excursion
(set-buffer forward-buffer)
- (let (rmail-enable-mime)
- (rmail-toggle-header 0)))
+ ;; 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" 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"
+ (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-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.
(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))
;; For unknown reason, MIME-Version doesn't exist.
(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