:group 'message-news
:type '(repeat sexp)) ; Fixme: improve this
+(defcustom message-required-headers '((optional . References))
+ "*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)
+ "*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)
- (optional . References)
(optional . User-Agent))
"*Headers to be generated or prompted for when posting an article.
RFC977 and RFC1036 require From, Date, Newsgroups, Subject,
(defcustom message-required-mail-headers
'(From Subject Date (optional . In-Reply-To) Message-ID
- (optional . User-Agent)
- (optional . References))
+ (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 and User-Agent are optional."
;; 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 normally 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."
+ "Note to insert before signature to notify of cross-post 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
+(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)
"*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
(insert (car headers) ?\n)))))
(setq headers (cdr headers))))
+(defmacro message-with-reply-buffer (&rest forms)
+ "Evaluate FORMS in the reply buffer, if it exists."
+ `(when (and message-reply-buffer
+ (buffer-name message-reply-buffer))
+ (save-excursion
+ (set-buffer message-reply-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."
- (when (and message-reply-buffer
- (buffer-name message-reply-buffer))
- (save-excursion
- (set-buffer message-reply-buffer)
- (message-fetch-field header))))
+ (message-with-reply-buffer
+ (message-fetch-field header)))
(defun message-set-work-buffer ()
(if (get-buffer " *message work*")
(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)
+(defun message-cross-post-followup-to (target-group)
"Crossposts message and sets Followup-To to TARGET-GROUP.
With prefix-argument just set Follow-Up, don't cross-post."
(interactive
"[ \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 fup2
+ (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)
;; 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\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-p" '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)
["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 ]
"----"
(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."
(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
;; require one newline at the end.
(or (= (preceding-char) ?\n)
(insert ?\n))
+ (message-cleanup-headers)
(when
(save-restriction
(message-narrow-to-headers)
(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))
;; 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))
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
(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
projects / gnus / blobdiff