;;; message.el --- composing mail and news messages
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;;;###autoload
(defcustom message-archive-note
"X-No-Archive: Yes - save http://groups.google.com/"
- "Note to insert why you wouldn't want this posting archived.
+ "Note to insert why you wouldn't want this posting archived.
If nil, don't insert any text in the body."
:type 'string
:group 'message-various)
;; inspired by JoH-followup-to by Jochem Huhman <joh at gmx.de>
;; new suggestions by R. Weikusat <rw at another.de>
-(defvar message-xpost-old-target nil
+(defvar message-cross-post-old-target nil
"Old target for cross-posts or follow-ups.")
-(make-variable-buffer-local 'message-xpost-old-target)
+(make-variable-buffer-local 'message-cross-post-old-target)
;;;###autoload
-(defcustom message-xpost-default t
- "When non-nil `message-xpost-fup2' will normally perform a crosspost.
-If nil, `message-xpost-fup2' will only do a followup. Note that you
-can explicitly override this setting by calling `message-xpost-fup2'
-with a prefix."
+(defcustom message-cross-post-default t
+ "When non-nil `message-cross-post-followup-to' will perform a crosspost.
+If nil, `message-cross-post-followup-to' will only do a followup. Note that
+you can explicitly override this setting by calling
+`message-cross-post-followup-to' with a prefix."
:type 'boolean
:group 'message-various)
;;;###autoload
-(defcustom message-xpost-note
+(defcustom message-cross-post-note
"Crosspost & Followup-To: "
"Note to insert before signature to notify of xpost and follow-up."
:type 'string
:group 'message-various)
;;;###autoload
-(defcustom message-fup2-note
+(defcustom message-followup-to-note
"Followup-To: "
"Note to insert before signature to notify of follow-up only."
:type 'string
:group 'message-various)
;;;###autoload
-(defcustom message-xpost-note-function
- 'message-xpost-insert-note
- "Function to use to insert note about Crosspost or Followup-To.
+(defcustom message-cross-post-note-function
+ 'message-cross-post-insert-note
+ "Function to use to insert note about Crosspost or Followup-To.
The function will be called with four arguments. The function should not only
insert a note, but also ensure old notes are deleted. See the documentation
-for `message-xpost-insert-note'. "
+for `message-cross-post-insert-note'."
:type 'function
:group 'message-various)
:group 'message-headers
:type 'boolean)
-(defcustom message-syntax-checks
+(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.
`new-text', `quoting-style', `redirected-followup', `signature',
`approved', `sender', `empty', `empty-headers', `message-id', `from',
`subject', `shorten-followup-to', `existing-newsgroups',
-`buffer-file-name', `unchanged', `newsgroups', `reply-to'."
+`buffer-file-name', `unchanged', `newsgroups', `reply-to',
+'continuation-headers', and `long-header-lines'."
:group 'message-news
:type '(repeat sexp)) ; Fixme: improve this
+(defcustom message-required-headers '((optional . References) From)
+ "*Headers to be generated or promted for when sending a message.
+Also see `message-required-news-headers' and
+1message-required-mail-headers'."
+ :group 'message-news
+ :group 'message-headers
+ :type '(repeat sexp))
+
+(defcustom message-draft-headers '(References From)
+ "*Headers to be generated when saving a draft message."
+ :group 'message-news
+ :group 'message-headers
+ :type '(repeat sexp))
+
(defcustom message-required-news-headers
'(From Newsgroups Subject Date Message-ID
- (optional . Organization) Lines
+ (optional . Organization)
(optional . User-Agent))
"*Headers to be generated or prompted for when posting an article.
RFC977 and RFC1036 require From, Date, Newsgroups, Subject,
:type '(repeat sexp))
(defcustom message-required-mail-headers
- '(From Subject Date (optional . In-Reply-To) Message-ID Lines
+ '(From Subject Date (optional . In-Reply-To) Message-ID
(optional . User-Agent))
"*Headers to be generated or prompted for when mailing a message.
It is recommended that From, Date, To, Subject and Message-ID be
-included. Organization, Lines and User-Agent are optional."
+included. Organization and User-Agent are optional."
:group 'message-mail
:group 'message-headers
:type '(repeat sexp))
"*If non-nil, generate all required headers before composing.
The variables `message-required-news-headers' and
`message-required-mail-headers' specify which headers to generate.
+This can also be a list of headers that should be generated before
+composing.
Note that the variable `message-deletable-headers' specifies headers which
are to be deleted and then re-generated before sending, so this variable
will not have a visible effect for those headers."
:group 'message-headers
- :type 'boolean)
+ :type '(choice (const :tag "None" nil)
+ (const :tag "All" t)
+ (repeat (sexp :tag "Header"))))
(defcustom message-setup-hook '(turn-on-mime-edit)
"Normal hook, run each time a new outgoing message is initialized.
:group 'message-various
:type 'hook)
-(defcustom message-header-hook '((lambda () (eword-encode-header t)))
+(defcustom message-header-hook '((lambda () (mime-encode-header-in-buffer t)))
"Hook run in a message mode buffer narrowed to the headers."
:group 'message-various
:type 'hook)
:type '(choice file (const :tags "None" nil))
:group 'message-insertion)
+;;;###autoload
+(defcustom message-signature-insert-empty-line t
+ "*If non-nil, insert an empty line before the signature separator."
+ :type 'boolean
+ :group 'message-insertion)
+
(defcustom message-distribution-function nil
"*Function called to return a Distribution header."
:group 'message-news
"*A list of GNKSA feet you are allowed to shoot.
Gnus gives you all the opportunity you could possibly want for
shooting yourself in the foot. Also, Gnus allows you to shoot the
-feet of Good Net-Keeping Seal of Approval. The following are foot
+feet of Good Net-Keeping Seal of Approval. The following are foot
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 messages from
+`cancel-messages' Allow you to cancel or supersede messages from
your other email addresses.")
(defsubst message-gnksa-enable-p (feature)
(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."
(defvar message-draft-coding-system
nnheader-auto-save-coding-system
- "Coding system to compose mail.")
+ "*Coding system to compose mail.
+If you'd like to make it possible to share draft files between XEmacs
+and Emacs, you may use `iso-2022-7bit' for this value at your own risk.
+Note that the coding-system `iso-2022-7bit' isn't suitable to all data.")
(defcustom message-send-mail-partially-limit 1000000
"The limitation of messages sent as message/partial.
(autoload 'gnus-group-name-decode "gnus-group")
(autoload 'gnus-groups-from-server "gnus")
(autoload 'rmail-output "rmailout")
+ (autoload 'gnus-delay-article "gnus-delay")
(autoload 'mu-cite-original "mu-cite"))
\f
(insert (car headers) ?\n)))))
(setq headers (cdr headers))))
+(defmacro message-with-reply-buffer (&rest forms)
+ "Evaluate FORMS in the reply buffer, if it exists."
+ `(let ((buffer (message-eval-parameter message-reply-buffer)))
+ (when (and buffer
+ (buffer-name buffer))
+ (save-excursion
+ (set-buffer buffer)
+ ,@forms))))
+
+(put 'message-with-reply-buffer 'lisp-indent-function 0)
+(put 'message-with-reply-buffer 'edebug-form-spec '(body))
(defun message-fetch-reply-field (header)
"Fetch field HEADER from the message we're replying to."
- (let ((buffer (message-eval-parameter message-reply-buffer)))
- (when (and buffer
- (buffer-name buffer))
- (save-excursion
- (set-buffer buffer)
- (message-fetch-field header)))))
+ (message-with-reply-buffer
+ (message-fetch-field header)))
(defun message-set-work-buffer ()
(if (get-buffer " *message work*")
;;; Start of functions adopted from `message-utils.el'.
(defun message-strip-subject-trailing-was (subject)
- "Remove trailing \"(Was: <old subject>)\" from subject lines.
+ "Remove trailing \"(Was: <old subject>)\" from SUBJECT lines.
Leading \"Re: \" is not stripped by this function. Use the function
`message-strip-subject-re' for this."
(let* ((query message-subject-trailing-was-query)
(new) (found))
(setq found
- (string-match
+ (string-match
(if (eq query 'ask)
message-subject-trailing-was-ask-regexp
message-subject-trailing-was-regexp)
(if (eq query 'ask)
(if (message-y-or-n-p
"Strip `(was: <old subject>)' in subject? " t
- (concat
+ (concat
"Strip `(was: <old subject>)' in subject "
"and use the new one instead?\n\n"
"Current subject is: \""
;;;###autoload
(defun message-change-subject (new-subject)
- "Ask for new Subject: header, append (was: <Old Subject>)."
+ "Ask for NEW-SUBJECT header, append (was: <Old Subject>)."
(interactive
(list
(read-from-minibuffer "New subject: ")))
(save-excursion
(let ((old-subject (message-fetch-field "Subject")))
(cond ((not old-subject)
- (error "No current subject."))
+ (error "No current subject"))
((not (string-match
(concat "^[ \t]*"
(regexp-quote new-subject)
;;;###autoload
(defun message-mark-insert-file (file)
- "Inserts FILE at point, marking it with enclosing tags.
+ "Insert FILE at point, marking it with enclosing tags.
See `message-mark-insert-begin' and `message-mark-insert-end'."
(interactive "fFile to insert: ")
;; reverse insertion to get correct result.
(message-sort-headers)))
;;;###autoload
-(defun message-xpost-fup2-header (target-group)
+(defun message-cross-post-followup-to-header (target-group)
"Mangles FollowUp-To and Newsgroups header to point to TARGET-GROUP.
With prefix-argument just set Follow-Up, don't cross-post."
(interactive
(message-goto-newsgroups)
(beginning-of-line)
;; if we already did a crosspost before, kill old target
- (if (and message-xpost-old-target
+ (if (and message-cross-post-old-target
(re-search-forward
- (regexp-quote (concat "," message-xpost-old-target))
+ (regexp-quote (concat "," message-cross-post-old-target))
nil t))
(replace-match ""))
;; unless (followup is to poster or user explicitly asked not
;; to cross-post, or target-group is already in Newsgroups)
;; add target-group to Newsgroups line.
(cond ((and (or
- ;; def: xpost, req:no
- (and message-xpost-default (not current-prefix-arg))
- ;; def: no-xpost, req:yes
- (and (not message-xpost-default) current-prefix-arg))
+ ;; def: cross-post, req:no
+ (and message-cross-post-default (not current-prefix-arg))
+ ;; def: no-cross-post, req:yes
+ (and (not message-cross-post-default) current-prefix-arg))
(not (string-match "poster" target-group))
(not (string-match (regexp-quote target-group)
(message-fetch-field "Newsgroups"))))
"[ \t]*$")
(message-fetch-field "Newsgroups")))
(insert (concat "\nFollowup-To: " target-group)))
- (setq message-xpost-old-target target-group))
+ (setq message-cross-post-old-target target-group))
;;;###autoload
-(defun message-xpost-insert-note (target-group xpost in-old old-groups)
+(defun message-cross-post-insert-note (target-group cross-post in-old
+ old-groups)
"Insert a in message body note about a set Followup or Crosspost.
If there have been previous notes, delete them. TARGET-GROUP specifies the
-group to Followup-To. When XPOST is t, insert note about
+group to Followup-To. When CROSS-POST is t, insert note about
crossposting. IN-OLD specifies whether TARGET-GROUP is a member of
OLD-GROUPS. OLD-GROUPS lists the old-groups the posting would have
been made to before the user asked for a Crosspost."
nil t))) ; just search in body
(message-goto-signature)
(while (re-search-backward
- (concat "^" (regexp-quote message-xpost-note) ".*")
+ (concat "^" (regexp-quote message-cross-post-note) ".*")
head t)
(message-delete-line))
(message-goto-signature)
(while (re-search-backward
- (concat "^" (regexp-quote message-fup2-note) ".*")
+ (concat "^" (regexp-quote message-followup-to-note) ".*")
head t)
(message-delete-line))
;; insert new note
(if (message-goto-signature)
(re-search-backward message-signature-separator))
(if (or in-old
- (not xpost)
+ (not cross-post)
(string-match "^[ \t]*poster[ \t]*$" target-group))
- (insert (concat message-fup2-note target-group "\n"))
- (insert (concat message-xpost-note target-group "\n")))))
+ (insert (concat message-followup-to-note target-group "\n"))
+ (insert (concat message-cross-post-note target-group "\n")))))
;;;###autoload
-(defun message-xpost-fup2 (target-group)
- "Crossposts message and sets Followup-To to TARGET-GROUP.
+(defun message-cross-post-followup-to (target-group)
+ "Crossposts message and set Followup-To to TARGET-GROUP.
With prefix-argument just set Follow-Up, don't cross-post."
(interactive
(list ; Completion based on Gnus
(save-excursion
(let* ((old-groups (message-fetch-field "Newsgroups"))
(in-old (string-match
- (regexp-quote target-group)
+ (regexp-quote target-group)
(or old-groups ""))))
;; check whether target exactly matches old Newsgroups
(cond ((not old-groups)
- (error "No current newsgroup."))
+ (error "No current newsgroup"))
((or (not in-old)
(not (string-match
(concat "^[ \t]*"
"[ \t]*$")
old-groups)))
;; yes, Newsgroups line must change
- (message-xpost-fup2-header target-group)
- ;; insert note whether we do xpost or fup2
- (funcall message-xpost-note-function
+ (message-cross-post-followup-to-header target-group)
+ ;; insert note whether we do cross-post or followup-to
+ (funcall message-cross-post-note-function
target-group
- (if (or (and message-xpost-default
+ (if (or (and message-cross-post-default
(not current-prefix-arg))
- (and (not message-xpost-default)
+ (and (not message-cross-post-default)
current-prefix-arg)) t)
in-old old-groups))))))))
(message-fetch-field "cc")
(message-fetch-field "bcc")))))))
+(defun message-subscribed-p ()
+ "Say whether we need to insert a MFT header."
+ (or message-subscribed-regexps
+ message-subscribed-addresses
+ message-subscribed-address-file
+ message-subscribed-address-functions))
+
(defun message-next-header ()
"Go to the beginning of the next header."
(beginning-of-line)
(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-f\C-i"
+ 'message-insert-or-toggle-importance)
+ (define-key message-mode-map "\C-c\C-f\C-a"
+ 'message-generate-unsubscribed-mail-followup-to)
;; modify headers (and insert notes in body)
(define-key message-mode-map "\C-c\C-fs" 'message-change-subject)
;;
- (define-key message-mode-map "\C-c\C-fx" 'message-xpost-fup2)
- ;; prefix+message-xpost-fup2 = same w/o xpost
+ (define-key message-mode-map "\C-c\C-fx" 'message-cross-post-followup-to)
+ ;; prefix+message-cross-post-followup-to = same w/o cross-post
(define-key message-mode-map "\C-c\C-ft" 'message-reduce-to-to-cc)
(define-key message-mode-map "\C-c\C-fa" 'message-add-archive-header)
;; mark inserted text
(define-key message-mode-map "\C-c\M-m" 'message-mark-inserted-region)
(define-key message-mode-map "\C-c\M-f" 'message-mark-insert-file)
-
+
(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-fc" 'message-goto-mail-copies-to)
(define-key message-mode-map "\C-c\C-t" 'message-insert-to)
+ (define-key message-mode-map "\C-c\M-t" 'message-insert-wide-reply)
(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\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)
(easy-menu-define
message-mode-menu message-mode-map "Message Menu."
`("Message"
- ["Sort Headers" message-sort-headers t]
["Yank Original" message-yank-original t]
["Fill Yanked Message" message-fill-yanked-message t]
["Insert Signature" message-insert-signature t]
["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"))]
["Insert Region Marked" message-mark-inserted-region
,@(if (featurep 'xemacs) '(t)
'(:help "Mark region with enclosing tags"))]
- ["Insert File Marked" message-mark-insert-file
+ ["Insert File Marked..." message-mark-insert-file
,@(if (featurep 'xemacs) '(t)
'(:help "Insert file at point marked with enclosing tags"))]
"----"
["Postpone Message" message-dont-send
,@(if (featurep 'xemacs) '(t)
'(:help "File this draft message and exit"))]
- ["Send at Specific Time" gnus-delay-article
+ ["Send at Specific Time..." gnus-delay-article
,@(if (featurep 'xemacs) '(t)
'(:help "Ask, then arrange to send message at that time"))]
["Kill Message" message-kill-buffer
(easy-menu-define
message-mode-field-menu message-mode-map ""
- '("Field"
+ `("Field"
["Fetch To" message-insert-to t]
["Fetch Newsgroups" message-insert-newsgroups t]
"----"
["To" message-goto-to t]
["From" message-goto-from t]
["Subject" message-goto-subject t]
- ["Change subject" message-change-subject t]
+ ["Change subject..." message-change-subject t]
["Cc" message-goto-cc t]
["Bcc" message-goto-bcc t]
["Fcc" message-goto-fcc t]
["Reply-To" message-goto-reply-to 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 receipt notification"))]
"----"
;; (typical) news stuff
["Summary" message-goto-summary t]
["Keywords" message-goto-keywords t]
["Newsgroups" message-goto-newsgroups t]
["Followup-To" message-goto-followup-to t]
- ;; ["Followup-To (with note in body)" message-xpost-fup2 t]
- ["Crosspost / Followup-To" message-xpost-fup2 t]
+ ;; ["Followup-To (with note in body)" message-cross-post-followup-to t]
+ ["Crosspost / Followup-To..." message-cross-post-followup-to t]
["Distribution" message-goto-distribution t]
["X-No-Archive:" message-add-archive-header t ]
"----"
["Mail-Copies-To" message-goto-mail-copies-to t]
["Reduce To: to Cc:" message-reduce-to-to-cc t]
"----"
- ["Body" message-goto-body t]
- ["Signature" message-goto-signature t]))
+ ["Sort Headers" message-sort-headers t]
+ ["Goto Body" message-goto-body t]
+ ["Goto Signature" message-goto-signature t]))
(defvar message-tool-bar-map nil)
(goto-char (point-max))
nil))
-(defun message-gen-unsubscribed-mft (&optional include-cc)
+(defun message-generate-unsubscribed-mail-followup-to (&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.
+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
+If the optional argument INCLUDE-CC is non-nil, the addresses in the
Cc: header are also put into the MFT."
(interactive "P")
(or (equal (downcase co) "never")
(equal (downcase co) "nobody")))
(error "The user has requested not to have copies sent via mail")))
- (when (and (message-position-on-field "To")
- (mail-fetch-field "to")
- (not (string-match "\\` *\\'" (mail-fetch-field "to"))))
- (insert ", "))
- (insert (or (message-fetch-reply-field "mail-reply-to")
- (message-fetch-reply-field "reply-to")
- (message-fetch-reply-field "from") "")))
+ (message-carefully-insert-headers
+ (list (cons 'To
+ (or (message-fetch-reply-field "mail-reply-to")
+ (message-fetch-reply-field "reply-to")
+ (message-fetch-reply-field "from")
+ "")))))
+
+(defun message-insert-wide-reply ()
+ "Insert To and Cc headers as if you were doing a wide reply."
+ (interactive)
+ (let ((headers (message-with-reply-buffer
+ (message-get-reply-headers t))))
+ (message-carefully-insert-headers headers)))
+
+(defun message-carefully-insert-headers (headers)
+ (dolist (header headers)
+ (let ((header-name (symbol-name (car header))))
+ (when (and (message-position-on-field header-name)
+ (mail-fetch-field header-name)
+ (not (string-match "\\` *\\'"
+ (mail-fetch-field header-name))))
+ (insert ", "))
+ (insert (cdr header)))))
(defun message-widen-reply ()
"Widen the reply to include maximum recipients."
;; Insert the signature.
(unless (bolp)
(insert "\n"))
+ (when message-signature-insert-empty-line
+ (insert "\n"))
(insert "\n" message-signature-separator-for-insertion)
(unless (bolp)
(insert "\n"))
(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)
+ (if (and (message-subscribed-p)
(not (mail-fetch-field "mail-followup-to")))
(setq headers
(cons
- (cons "Mail-Followup-To" (message-make-mft))
+ (cons "Mail-Followup-To" (message-make-mail-followup-to))
message-required-mail-headers))
;; otherwise, delete the MFT header if the field is empty
(when (equal "" (mail-fetch-field "mail-followup-to"))
;; require one newline at the end.
(or (= (preceding-char) ?\n)
(insert ?\n))
+ (message-cleanup-headers)
(when
(save-restriction
(message-narrow-to-headers)
(backward-char 1)
(run-hooks 'message-send-mail-hook)
(if recipients
- (static-if (fboundp 'smtp-send-buffer)
- (smtp-send-buffer user-mail-address recipients
- (current-buffer))
- (let ((result (smtp-via-smtp user-mail-address recipients
- (current-buffer))))
- (unless (eq result t)
- (error "Sending failed; %s" result))))
+ (smtp-send-buffer user-mail-address recipients (current-buffer))
(error "Sending failed; no recipients"))))
(defsubst message-maybe-split-and-send-news (method)
(y-or-n-p
"The control code \"cmsg\" is in the subject. Really post? ")
t))
+ ;; Check long header lines.
+ (message-check 'long-header-lines
+ (let ((start (point))
+ found)
+ (while (and (not found)
+ (re-search-forward "^\\([^ \t:]+\\): " nil t))
+ (when (> (- (point) start) 998)
+ (setq found t))
+ (setq start (match-beginning 0))
+ (forward-line 1))
+ (if found
+ (y-or-n-p (format "Your %s header is too long. Really post? "
+ (match-string 1)))
+ t)))
;; Check for multiple identical headers.
(message-check 'multiple-headers
(let (found)
(if (= (length errors) 1) "this" "these")
(if (= (length errors) 1) "" "s")
(mapconcat 'identity errors ", ")))))))
+ ;; Check continuation headers.
+ (message-check 'continuation-headers
+ (goto-char (point-min))
+ (let ((do-posting t))
+ (while (re-search-forward "^[^ \t\n][^:\n]*$" nil t)
+ (if (y-or-n-p "Fix continuation lines? ")
+ (progn
+ (goto-char (match-beginning 0))
+ (insert " "))
+ (unless (y-or-n-p "Send anyway? ")
+ (setq do-posting nil))))
+ do-posting))
;; Check the Newsgroups & Followup-To headers for syntax errors.
(message-check 'valid-newsgroups
(let ((case-fold-search t)
(message-goto-body)
(int-to-string (count-lines (point) (point-max))))))
+(defun message-make-references ()
+ "Return the References header for this message."
+ (when message-reply-headers
+ (let ((message-id (mail-header-message-id message-reply-headers))
+ (references (mail-header-references message-reply-headers))
+ new-references)
+ (if (or references message-id)
+ (concat (or references "") (and references " ")
+ (or message-id ""))
+ nil))))
+
(defun message-make-in-reply-to ()
"Return the In-Reply-To header for this message."
(when message-reply-headers
"Send a message to the list only.
Remove all addresses but the list address from To and Cc headers."
(interactive)
- (let ((listaddr (message-make-mft t)))
+ (let ((listaddr (message-make-mail-followup-to t)))
(when listaddr
(save-excursion
(message-remove-header "to")
(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)."
+(defun message-make-mail-followup-to (&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"))
(defun message-generate-headers (headers)
"Prepare article HEADERS.
Headers already prepared in the buffer are not modified."
+ (setq headers (append headers message-required-headers))
(save-restriction
(message-narrow-to-headers)
(let* ((Date (message-make-date))
(Subject nil)
(Newsgroups nil)
(In-Reply-To (message-make-in-reply-to))
+ (References (message-make-references))
(To nil)
(Distribution (message-make-distribution))
(Lines (message-make-lines))
(User-Agent (message-make-user-agent))
(Expires (message-make-expires))
(case-fold-search t)
+ (optionalp nil)
header value elem)
;; First we remove any old generated headers.
(let ((headers message-deletable-headers))
(setq elem (pop headers))
(if (consp elem)
(if (eq (car elem) 'optional)
- (setq header (cdr elem))
+ (setq header (cdr elem)
+ optionalp t)
(setq header (car elem)))
(setq header elem))
(when (or (not (re-search-forward
;; The header was found. We insert a space after the
;; colon, if there is none.
(if (/= (char-after) ? ) (insert " ") (forward-char 1))
- ;; Find out whether the header is empty...
+ ;; Find out whether the header is empty.
(looking-at "[ \t]*\n[^ \t]")))
;; So we find out what value we should insert.
(setq value
(cond
- ((and (consp elem) (eq (car elem) 'optional))
+ ((and (consp elem)
+ (eq (car elem) 'optional))
;; This is an optional header. If the cdr of this
;; is something that is nil, then we do not insert
;; this header.
(setq header (cdr elem))
- (or (and (fboundp (cdr elem)) (funcall (cdr elem)))
- (and (boundp (cdr elem)) (symbol-value (cdr elem)))))
+ (or (and (message-functionp (cdr elem))
+ (funcall (cdr elem)))
+ (and (boundp (cdr elem))
+ (symbol-value (cdr elem)))))
((consp elem)
;; The element is a cons. Either the cdr is a
;; string to be inserted verbatim, or it is a
;; function, and we insert the value returned from
;; this function.
- (or (and (stringp (cdr elem)) (cdr elem))
- (and (fboundp (cdr elem)) (funcall (cdr elem)))))
- ((and (boundp header) (symbol-value header))
+ (or (and (stringp (cdr elem))
+ (cdr elem))
+ (and (message-functionp (cdr elem))
+ (funcall (cdr elem)))))
+ ((and (boundp header)
+ (symbol-value header))
;; The element is a symbol. We insert the value
;; of this symbol, if any.
(symbol-value header))
(progn
;; This header didn't exist, so we insert it.
(goto-char (point-max))
- (insert (if (stringp header) header (symbol-name header))
- ": " value)
- ;; We check whether the value was ended by a
- ;; newline. If now, we insert one.
- (unless (bolp)
- (insert "\n"))
- (forward-line -1))
+ (let ((formatter
+ (cdr (assq header message-header-format-alist))))
+ (if formatter
+ (funcall formatter header value)
+ (insert (if (stringp header)
+ header (symbol-name header))
+ ": " 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.
(delete-region (point) (gnus-point-at-eol))
- (insert value)
- (when (bolp)
- (delete-char -1)))
+ ;; If the header is optional, and the header was
+ ;; empty, we can't insert it anyway.
+ (unless optionalp
+ (insert value)
+ (when (bolp)
+ (delete-char -1))))
;; Add the deletable property to the headers that require it.
(and (memq header message-deletable-headers)
(progn (beginning-of-line) (looking-at "[^:]+: "))
(forward-line 2)))
(sit-for 0)))
+(defcustom message-beginning-of-line t
+ "Whether C-a goes to beginning of header values."
+ :group 'message-buffers
+ :type 'boolean)
+
(defun message-beginning-of-line (&optional n)
"Move point to beginning of header value or to beginning of line."
(interactive "p")
(let ((zrs 'zmacs-region-stays))
(when (and (interactive-p) (boundp zrs))
(set zrs t)))
- (if (message-point-in-header-p)
+ (if (and message-beginning-of-line
+ (message-point-in-header-p))
(let* ((here (point))
(bol (progn (beginning-of-line n) (point)))
(eol (gnus-point-at-eol))
headers)
nil switch-function yank-action actions)))))
+(defun message-headers-to-generate (headers included-headers excluded-headers)
+ "Return a list that includes all headers from HEADERS.
+If INCLUDED-HEADERS is a list, just include those headers. If if is
+t, include all headers. In any case, headers from EXCLUDED-HEADERS
+are not included."
+ (let ((result nil)
+ header-name)
+ (dolist (header headers)
+ (setq header-name (cond
+ ((and (consp header)
+ (eq (car header) 'optional))
+ ;; On the form (optional . Header)
+ (cdr header))
+ ((consp header)
+ ;; On the form (Header . function)
+ (car header))
+ (t
+ ;; Just a Header.
+ header)))
+ (when (and (not (memq header-name excluded-headers))
+ (or (eq included-headers t)
+ (memq header-name included-headers)))
+ (push header result)))
+ (nreverse result)))
+
(defun message-setup-1 (headers &optional replybuffer actions)
(dolist (action actions)
(condition-case nil
(or (bolp) (insert ?\n)))
(when message-generate-headers-first
(message-generate-headers
- (delq 'Lines
- (delq 'Subject
- (copy-sequence message-required-news-headers))))))
+ (message-headers-to-generate
+ (append message-required-news-headers
+ message-required-headers)
+ message-generate-headers-first
+ '(Lines Subject)))))
(when (message-mail-p)
(when message-default-mail-headers
(insert message-default-mail-headers)
(or (bolp) (insert ?\n)))
(when message-generate-headers-first
(message-generate-headers
- (delq 'Lines
- (delq 'Subject
- (copy-sequence message-required-mail-headers))))))
+ (message-headers-to-generate
+ (append message-required-mail-headers
+ message-required-headers)
+ message-generate-headers-first
+ '(Lines Subject)))))
(run-hooks 'message-signature-setup-hook)
(message-insert-signature)
(save-restriction
(message-narrow-to-headers)
- (if message-alternative-emails
+ (if (and replybuffer
+ message-alternative-emails)
(message-use-alternative-email-as-from))
(run-hooks 'message-header-setup-hook))
(set-buffer-modified-p nil)
(when message-auto-save-directory
(unless (file-directory-p
(directory-file-name message-auto-save-directory))
- (gnus-make-directory message-auto-save-directory))
+ (make-directory message-auto-save-directory t))
(if (gnus-alive-p)
(setq message-draft-article
(nndraft-request-associate-buffer "drafts"))
(message-setup `((Newsgroups . ,(or newsgroups ""))
(Subject . ,(or subject ""))))))
-(defun message-get-reply-headers (wide &optional to-address)
+(defun message-get-reply-headers (wide &optional to-address address-headers)
(let (follow-to mct never-mct to cc author mft recipients)
;; Find all relevant headers we need.
(let ((mrt (when message-use-mail-reply-to
(cond
((not wide)
(setq recipients (concat ", " author)))
+ (address-headers
+ (dolist (header address-headers)
+ (let ((value (message-fetch-field header)))
+ (when value
+ (setq recipients (concat recipients ", " value))))))
((and mft
(string-match "[^ \t,]" mft)
(or (not (eq message-use-mail-followup-to 'ask))
(message-setup
`((Subject . ,subject)
- ,@follow-to
- ,@(if (or references message-id)
- `((References . ,(concat (or references "") (and references " ")
- (or message-id ""))))
- nil))
+ ,@follow-to)
cur)))
;;;###autoload
(message-pop-to-buffer (message-buffer-name "followup" from newsgroups))
+ (setq message-reply-headers
+ (make-full-mail-header-from-decoded-header
+ 0 subject from date message-id references 0 0 ""))
+
(message-setup
`((Subject . ,subject)
,@follow-to
,@(and mct (list (cons 'Cc mct)))
- ,@(and distribution (list (cons 'Distribution distribution)))
- ,@(if (or references message-id)
- `((References . ,(concat (or references "") (and references " ")
- (or message-id ""))))))
- cur)
-
- (setq message-reply-headers
- (make-full-mail-header-from-decoded-header
- 0 subject from date message-id references 0 0 ""))))
+ ,@(and distribution (list (cons 'Distribution distribution))))
+ cur)))
;;;###autoload
(defun message-cancel-news (&optional arg)
(defvar tool-bar-map)
(defvar tool-bar-mode))
+(defun message-tool-bar-local-item-from-menu (command icon in-map &optional from-map &rest props)
+ ;; We need to make tool bar entries in local keymaps with
+ ;; `tool-bar-local-item-from-menu' in Emacs > 21.3
+ (if (fboundp 'tool-bar-local-item-from-menu)
+ ;; This is for Emacs 21.3
+ (tool-bar-local-item-from-menu command icon in-map from-map props)
+ (tool-bar-add-item-from-menu command icon from-map props)))
+
(defun message-tool-bar-map ()
(or message-tool-bar-map
(setq message-tool-bar-map
(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
- 'mime-edit-insert-file "attach" message-mode-map)
- (tool-bar-add-item-from-menu
- 'ispell-message "spell" message-mode-map)
- (tool-bar-add-item-from-menu
+ (message-tool-bar-local-item-from-menu
+ 'message-send-and-exit "mail_send" tool-bar-map message-mode-map)
+ (message-tool-bar-local-item-from-menu
+ 'message-kill-buffer "close" tool-bar-map message-mode-map)
+ (message-tool-bar-local-item-from-menu
+ 'message-dont-send "cancel" tool-bar-map message-mode-map)
+;; (message-tool-bar-local-item-from-menu
+;; 'mime-edit-insert-file "attach"
+;; tool-bar-map mime-edit-mode-map)
+ (message-tool-bar-local-item-from-menu
+ 'ispell-message "spell" tool-bar-map message-mode-map)
+;; (message-tool-bar-local-item-from-menu
+;; 'mime-edit-preview-message "preview"
+;; tool-bar-map mime-edit-mode-map)
+ (message-tool-bar-local-item-from-menu
'message-insert-importance-high "important"
- message-mode-map)
- (tool-bar-add-item-from-menu
+ tool-bar-map message-mode-map)
+ (message-tool-bar-local-item-from-menu
'message-insert-importance-low "unimportant"
- message-mode-map)
- (tool-bar-add-item-from-menu
+ tool-bar-map message-mode-map)
+ (message-tool-bar-local-item-from-menu
'message-insert-disposition-notification-to "receipt"
- message-mode-map)
+ tool-bar-map message-mode-map)
tool-bar-map)))))
;;; Group name completion.
(defcustom message-completion-alist
(list (cons message-newgroups-header-regexp 'message-expand-group)
'("^\\(Resent-\\)?\\(To\\|B?Cc\\):" . message-expand-name)
- '("^\\(Reply-To\\|From\\|Disposition-Notification-To\\|Return-Receipt-To\\):"
+ '("^\\(Reply-To\\|From\\|Mail-Followup-To\\|Mail-Copies-To\\):"
+ . message-expand-name)
+ '("^\\(Disposition-Notification-To\\|Return-Receipt-To\\):"
. message-expand-name))
"Alist of (RE . FUN). Use FUN for completion on header lines matching RE."
:group 'message