: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-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,
(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*")
(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)
["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
["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]
["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]
+ ["Crosspost / Followup-To..." message-xpost-fup2 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."
(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
(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))
(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.
(setq to (message-fetch-field "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
+ (vector 0 subject from date message-id references 0 0 ""))
+
(message-setup
`((Subject . ,subject)
,@(cond
(t
`((Newsgroups . ,newsgroups))))
,@(and distribution (list (cons 'Distribution distribution)))
- ,@(if (or references message-id)
- `((References . ,(concat (or references "") (and references " ")
- (or message-id "")))))
,@(when (and mct
(not (or (equal (downcase mct) "never")
(equal (downcase mct) "nobody"))))
(or mrt reply-to from "")
mct)))))
- cur)
-
- (setq message-reply-headers
- (vector 0 subject from date message-id references 0 0 ""))))
+ cur)))
;;;###autoload
projects / gnus / blobdiff