X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmessage.el;h=ac8e25166bf38527b6425e593d37a7717bfe7a09;hb=a8ee92ba66284aa600ccd866e9a85fcbe35ea116;hp=c79c2f05a4d8d0a12ae1034712d5d5bc2634e9b1;hpb=d73e8a3c99dfa39e6bbddbddbefaf4b818593854;p=gnus diff --git a/lisp/message.el b/lisp/message.el index c79c2f05a..ac8e25166 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -174,7 +174,7 @@ Otherwise, most addresses look like `angles', but they look like :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. @@ -188,13 +188,28 @@ Checks include `subject-cmsg', `multiple-headers', `sendsys', `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, @@ -314,7 +329,7 @@ Archives \(such as groups.googgle.com\) respect this header." ;;;###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) @@ -323,40 +338,40 @@ If nil, don't insert any text in the body." ;; inspired by JoH-followup-to by Jochem Huhman ;; new suggestions by R. Weikusat -(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 - "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) @@ -668,6 +683,8 @@ variable isn't used." "*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 @@ -784,6 +801,12 @@ If nil, don't insert a signature." :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 @@ -941,7 +964,7 @@ 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) @@ -1150,7 +1173,7 @@ candidates: (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." @@ -1178,7 +1201,10 @@ The cdr of ech entry is a function for applying the face to a region.") (defvar message-draft-coding-system mm-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. @@ -1478,14 +1504,21 @@ is used by default." (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*") @@ -1526,13 +1559,13 @@ is used by default." ;;; Start of functions adopted from `message-utils.el'. (defun message-strip-subject-trailing-was (subject) - "Remove trailing \"(Was: )\" from subject lines. + "Remove trailing \"(Was: )\" 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) @@ -1544,7 +1577,7 @@ Leading \"Re: \" is not stripped by this function. Use the function (if (eq query 'ask) (if (message-y-or-n-p "Strip `(was: )' in subject? " t - (concat + (concat "Strip `(was: )' in subject " "and use the new one instead?\n\n" "Current subject is: \"" @@ -1633,7 +1666,7 @@ body, set `message-archive-note' to nil." (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 @@ -1648,19 +1681,19 @@ With prefix-argument just set Follow-Up, don't cross-post." (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")))) @@ -1674,13 +1707,14 @@ With prefix-argument just set Follow-Up, don't cross-post." "[ \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." @@ -1691,25 +1725,25 @@ 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 @@ -1726,7 +1760,7 @@ With prefix-argument just set Follow-Up, don't cross-post." (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) @@ -1738,13 +1772,13 @@ With prefix-argument just set Follow-Up, don't cross-post." "[ \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)))))))) @@ -1878,6 +1912,13 @@ Point is left at the beginning of the narrowed-to region." (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) @@ -1956,18 +1997,19 @@ Point is left at the beginning of the narrowed-to region." ;; 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-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) @@ -2024,15 +2066,15 @@ Point is left at the beginning of the narrowed-to region." ["Request Receipt" message-insert-disposition-notification-to ,@(if (featurep 'xemacs) '(t) - '(:help "Request a Disposition Notification of this article"))] + '(:help "Request a receipt notification"))] ["Spellcheck" ispell-message ,@(if (featurep 'xemacs) '(t) '(:help "Spellcheck this message"))] "----" - ["Insert Region Marked" message-mark-inserted-region + ["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"))] "----" @@ -2042,7 +2084,7 @@ Point is left at the beginning of the narrowed-to region." ["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 @@ -2058,7 +2100,7 @@ Point is left at the beginning of the narrowed-to region." ["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] @@ -2069,8 +2111,8 @@ Point is left at the beginning of the narrowed-to region." ["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 ] "----" @@ -2411,13 +2453,29 @@ With the prefix argument FORCE, insert the header anyway." (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." @@ -2626,7 +2684,9 @@ Prefix arg means justify as well." ;; Insert the signature. (unless (bolp) (insert "\n")) - (insert "\n-- \n") + (when message-signature-insert-empty-line + (insert "\n")) + (insert "-- \n") (if (eq signature t) (insert-file-contents message-signature-file) (insert signature)) @@ -3162,7 +3222,7 @@ It should typically alter the sending method in some way or other." (or (< (mm-char-int char) 128) (and (mm-multibyte-p) (memq (char-charset char) - '(eight-bit-control eight-bit-graphic + '(eight-bit-control eight-bit-graphic control-1))))) (add-text-properties (point) (1+ (point)) '(highlight t)) (setq found t)) @@ -3170,7 +3230,7 @@ It should typically alter the sending method in some way or other." (skip-chars-forward mm-7bit-chars)) (when found (setq choice - (gnus-multiple-choice + (gnus-multiple-choice "Illegible text found. Continue posting? " '((?d "Remove and continue posting") (?r "Replace with dots and continue posting") @@ -3308,10 +3368,7 @@ It should typically alter the sending method in some way or other." (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 @@ -3349,6 +3406,7 @@ It should typically alter the sending method in some way or other." ;; require one newline at the end. (or (= (preceding-char) ?\n) (insert ?\n)) + (message-cleanup-headers) (when (save-restriction (message-narrow-to-headers) @@ -3369,13 +3427,14 @@ It should typically alter the sending method in some way or other." "The message size is too large, split? " t "\ -The message size, " (/ (point-max) 1000) "KB, is too large. +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 + (/ message-send-mail-partially-limit 1000) + "KB except the last one. However, some mail readers (MUA's) can't read split messages, i.e., @@ -3712,6 +3771,20 @@ Otherwise, generate and save a value for `canlock-password' first." (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) @@ -3845,6 +3918,18 @@ Otherwise, generate and save a value for `canlock-password' first." (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) @@ -4243,6 +4328,17 @@ If NOW, use that time instead." (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 @@ -4447,6 +4543,7 @@ not the additional To and Cc header contents)." (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)) @@ -4457,6 +4554,7 @@ Headers already prepared in the buffer are not modified." (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)) @@ -4505,21 +4603,27 @@ Headers already prepared in the buffer are not modified." ;; 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)) @@ -4536,13 +4640,18 @@ Headers already prepared in the buffer are not modified." (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)) @@ -4876,6 +4985,31 @@ than 988 characters long, and if they are not, trim them until they are." 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 @@ -4910,18 +5044,22 @@ than 988 characters long, and if they are not, trim them until they are." (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 @@ -4940,7 +5078,7 @@ than 988 characters long, and if they are not, trim them until they are." (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")) @@ -5016,7 +5154,7 @@ OTHER-HEADERS is an alist of header/value pairs." (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") @@ -5044,6 +5182,11 @@ OTHER-HEADERS is an alist of header/value pairs." (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)) @@ -5184,11 +5327,7 @@ responses here are directed to other addresses."))) (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 @@ -5247,6 +5386,9 @@ If TO-NEWSGROUPS, use that as the new Newsgroups line." (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 @@ -5295,9 +5437,6 @@ responses here are directed to other newsgroups.")) (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")))) @@ -5306,10 +5445,7 @@ responses here are directed to other newsgroups.")) (or mrt reply-to from "") mct))))) - cur) - - (setq message-reply-headers - (vector 0 subject from date message-id references 0 0 "")))) + cur))) ;;;###autoload @@ -5838,10 +5974,18 @@ which specify the range to operate on." (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 - (and + (and (condition-case nil (require 'tool-bar) (error nil)) (fboundp 'tool-bar-add-item-from-menu) tool-bar-mode @@ -5852,25 +5996,25 @@ which specify the range to operate on." (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-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 + 'mml-attach-file "attach" tool-bar-map mml-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 '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. @@ -5884,7 +6028,9 @@ which specify the range to operate on." (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