X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmessage.el;h=988544a9ce39e436d6f56f8e76c728ec4dda0d04;hb=d0498ec691ac9cc3f6bdd9f4ba3ac26457cc3d8a;hp=5f040f98eaf07a9ff47575f26026800df28590b2;hpb=1c329860c2325decc384e8fb32f6f770c1ecd7fd;p=gnus diff --git a/lisp/message.el b/lisp/message.el index 5f040f98e..988544a9c 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -53,13 +53,15 @@ (defvar message-fcc-handler-function 'rmail-output "*A function called to save outgoing articles. This function will be called with the name of the file to store the -article in. The default function is `rmail-output' which saves in Unix +article in. The default function is `rmail-output' which saves in Unix mailbox format.") ;;;###autoload (defvar message-courtesy-message - "The following message is a courtesy copy of an article\nthat has been posted as well.\n\n" + "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. +If the string contains the format spec \"%s\", the Newsgroups +the article has been posted to will be inserted there. If this variable is nil, no such courtesy message will be added.") ;;;###autoload @@ -112,16 +114,16 @@ RFC822 required that From, Date, To, Subject and Message-ID be included. Organization, Lines and X-Mailer are optional.") ;;;###autoload -(defvar message-deletable-headers '(Message-ID Date) +(defvar message-deletable-headers '(Message-ID Date Lines) "*Headers to be deleted if they already exist and were generated by message previously.") ;;;###autoload (defvar message-ignored-news-headers - "^NNTP-Posting-Host:\\|^Xref:\\|^Bcc:\\|^Gcc:\\|^Fcc:" + "^NNTP-Posting-Host:\\|^Xref:\\|^Bcc:\\|^Gcc:\\|^Fcc:\\|^Resent-Fcc:" "*Regexp of headers to be removed unconditionally before posting.") ;;;###autoload -(defvar message-ignored-mail-headers "^Gcc:\\|^Fcc:" +(defvar message-ignored-mail-headers "^Gcc:\\|^Fcc:\\|^Resent-Fcc:" "*Regexp of headers to be removed unconditionally before mailing.") ;;;###autoload @@ -191,7 +193,10 @@ If nil, message won't autosave.") ;;;###autoload (defvar message-ignored-cited-headers "." - "Delete these headers from the messages you yank.") + "*Delete these headers from the messages you yank.") + +(defvar message-cancel-message "I am canceling my own article." + "Message to be inserted in the cancel message.") ;; Useful to set in site-init.el ;;;###autoload @@ -200,8 +205,8 @@ If nil, message won't autosave.") The headers should be delimited by a line whose contents match the variable `mail-header-separator'. -Legal values include `message-send-mail-with-mh' and -`message-send-mail-with-sendmail', which is the default.") +Legal values include `message-send-mail-with-sendmail' (the default), +`message-send-mail-with-mh' and `message-send-mail-with-qmail'.") ;;;###autoload (defvar message-send-news-function 'message-send-news @@ -230,11 +235,23 @@ and respond with new To and Cc headers.") ;;;###autoload (defvar message-use-followup-to 'ask "*Specifies what to do with Followup-To header. -If nil, ignore the header. If it is t, use its value, but query before +If nil, ignore the header. If it is t, use its value, but query before using the \"poster\" value. If it is the symbol `ask', query the user whether to ignore the \"poster\" value. If it is the symbol `use', always use the value.") +;; qmail-related stuff +(defvar message-qmail-inject-program "/var/qmail/bin/qmail-inject" + "Location of the qmail-inject program.") + +(defvar message-qmail-inject-args nil + "Arguments passed to qmail-inject programs. +This should be a list of strings, one string for each argument. + +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\").") + (defvar gnus-post-method) (defvar gnus-select-method) ;;;###autoload @@ -304,7 +321,7 @@ If a form, the result from the form will be used instead.") ;;;###autoload (defvar message-signature-file "~/.signature" - "*File containing the text inserted at end of message. buffer.") + "*File containing the text inserted at end of message buffer.") (defvar message-distribution-function nil "*Function called to return a Distribution header.") @@ -361,8 +378,8 @@ these lines.") (re-search-forward "^OR\\>" nil t))) (kill-buffer buffer)))) ;; According to RFC822, "The field-name must be composed of printable - ;; ASCII characters (i.e. characters that have decimal values between - ;; 33 and 126, except colon)", i.e. any chars except ctl chars, + ;; ASCII characters (i. e., characters that have decimal values between + ;; 33 and 126, except colon)", i. e., any chars except ctl chars, ;; space, or colon. '(looking-at "[ \t]\\|[][!\"#$%&'()*+,-./0-9;<=>?@A-Z\\\\^_`a-z{|}~]+:")) "Set this non-nil if the system's mailer runs the header and body together. @@ -370,12 +387,19 @@ these lines.") The value should be an expression to test whether the problem will actually occur.") +;;; Internal variables. +;;; Well, not really internal. + (defvar message-mode-syntax-table (let ((table (copy-syntax-table text-mode-syntax-table))) (modify-syntax-entry ?% ". " table) table) "Syntax table used while in Message mode.") +(defvar message-mode-abbrev-table text-mode-abbrev-table + "Abbrev table used in Message mode buffers. +Defaults to `text-mode-abbrev-table'.") + (defvar message-font-lock-keywords (let* ((cite-prefix "A-Za-z") (cite-suffix (concat cite-prefix "0-9_.@-"))) (list '("^To:" . font-lock-function-name-face) @@ -388,7 +412,7 @@ actually occur.") "\\([" cite-prefix "]+[" cite-suffix "]*\\)?" "[>|}].*") 'font-lock-reference-face) - '("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\):.*" + '("^\\(X-[A-Za-z0-9-]+\\|In-Reply-To\\):.*" . font-lock-string-face))) "Additional expressions to highlight in Message mode.") @@ -411,6 +435,9 @@ The cdr of ech entry is a function for applying the face to a region.") (defvar message-buffer-list nil) +;; Byte-compiler warning +(defvar gnus-active-hashtb) + ;;; Regexp matching the delimiter of messages in UNIX mail format ;;; (UNIX From lines), minus the initial ^. (defvar message-unix-mail-delimiter @@ -474,7 +501,7 @@ The cdr of ech entry is a function for applying the face to a region.") (Lines) (Expires) (Message-ID) - (References . message-fill-header) + (References) (X-Mailer) (X-Newsreader)) "Alist used for formatting headers.") @@ -505,6 +532,10 @@ The cdr of ech entry is a function for applying the face to a region.") (point) (goto-char p)))) +(defmacro message-y-or-n-p (question show &rest text) + "Ask QUESTION, displaying the rest of the arguments in a temp. buffer if SHOW" + `(message-talkative-question 'y-or-n-p ,question ,show ,@text)) + ;; Delete the current line (and the next N lines.); (defmacro message-delete-line (&optional n) `(delete-region (progn (beginning-of-line) (point)) @@ -516,7 +547,7 @@ The cdr of ech entry is a function for applying the face to a region.") (let ((regexp (format "[%s]+" (or separator ","))) (beg 1) (first t) - quoted elems) + quoted elems paren) (save-excursion (message-set-work-buffer) (insert header) @@ -528,11 +559,18 @@ The cdr of ech entry is a function for applying the face to a region.") (cond ((and (> (point) beg) (or (eobp) (and (looking-at regexp) - (not quoted)))) + (not quoted) + (not paren)))) (push (buffer-substring beg (point)) elems) (setq beg (match-end 0))) ((= (following-char) ?\") - (setq quoted (not quoted))))) + (setq quoted (not quoted))) + ((and (= (following-char) ?\() + (not quoted)) + (setq paren t)) + ((and (= (following-char) ?\)) + (not quoted)) + (setq paren nil)))) (nreverse elems)))) (defun message-fetch-field (header) @@ -659,7 +697,7 @@ Return the number of headers removed." (forward-char -1))) (lambda () (or (get-text-property (point) 'message-rank) - 0)))) + 10000)))) (defun message-sort-headers () "Sort the headers of the current message according to `message-header-format-alist'." @@ -735,7 +773,7 @@ Return the number of headers removed." ["To" message-goto-to t] ["Subject" message-goto-subject t] ["Cc" message-goto-cc t] - ["Reply-to" message-goto-reply-to t] + ["Reply-To" message-goto-reply-to t] ["Summary" message-goto-summary t] ["Keywords" message-goto-keywords t] ["Newsgroups" message-goto-newsgroups t] @@ -779,7 +817,7 @@ C-c C-i message-goto-signature (move to the beginning of the signature). C-c C-w message-insert-signature (insert `message-signature-file' file). C-c C-y message-yank-original (insert current message, if any). C-c C-q message-fill-yanked-message (fill what was yanked). -C-c C-r message-ceasar-buffer-body (rot13 the message body)." +C-c C-r message-caesar-buffer-body (rot13 the message body)." (interactive) (kill-all-local-variables) (make-local-variable 'message-reply-buffer) @@ -790,7 +828,7 @@ C-c C-r message-ceasar-buffer-body (rot13 the message body)." (make-local-variable 'message-postpone-actions) (set-syntax-table message-mode-syntax-table) (use-local-map message-mode-map) - (setq local-abbrev-table text-mode-abbrev-table) + (setq local-abbrev-table message-mode-abbrev-table) (setq major-mode 'message-mode) (setq mode-name "Message") (setq buffer-offer-save t) @@ -825,8 +863,8 @@ C-c C-r message-ceasar-buffer-body (rot13 the message body)." (setq message-sent-message-via nil) (make-local-variable 'message-checksum) (setq message-checksum nil) - (when (fboundp 'mail-hist-define-keys) - (mail-hist-define-keys)) + ;;(when (fboundp 'mail-hist-define-keys) + ;; (mail-hist-define-keys)) (when (string-match "XEmacs\\|Lucid" emacs-version) (message-setup-toolbar)) (easy-menu-add message-mode-menu message-mode-map) @@ -964,10 +1002,7 @@ C-c C-r message-ceasar-buffer-body (rot13 the message body)." (file-exists-p message-signature-file)) signature)))) (when signature -; ;; Remove blank lines at the end of the message. (goto-char (point-max)) -; (skip-chars-backward " \t\n") -; (delete-region (point) (point-max)) ;; Insert the signature. (unless (bolp) (insert "\n")) @@ -1050,7 +1085,9 @@ name, rather than giving an automatic name." (name-default (concat "*message* " mail-trimmed-to)) (name (if enter-string (read-string "New buffer name: " name-default) - name-default))) + name-default)) + (default-directory + (file-name-as-directory message-autosave-directory))) (rename-buffer name t))))) (defun message-fill-yanked-message (&optional justifyp) @@ -1079,7 +1116,19 @@ However, if `message-yank-prefix' is non-nil, insert that prefix on each line." (if (search-forward "\n\n" nil t) (1- (point)) (point))) - (message-remove-header message-ignored-cited-headers t))) + (message-remove-header message-ignored-cited-headers t) + (goto-char (point-max)))) + ;; Delete blank lines at the start of the buffer. + (while (and (point-min) + (eolp)) + (message-delete-line)) + ;; Delete blank lines at the end of the buffer. + (goto-char (point-max)) + (unless (eolp) + (insert "\n")) + (while (and (zerop (forward-line -1)) + (looking-at "$")) + (message-delete-line)) ;; Do the indentation. (if (null message-yank-prefix) (indent-rigidly start (mark t) message-indentation-spaces) @@ -1113,7 +1162,8 @@ prefix, and don't delete any headers." (unless modified (setq message-checksum (cons (message-checksum) (buffer-size))))))) -(defun message-cite-original () +(defun message-cite-original () + "Cite function in the standard Message manner." (let ((start (point)) (functions (when message-indent-citation-function @@ -1167,21 +1217,21 @@ The text will also be indented the normal way." (save-excursion (let ((start (point)) mark) - (if (not (re-search-forward message-signature-separator (mark t) t)) - ;; No signature here, so we just indent the cited text. + (if (not (re-search-forward message-signature-separator (mark t) t)) + ;; No signature here, so we just indent the cited text. + (message-indent-citation) + ;; Find the last non-empty line. + (forward-line -1) + (while (looking-at "[ \t]*$") + (forward-line -1)) + (forward-line 1) + (setq mark (set-marker (make-marker) (point))) + (goto-char start) (message-indent-citation) - ;; Find the last non-empty line. - (forward-line -1) - (while (looking-at "[ \t]*$") - (forward-line -1)) - (forward-line 1) - (setq mark (set-marker (make-marker) (point))) - (goto-char start) - (message-indent-citation) - ;; Enable undoing the deletion. - (undo-boundary) - (delete-region mark (mark t)) - (set-marker mark nil))))) + ;; Enable undoing the deletion. + (undo-boundary) + (delete-region mark (mark t)) + (set-marker mark nil))))) @@ -1206,8 +1256,9 @@ The text will also be indented the normal way." (defun message-dont-send () "Don't send the message you have been editing." (interactive) - (message-bury (current-buffer)) - (message-do-actions message-postpone-actions)) + (let ((actions message-postpone-actions)) + (message-bury (current-buffer)) + (message-do-actions actions))) (defun message-kill-buffer () "Kill the current buffer." @@ -1258,8 +1309,8 @@ the user from the mailer." "Already sent message via mail; resend? ")) (message-send-mail arg)))) (message-do-fcc) - (when (fboundp 'mail-hist-put-headers-into-history) - (mail-hist-put-headers-into-history)) + ;;(when (fboundp 'mail-hist-put-headers-into-history) + ;; (mail-hist-put-headers-into-history)) (run-hooks 'message-sent-hook) (message "Sending...done") ;; If buffer has no file, mark it as unmodified and delete autosave. @@ -1401,6 +1452,47 @@ the user from the mailer." (when (bufferp errbuf) (kill-buffer errbuf))))) +(defun message-send-mail-with-qmail () + "Pass the prepared message buffer to qmail-inject. +Refer to the documentation for the variable `message-send-mail-function' +to find out how to use this." + ;; replace the header delimiter with a blank line + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "\n")) + (replace-match "\n") + ;; send the message + (case + (apply + 'call-process-region 1 (point-max) message-qmail-inject-program + nil nil nil + ;; qmail-inject's default behaviour is to look for addresses on the + ;; command line; if there're none, it scans the headers. + ;; yes, it does The Right Thing w.r.t. Resent-To and it's kin. + ;; + ;; in general, ALL of qmail-inject's defaults are perfect for simply + ;; reading a formatted (i. e., at least a To: or Resent-To header) + ;; message from stdin. + ;; + ;; qmail also has the advantage of not having been raped by + ;; various vendors, so we don't have to allow for that, either -- + ;; compare this with message-send-mail-with-sendmail and weep + ;; for sendmail's lost innocence. + ;; + ;; all this is way cool coz it lets us keep the arguments entirely + ;; 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) + ;; qmail-inject doesn't say anything on it's stdout/stderr, + ;; we have to look at the retval instead + (0 nil) + (1 (error "qmail-inject reported permanent failure.")) + (111 (error "qmail-inject reported transient failure.")) + ;; should never happen + (t (error "qmail-inject reported unknown failure.")))) + + (defun message-send-mail-with-mh () "Send the prepared message buffer with mh." (let ((mh-previous-window-config nil) @@ -1408,10 +1500,17 @@ the user from the mailer." (concat (file-name-as-directory message-autosave-directory) "msg.")))) (setq buffer-file-name name) - (mh-send-letter) - (condition-case () - (delete-file name) - (error nil)))) + ;; MH wants to generate these headers itself. + (let ((headers message-deletable-headers)) + (while headers + (goto-char (point-min)) + ;;(message "Deleting header %s" (car headers)) (sit-for 5) + (and (re-search-forward + (concat "^" (symbol-name (car headers)) ": *") nil t) + (message-delete-line)) + (pop headers))) + ;; Pass it on to mh. + (mh-send-letter))) (defun message-send-news (&optional arg) (let ((tembuf (generate-new-buffer " *message temp*")) @@ -1433,17 +1532,20 @@ the user from the mailer." ;; Let the user do all of the above. (run-hooks 'message-header-hook)) (message-cleanup-headers) - (when (message-check-news-syntax) + (if (not (message-check-news-syntax)) + (progn + (message "Posting nor performed") + nil) (unwind-protect (save-excursion (set-buffer tembuf) (buffer-disable-undo (current-buffer)) (erase-buffer) ;; Avoid copying text props. - (insert (format - "%s" (save-excursion - (set-buffer messbuf) - (buffer-string)))) + (insert (format + "%s" (save-excursion + (set-buffer messbuf) + (buffer-string)))) ;; Remove some headers. (save-restriction (message-narrow-to-headers) @@ -1454,7 +1556,7 @@ the user from the mailer." (or (= (preceding-char) ?\n) (insert ?\n)) (let ((case-fold-search t)) - ;; Remove the delimeter. + ;; Remove the delimiter. (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n")) @@ -1491,7 +1593,7 @@ the user from the mailer." (save-excursion (if (string-match "^cmsg " (message-fetch-field "subject")) (y-or-n-p - "The control code \"cmsg \" is in the subject. Really post? ") + "The control code \"cmsg \" is in the subject. Really post? ") t))) ;; Check for multiple identical headers. (or (message-check-element 'multiple-headers) @@ -1509,14 +1611,14 @@ the user from the mailer." (setq found nil)))) (if found (y-or-n-p - (format "Multiple %s headers. Really post? " found)) + (format "Multiple %s headers. Really post? " found)) t)))) ;; Check for Version and Sendsys. (or (message-check-element 'sendsys) (save-excursion (if (re-search-forward "^Sendsys:\\|^Version:" nil t) (y-or-n-p - (format "The article contains a %s command. Really post? " + (format "The article contains a %s command. Really post? " (buffer-substring (match-beginning 0) (1- (match-end 0))))) t))) @@ -1553,9 +1655,9 @@ the user from the mailer." (save-excursion (if (re-search-forward "^Approved:" nil t) (y-or-n-p - "The article contains an Approved header. Really post? ") + "The article contains an Approved header. Really post? ") t))) - ;; Check the Message-Id header. + ;; Check the Message-ID header. (or (message-check-element 'message-id) (save-excursion (let* ((case-fold-search t) @@ -1565,7 +1667,7 @@ the user from the mailer." (string-match "@[^\\.]*\\." message-id)) (y-or-n-p (format - "The Message-ID looks strange: \"%s\". Really post? " + "The Message-ID looks strange: \"%s\". Really post? " message-id)))))) ;; Check the Subject header. (or @@ -1619,7 +1721,7 @@ the user from the mailer." (if (or (not (string-match - "\\`\\([-+_&.a-zA-Z0-9]+\\)?\\(,[-.a-zA-Z0-9]+\\)*\\'" + "\\`\\([-+_&.a-zA-Z0-9]+\\)?\\(,[-+_&.a-zA-Z0-9]+\\)*\\'" header)) (memq nil (mapcar @@ -1680,8 +1782,8 @@ the user from the mailer." (concat "^" (regexp-quote mail-header-separator) "$")) (forward-line 1) (let ((b (point))) - (or (re-search-forward message-signature-separator nil t) - (goto-char (point-max))) + (goto-char (point-max)) + (re-search-backward message-signature-separator nil t) (beginning-of-line) (or (re-search-backward "[^ \n\t]" b t) (y-or-n-p "Empty article. Really post? "))))) @@ -1690,13 +1792,13 @@ the user from the mailer." (save-excursion (if (re-search-forward "[\000-\007\013\015-\037\200-\237]" nil t) (y-or-n-p - "The article contains control characters. Really post? ") + "The article contains control characters. Really post? ") t))) ;; Check excessive size. (or (message-check-element 'size) (if (> (buffer-size) 60000) (y-or-n-p - (format "The article is %d octets long. Really post? " + (format "The article is %d octets long. Really post? " (buffer-size))) t)) ;; Check whether any new text has been added. @@ -1711,14 +1813,14 @@ the user from the mailer." (message-check-element 'signature) (progn (goto-char (point-max)) - (if (or (not (re-search-backward "^-- $" nil t)) + (if (or (not (re-search-backward message-signature-separator nil t)) (search-forward message-forward-end-separator nil t)) t (if (> (count-lines (point) (point-max)) 5) (y-or-n-p (format "Your .sig is %d lines; it should be max 4. Really post? " - (count-lines (point) (point-max)))) + (1- (count-lines (point) (point-max))))) t)))))) (defun message-check-element (type) @@ -1998,7 +2100,7 @@ the user from the mailer." (goto-char fullname-start) (while (re-search-forward "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)" - nil 1) + nil 1) (replace-match "\\1(\\3)" t) (goto-char fullname-start))) (insert ")"))) @@ -2084,7 +2186,7 @@ Headers already prepared in the buffer are not modified." (message-delete-line)) (pop headers))) ;; Go through all the required headers and see if they are in the - ;; articles already. If they are not, or are empty, they are + ;; articles already. If they are not, or are empty, they are ;; inserted automatically - except for Subject, Newsgroups and ;; Distribution. (while headers @@ -2099,7 +2201,7 @@ Headers already prepared in the buffer are not modified." (concat "^" (downcase (symbol-name header)) ":") nil t)) (progn - ;; The header was found. We insert a space after the + ;; The header was found. We insert a space after the ;; colon, if there is none. (if (/= (following-char) ? ) (insert " ") (forward-char 1)) ;; Find out whether the header is empty... @@ -2176,15 +2278,20 @@ Headers already prepared in the buffer are not modified." (defun message-insert-courtesy-copy () "Insert a courtesy message in mail copies of combined messages." - (save-excursion - (save-restriction - (message-narrow-to-headers) - (let ((newsgroups (message-fetch-field "newsgroups"))) - (when newsgroups + (let (newsgroups) + (save-excursion + (save-restriction + (message-narrow-to-headers) + (when (setq newsgroups (message-fetch-field "newsgroups")) (goto-char (point-max)) - (insert "Posted-To: " newsgroups "\n")))) - (forward-line 1) - (insert message-courtesy-message))) + (insert "Posted-To: " newsgroups "\n"))) + (forward-line 1) + (when message-courtesy-message + (cond + ((string-match "%s" message-courtesy-message) + (insert (format message-courtesy-message newsgroups))) + (t + (insert message-courtesy-message))))))) ;;; ;;; Setting up a message buffer @@ -2427,11 +2534,7 @@ Headers already prepared in the buffer are not modified." (inhibit-point-motion-hooks t) mct never-mct gnus-warning) (save-restriction - (narrow-to-region - (goto-char (point-min)) - (if (search-forward "\n\n" nil t) - (1- (point)) - (point-max))) + (message-narrow-to-head) ;; Allow customizations to have their say. (if (not wide) ;; This is a regular reply. @@ -2496,9 +2599,11 @@ Headers already prepared in the buffer are not modified." (setq ccalist (delq (assoc (car (pop s)) s) ccalist))))) (setq follow-to (list (cons 'To (cdr (pop ccalist))))) (when ccalist - (push (cons 'Cc - (mapconcat (lambda (addr) (cdr addr)) ccalist ", ")) - follow-to))))) + (let ((ccs (cons 'Cc (mapconcat + (lambda (addr) (cdr addr)) ccalist ", ")))) + (when (string-match "^ +" (cdr ccs)) + (setcdr ccs (substring (cdr ccs) (match-end 0)))) + (push ccs follow-to)))))) (widen)) (message-pop-to-buffer (message-buffer-name @@ -2519,11 +2624,14 @@ Headers already prepared in the buffer are not modified." ;;;###autoload (defun message-wide-reply (&optional to-address) + "Make a \"wide\" reply to the message in the current buffer." (interactive) (message-reply to-address t)) ;;;###autoload -(defun message-followup () +(defun message-followup (&optional to-newsgroups) + "Follow up to the message in the current buffer. +If TO-NEWSGROUPS, use that as the new Newsgroups line." (interactive) (let ((cur (current-buffer)) from subject date reply-to mct @@ -2568,6 +2676,8 @@ Headers already prepared in the buffer are not modified." (message-setup `((Subject . ,subject) ,@(cond + (to-newsgroups + (list (cons 'Newsgroups to-newsgroups))) (follow-to follow-to) ((and followup-to message-use-followup-to) (list @@ -2600,15 +2710,16 @@ used to direct the following discussion to one newsgroup only, because discussions that are spread over several newsgroup tend to be fragmented and very difficult to follow. -Also, some source/announcment newsgroups are not indented for discussion; +Also, some source/announcement newsgroups are not indented for discussion; responses here are directed to other newsgroups.")) (cons 'Newsgroups followup-to) (cons 'Newsgroups newsgroups)))))) (t `((Newsgroups . ,newsgroups)))) ,@(and distribution (list (cons 'Distribution distribution))) - (References . ,(concat (or references "") (and references " ") - (or message-id ""))) + ,@(if (or references message-id) + `((References . ,(concat (or references "") (and references " ") + (or message-id ""))))) ,@(when (and mct (not (equal (downcase mct) "never"))) (list (cons 'Cc (if (equal (downcase mct) "always") @@ -2654,7 +2765,7 @@ responses here are directed to other newsgroups.")) (concat "Distribution: " distribution "\n") "") mail-header-separator "\n" - "This is a cancel message from " from ".\n") + message-cancel-message) (message "Canceling your article...") (let ((message-syntax-checks 'dont-check-for-anything-just-trust-me)) (funcall message-send-news-function)) @@ -2712,7 +2823,8 @@ header line with the old Message-ID." (defun message-make-forward-subject () "Return a Subject header suitable for the message in the current buffer." - (concat "[" (or (message-fetch-field (if (message-news-p) "newsgroups" "from")) + (concat "[" (or (message-fetch-field + (if (message-news-p) "newsgroups" "from")) "(nowhere)") "] " (or (message-fetch-field "Subject") ""))) @@ -2722,7 +2834,8 @@ header line with the old Message-ID." Optional NEWS will use news to forward instead of mail." (interactive "P") (let ((cur (current-buffer)) - (subject (message-make-forward-subject))) + (subject (message-make-forward-subject)) + art-beg) (if news (message-news nil subject) (message-mail nil subject)) ;; Put point where we want it before inserting the forwarded ;; message. @@ -2736,13 +2849,13 @@ Optional NEWS will use news to forward instead of mail." (narrow-to-region (point) (point)) ;; Insert the separators and the forwarded buffer. (insert message-forward-start-separator) + (setq art-beg (point)) (insert-buffer-substring cur) (goto-char (point-max)) (insert message-forward-end-separator) (set-text-properties (point-min) (point-max) nil) ;; Remove all unwanted headers. - (goto-char (point-min)) - (forward-line 1) + (goto-char art-beg) (narrow-to-region (point) (if (search-forward "\n\n" nil t) (1- (point)) (point))) @@ -2900,13 +3013,13 @@ Called from program, takes two arguments START and END which specify the range to operate on." (interactive "r") (save-excursion - (let ((end1 (make-marker))) - (move-marker end1 (max start end)) - (goto-char (min start end)) - (while (< (point) end1) - (or (looking-at "[_\^@- ]") - (insert (following-char) "\b")) - (forward-char 1))))) + (let ((end1 (make-marker))) + (move-marker end1 (max start end)) + (goto-char (min start end)) + (while (< (point) end1) + (or (looking-at "[_\^@- ]") + (insert (following-char) "\b")) + (forward-char 1))))) ;;;###autoload (defun unbold-region (start end) @@ -2915,12 +3028,12 @@ Called from program, takes two arguments START and END which specify the range to operate on." (interactive "r") (save-excursion - (let ((end1 (make-marker))) - (move-marker end1 (max start end)) - (goto-char (min start end)) - (while (re-search-forward "\b" end1 t) - (if (eq (following-char) (char-after (- (point) 2))) - (delete-char -2)))))) + (let ((end1 (make-marker))) + (move-marker end1 (max start end)) + (goto-char (min start end)) + (while (re-search-forward "\b" end1 t) + (if (eq (following-char) (char-after (- (point) 2))) + (delete-char -2)))))) (defalias 'message-exchange-point-and-mark 'exchange-point-and-mark) @@ -2978,10 +3091,6 @@ Do a `tab-to-tab-stop' if not in those headers." ;;; Help stuff. -(defmacro message-y-or-n-p (question show &rest text) - "Ask QUESTION, displaying the rest of the arguments in a temporary buffer." - `(message-talkative-question 'y-or-n-p ,question ,show ,@text)) - (defun message-talkative-question (ask question show &rest text) "Call FUNCTION with argument QUESTION, displaying the rest of the arguments in a temporary buffer if SHOW. The following arguments may contain lists of values."