X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fmessage.el;h=60e6ed9418fc362e76ec9f5fc18110d2d8720a4e;hb=224da95810808ee8b6512e24d092afeba0ffb54a;hp=ad8172826cb9b6a86eeba55f299b3d1b343ec9d8;hpb=b14ba71ca00ad909b738bad1898f1908c0e6d2eb;p=elisp%2Fgnus.git- diff --git a/lisp/message.el b/lisp/message.el index ad81728..60e6ed9 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -5,6 +5,8 @@ ;; MORIOKA Tomohiko ;; Shuhei KOBAYASHI ;; Keiichi Suzuki +;; Tatsuya Ichikawa +;; Katsumi Yamaoka ;; Keywords: mail, news, MIME ;; This file is part of GNU Emacs. @@ -46,6 +48,14 @@ (require 'mailabbrev)) (require 'mime-edit) +;; Avoid byte-compile warnings. +(eval-when-compile + (require 'mail-parse) + (require 'mm-bodies) + (require 'mm-encode) + (require 'mml) + ) + (defgroup message '((user-mail-address custom-variable) (user-full-name custom-variable)) "Mail and news message composing." @@ -137,6 +147,11 @@ mailbox format." :group 'message-sending :type 'function) +(defcustom message-8bit-encoding-list '(8bit binary) + "*8bit encoding type in Content-Transfer-Encoding field." + :group 'message-sending + :type '(repeat (symbol :tag "Type"))) + (defcustom message-courtesy-message "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. @@ -151,6 +166,11 @@ If this variable is nil, no such courtesy message will be added." :group 'message-interface :type 'regexp) +(defcustom message-bounce-setup-function 'message-bounce-setup-for-mime-edit + "Function to setup a re-sending bounced message." + :group 'message-sending + :type 'function) + ;;;###autoload (defcustom message-from-style 'default "*Specifies how \"From\" headers look. @@ -296,14 +316,15 @@ nil means let mailer mail back a message to report errors." :group 'message-mail :type 'boolean) -(defcustom message-generate-new-buffers t +(defcustom message-generate-new-buffers 'unique "*Non-nil means that a new message buffer will be created whenever `message-setup' is called. If this is a function, call that function with three parameters: The type, the to address and the group name. (Any of these may be nil.) The function should return the new buffer name." :group 'message-buffers :type '(choice (const :tag "off" nil) - (const :tag "on" t) + (const :tag "unique" unique) + (const :tag "unsuniqueent" unsent) (function fun))) (defcustom message-kill-buffer-on-exit nil @@ -383,7 +404,7 @@ The provided functions are: :group 'message-forwarding :type 'boolean) -(defcustom message-ignored-resent-headers "^Return-Receipt" +(defcustom message-ignored-resent-headers "^Return-receipt\\|^X-Gnus" "*All headers that match this regexp will be deleted when resending a message." :group 'message-interface :type 'regexp) @@ -554,6 +575,12 @@ the signature is inserted." :group 'message-various :type 'hook) +(defcustom message-bounce-setup-hook nil + "Normal hook, run each time a a re-sending bounced message is initialized. +The function `message-bounce' runs this hook." + :group 'message-various + :type 'hook) + (defcustom message-mode-hook nil "Hook run in message mode buffers." :group 'message-various @@ -752,19 +779,28 @@ the prefix.") The default is `abbrev', which uses mailabbrev. nil switches mail aliases off.") -(defcustom message-autosave-directory +(defcustom message-auto-save-directory (nnheader-concat message-directory "drafts/") - "*Directory where Message autosaves buffers if Gnus isn't running. -If nil, Message won't autosave." + "*Directory where Message auto-saves buffers if Gnus isn't running. +If nil, Message won't auto-save." :group 'message-buffers :type 'directory) +(defcustom message-buffer-naming-style 'unique + "*The way new message buffers are named. +Valid valued are `unique' and `unsent'." + :group 'message-buffers + :type '(choice (const :tag "unique" unique) + (const :tag "unsent" unsent))) + ;;; Internal variables. ;;; Well, not really internal. (defvar message-mode-syntax-table (let ((table (copy-syntax-table text-mode-syntax-table))) (modify-syntax-entry ?% ". " table) + (modify-syntax-entry ?> ". " table) + (modify-syntax-entry ?< ". " table) table) "Syntax table used while in Message mode.") @@ -976,6 +1012,7 @@ The cdr of ech entry is a function for applying the face to a region.") (defvar message-this-is-news nil) (defvar message-this-is-mail nil) (defvar message-draft-article nil) +(defvar message-mime-part nil) ;; Byte-compiler warning (defvar gnus-active-hashtb) @@ -1060,7 +1097,6 @@ The cdr of ech entry is a function for applying the face to a region.") (Lines) (Expires) (Message-ID) - ;; (References . message-shorten-references) (References . message-fill-header) (User-Agent)) "Alist used for formatting headers.") @@ -1120,12 +1156,12 @@ The cdr of ech entry is a function for applying the face to a region.") (not paren)))) (push (buffer-substring beg (point)) elems) (setq beg (match-end 0))) - ((= (following-char) ?\") + ((eq (char-after) ?\") (setq quoted (not quoted))) - ((and (= (following-char) ?\() + ((and (eq (char-after) ?\() (not quoted)) (setq paren t)) - ((and (= (following-char) ?\)) + ((and (eq (char-after) ?\)) (not quoted)) (setq paren nil)))) (nreverse elems))))) @@ -1366,7 +1402,8 @@ Point is left at the beginning of the narrowed-to region." (defvar message-mode-map nil) (unless message-mode-map - (setq message-mode-map (copy-keymap text-mode-map)) + (setq message-mode-map (make-keymap)) + (set-keymap-parent message-mode-map text-mode-map) (define-key message-mode-map "\C-c?" 'describe-mode) (define-key message-mode-map "\C-c\C-f\C-t" 'message-goto-to) @@ -1407,6 +1444,7 @@ Point is left at the beginning of the narrowed-to region." (define-key message-mode-map "\t" 'message-tab) + (define-key message-mode-map "\C-x\C-s" 'message-save-drafts) (define-key message-mode-map "\C-xk" 'message-kill-buffer)) (easy-menu-define @@ -1474,12 +1512,12 @@ 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-e message-elide-region (elide the text between point and mark). +C-c C-v message-delete-not-region (remove the text outside the region). C-c C-z message-kill-to-signature (kill the text up to the signature). C-c C-r message-caesar-buffer-body (rot13 the message body)." (interactive) (kill-all-local-variables) - (make-local-variable 'message-reply-buffer) - (setq message-reply-buffer nil) + (set (make-local-variable 'message-reply-buffer) nil) (make-local-variable 'message-send-actions) (make-local-variable 'message-exit-actions) (make-local-variable 'message-kill-actions) @@ -1520,10 +1558,8 @@ C-c C-r message-caesar-buffer-body (rot13 the message body)." (setq message-reply-headers nil) (make-local-variable 'message-user-agent) (make-local-variable 'message-post-method) - (make-local-variable 'message-sent-message-via) - (setq message-sent-message-via nil) - (make-local-variable 'message-checksum) - (setq message-checksum nil) + (set (make-local-variable 'message-sent-message-via) nil) + (set (make-local-variable 'message-checksum) nil) (make-local-variable 'message-parameter-alist) (setq message-parameter-alist (copy-sequence message-startup-parameter-alist)) @@ -1666,7 +1702,8 @@ With the prefix argument FORCE, insert the header anyway." (let ((co (message-fetch-reply-field "mail-copies-to"))) (when (and (null force) co - (equal (downcase co) "never")) + (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") @@ -1962,6 +1999,11 @@ prefix, and don't delete any headers." (if (listp message-indent-citation-function) message-indent-citation-function (list message-indent-citation-function))))) + (goto-char start) + ;; Quote parts. + (while (re-search-forward "<#/?!*\\(multi\\|part\\)>" end t) + (goto-char (match-beginning 1)) + (insert "!")) (goto-char end) (when (re-search-backward "^-- $" start t) ;; Also peel off any blank lines before the signature. @@ -1985,12 +2027,18 @@ prefix, and don't delete any headers." mail-citation-hook) (run-hooks 'mail-citation-hook) (let ((start (point)) + (end (mark t)) (functions (when message-indent-citation-function (if (listp message-indent-citation-function) message-indent-citation-function (list message-indent-citation-function))))) (goto-char start) + ;; Quote parts. + (while (re-search-forward "<#/?!*\\(multi\\|part\\)>" end t) + (goto-char (match-beginning 1)) + (insert "!")) + (goto-char start) (while functions (funcall (pop functions))) (when message-citation-line-function @@ -2201,6 +2249,15 @@ the user from the mailer." "Send the current message via news." (message-send-news arg)) +(defmacro message-check (type &rest forms) + "Eval FORMS if TYPE is to be checked." + `(or (message-check-element ,type) + (save-excursion + ,@forms))) + +(put 'message-check 'lisp-indent-function 1) +(put 'message-check 'edebug-form-spec '(form body)) + (defun message-fix-before-sending () "Do various things to make the message nice before sending it." ;; Make sure there's a newline at the end of the message. @@ -2235,11 +2292,56 @@ the user from the mailer." (eval (car actions))))) (pop actions))) +(defsubst message-maybe-split-and-send-mail () + "Split a message if necessary, and send it via mail. +Returns nil if sending succeeded, returns any string if sending failed. +This sub function is for exclusive use of `message-send-mail'." + (let ((mime-edit-split-ignored-field-regexp + mime-edit-split-ignored-field-regexp) + (case-fold-search t) + failure) + (while (string-match "Message-ID" mime-edit-split-ignored-field-regexp) + (setq mime-edit-split-ignored-field-regexp + (concat (substring mime-edit-split-ignored-field-regexp + 0 (match-beginning 0)) + "Hey_MIME-Edit,_there_is_an_inviolable_Message_ID" + "_so_don't_rape_it!" + (substring mime-edit-split-ignored-field-regexp + (match-end 0))))) + (setq failure + (or + (catch 'message-sending-mail-failure + (mime-edit-maybe-split-and-send + (function + (lambda () + (interactive) + (save-restriction + (std11-narrow-to-header mail-header-separator) + (goto-char (point-min)) + (when (re-search-forward "^Message-ID:" nil t) + (delete-region (match-end 0) (std11-field-end)) + (insert " " (message-make-message-id)))) + (condition-case err + (funcall message-send-mail-function) + (error + (throw 'message-sending-mail-failure err)))))) + nil) + (condition-case err + (progn + (funcall message-send-mail-function) + nil) + (error err)))) + (when failure + (if (eq 'error (car failure)) + (cadr failure) + (prin1-to-string failure))))) + (defun message-send-mail (&optional arg) (require 'mail-utils) (let ((tembuf (message-generate-new-buffer-clone-locals " message temp")) (case-fold-search nil) - (news (message-news-p))) + (news (message-news-p)) + failure) (save-restriction (message-narrow-to-headers) ;; Insert some headers. @@ -2248,58 +2350,47 @@ the user from the mailer." (message-generate-headers message-required-mail-headers)) ;; Let the user do all of the above. (run-hooks 'message-header-hook)) - (unwind-protect - (save-excursion - (set-buffer tembuf) - (erase-buffer) - (insert-buffer message-encoding-buffer) - ;; Remove some headers. - (save-restriction - (message-narrow-to-headers) + (if (not (message-check-mail-syntax)) + (progn + (message "") + nil) + (unwind-protect + (save-excursion + (set-buffer tembuf) + (erase-buffer) + (insert-buffer message-encoding-buffer) ;; Remove some headers. - (message-remove-header message-ignored-mail-headers t)) - (goto-char (point-max)) - ;; require one newline at the end. - (or (= (preceding-char) ?\n) - (insert ?\n)) - (when (and news - (or (message-fetch-field "cc") - (message-fetch-field "to"))) - (message-insert-courtesy-copy)) -;; (mime-edit-maybe-split-and-send -;; (function -;; (lambda () -;; (interactive) -;; (funcall message-send-mail-function) -;; ))) - (mime-edit-maybe-split-and-send - (function - (lambda () - (interactive) - (save-restriction - (std11-narrow-to-header mail-header-separator) - (goto-char (point-min)) - (when (re-search-forward "^Message-Id:" nil t) - (delete-region (match-end 0)(std11-field-end)) - (insert (concat " " (message-make-message-id))) - )) - (funcall message-send-mail-function)))) - (funcall message-send-mail-function)) - (kill-buffer tembuf)) - (set-buffer message-edit-buffer) - (push 'mail message-sent-message-via))) + (save-restriction + (message-narrow-to-headers) + ;; Remove some headers. + (message-remove-header message-ignored-mail-headers t)) + (goto-char (point-max)) + ;; require one newline at the end. + (or (= (preceding-char) ?\n) + (insert ?\n)) + (when (and news + (or (message-fetch-field "cc") + (message-fetch-field "to"))) + (message-insert-courtesy-copy)) + (setq failure (message-maybe-split-and-send-mail))) + (kill-buffer tembuf)) + (set-buffer message-edit-buffer) + (if failure + (progn + (message "Couldn't send message via mail: %s" failure) + nil) + (push 'mail message-sent-message-via))))) (defun message-send-mail-with-sendmail () "Send off the prepared buffer with sendmail." (let ((errbuf (if message-interactive (generate-new-buffer " sendmail errors") 0)) - resend-addresses delimline) + resend-to-addresses delimline) (let ((case-fold-search t)) (save-restriction (message-narrow-to-headers) - ;; XXX: We need to handle Resent-CC/Resent-BCC, too. - (setq resend-addresses (message-fetch-field "resent-to"))) + (setq resend-to-addresses (message-fetch-field "resent-to"))) ;; Change header-delimiter to be what sendmail expects. (goto-char (point-min)) (re-search-forward @@ -2339,8 +2430,8 @@ the user from the mailer." ;; We must not do that for a resend ;; because we would find the original addresses. ;; For a resend, include the specific addresses. - (if resend-addresses - (list resend-addresses) + (if resend-to-addresses + (list resend-to-addresses) '("-t"))))) (when message-interactive (save-excursion @@ -2358,7 +2449,7 @@ the user from the mailer." "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. + ;; replace the header delimiter with a blank line (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n")) @@ -2443,6 +2534,38 @@ to find out how to use this." (error "Sending failed; " result))) (error "Sending failed; no recipients")))) +(defsubst message-maybe-split-and-send-news (method) + "Split a message if necessary, and send it via news. +Returns nil if sending succeeded, returns t if sending failed. +This sub function is for exclusive use of `message-send-news'." + (let ((mime-edit-split-ignored-field-regexp + mime-edit-split-ignored-field-regexp) + (case-fold-search t)) + (while (string-match "Message-ID" mime-edit-split-ignored-field-regexp) + (setq mime-edit-split-ignored-field-regexp + (concat (substring mime-edit-split-ignored-field-regexp + 0 (match-beginning 0)) + "Hey_MIME-Edit,_there_is_an_inviolable_Message_ID" + "_so_don't_rape_it!" + (substring mime-edit-split-ignored-field-regexp + (match-end 0))))) + (or + (catch 'message-sending-news-failure + (mime-edit-maybe-split-and-send + (function + (lambda () + (interactive) + (save-restriction + (std11-narrow-to-header mail-header-separator) + (goto-char (point-min)) + (when (re-search-forward "^Message-ID:" nil t) + (delete-region (match-end 0) (std11-field-end)) + (insert " " (message-make-message-id)))) + (unless (funcall message-send-news-function method) + (throw 'message-sending-news-failure t))))) + nil) + (not (funcall message-send-news-function method))))) + (defun message-send-news (&optional arg) (let ((tembuf (message-generate-new-buffer-clone-locals " *message temp*")) (case-fold-search nil) @@ -2479,27 +2602,15 @@ to find out how to use this." ;; require one newline at the end. (or (= (preceding-char) ?\n) (insert ?\n)) - (mime-edit-maybe-split-and-send - (function - (lambda () - (interactive) - (save-restriction - (std11-narrow-to-header mail-header-separator) - (goto-char (point-min)) - (when (re-search-forward "^Message-Id:" nil t) - (delete-region (match-end 0)(std11-field-end)) - (insert (concat " " (message-make-message-id))) - )) - (funcall message-send-news-function method) - ))) - (setq result (funcall message-send-news-function method))) + (setq result (message-maybe-split-and-send-news method))) (kill-buffer tembuf)) (set-buffer message-edit-buffer) (if result - (push 'news message-sent-message-via) - (message "Couldn't send message via news: %s" - (nnheader-get-report (car method))) - nil)))) + (progn + (message "Couldn't send message via news: %s" + (nnheader-get-report (car method))) + nil) + (push 'news message-sent-message-via))))) ;; 1997-09-29 by MORIOKA Tomohiko (defun message-send-news-with-gnus (method) @@ -2525,15 +2636,6 @@ to find out how to use this." ;;; Header generation & syntax checking. ;;; -(defmacro message-check (type &rest forms) - "Eval FORMS if TYPE is to be checked." - `(or (message-check-element ,type) - (save-excursion - ,@forms))) - -(put 'message-check 'lisp-indent-function 1) -(put 'message-check 'edebug-form-spec '(form body)) - (defun message-check-element (type) "Returns non-nil if this type is not to be checked." (if (eq message-syntax-checks 'dont-check-for-anything-just-trust-me) @@ -2772,6 +2874,9 @@ to find out how to use this." (y-or-n-p "The article contains control characters. Really post? ") t)) + ;; Check 8bit characters. + (message-check '8bit + (message-check-8bit)) ;; Check excessive size. (message-check 'size (if (> (buffer-size) 60000) @@ -2799,6 +2904,54 @@ to find out how to use this." (1- (count-lines (point) (point-max))))) t))))) +(defun message-check-mail-syntax () + "Check the syntax of the message." + (save-excursion + (save-restriction + (widen) + (and + ;; We narrow to the headers and check them first. + (save-excursion + (save-restriction + (message-narrow-to-headers) + (message-check-mail-header-syntax))) + ;; Check the body. + (save-excursion + (set-buffer message-edit-buffer) + (message-check-mail-body-syntax)))))) + +(defun message-check-mail-header-syntax () + t) + +(defun message-check-mail-body-syntax () + (and + ;; Check 8bit characters. + (message-check '8bit + (message-check-8bit) + ))) + +(defun message-check-8bit () + "Check the article contains 8bit characters." + (save-excursion + (set-buffer message-encoding-buffer) + (message-narrow-to-headers) + (let* ((case-fold-search t) + (field-value (message-fetch-field "content-transfer-encoding"))) + (if (and field-value + (member (downcase field-value) message-8bit-encoding-list)) + t + (widen) + (set-buffer (get-buffer-create " message syntax")) + (erase-buffer) + (goto-char (point-min)) + (set-buffer-multibyte nil) + (insert-buffer message-encoding-buffer) + (goto-char (point-min)) + (if (re-search-forward "[^\x00-\x7f]" nil t) + (y-or-n-p + "The article contains 8bit characters. Really post? ") + t))))) + (defun message-checksum () "Return a \"checksum\" for the current buffer." (let ((sum 0)) @@ -2809,7 +2962,7 @@ to find out how to use this." (while (not (eobp)) (when (not (looking-at "[ \t\n]")) (setq sum (logxor (ash sum 1) (if (natnump sum) 0 1) - (following-char)))) + (char-after)))) (forward-char 1))) sum)) @@ -2827,7 +2980,6 @@ to find out how to use this." (while (setq file (message-fetch-field "fcc")) (push file list) (message-remove-header "fcc" nil t))) - (run-hooks 'message-header-hook 'message-before-do-fcc-hook) (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (replace-match "" t t) @@ -2850,7 +3002,6 @@ to find out how to use this." (rmail-output file 1 nil t) (let ((mail-use-rfc822 t)) (rmail-output file 1 t t)))))) - (kill-buffer (current-buffer))))) (defun message-output (filename) @@ -2899,13 +3050,17 @@ If NOW, use that time instead." (zone (nth 8 (decode-time now))) (sign "+")) (when (< zone 0) - (setq sign "")) - ;; We do all of this because XEmacs doesn't have the %z spec. - (concat (format-time-string - "%d %b %Y %H:%M:%S " (or now (current-time))) - (format "%s%02d%02d" - sign (/ zone 3600) - (% zone 3600))))) + (setq sign "-") + (setq zone (- zone))) + (concat + (format-time-string "%d" now) + ;; The month name of the %b spec is locale-specific. Pfff. + (format " %s " + (capitalize (car (rassoc (nth 4 (decode-time now)) + parse-time-months)))) + (format-time-string "%Y %H:%M:%S " now) + ;; We do all of this because XEmacs doesn't have the %z spec. + (format "%s%02d%02d" sign (/ zone 3600) (% zone 3600))))) (defun message-make-followup-subject (subject) "Make a followup Subject." @@ -3022,10 +3177,10 @@ If NOW, use that time instead." (let ((pair (std11-extract-address-components from))) (concat "\n (" (or (car pair) (cadr pair)) - "'s message of " + "'s message of \"" (if (or (not date) (string= date "")) "(unknown date)" date) - ")")))))))) + "\")")))))))) (defun message-make-distribution () "Make a Distribution header." @@ -3243,7 +3398,7 @@ Headers already prepared in the buffer are not modified." (progn ;; The header was found. We insert a space after the ;; colon, if there is none. - (if (/= (following-char) ? ) (insert " ") (forward-char 1)) + (if (/= (char-after) ? ) (insert " ") (forward-char 1)) ;; Find out whether the header is empty... (looking-at "[ \t]*$"))) ;; So we find out what value we should insert. @@ -3352,10 +3507,11 @@ Headers already prepared in the buffer are not modified." (goto-char (point-min)) (while (not (eobp)) (skip-chars-forward "^,\"" (point-max)) - (if (or (= (following-char) ?,) + (if (or (eq (char-after) ?,) (eobp)) (when (not quoted) - (if last + (if (and (> (current-column) 78) + last) (save-excursion (goto-char last) (looking-at "[ \t]*") @@ -3422,7 +3578,7 @@ Headers already prepared in the buffer are not modified." (search-backward ":" ) (widen) (forward-char 1) - (if (= (following-char) ? ) + (if (eq (char-after) ? ) (forward-char 1) (insert " "))) (t @@ -3441,7 +3597,7 @@ Headers already prepared in the buffer are not modified." ((message-functionp message-generate-new-buffers) (funcall message-generate-new-buffers type to group)) ;; Generate a new buffer name The Message Way. - (message-generate-new-buffers + ((eq message-generate-new-buffers 'unique) (generate-new-buffer-name (concat "*" type (if to @@ -3451,6 +3607,16 @@ Headers already prepared in the buffer are not modified." "") (if (and group (not (string= group ""))) (concat " on " group) "") "*"))) + ((eq message-generate-new-buffers 'unsent) + (generate-new-buffer-name + (concat "*unsent " type + (if to + (concat " to " + (or (car (mail-extract-address-components to)) + to) "") + "") + (if (and group (not (string= group ""))) (concat " on " group) "") + "*"))) ;; Use standard name. (t (format "*%s message*" type)))) @@ -3506,7 +3672,7 @@ Headers already prepared in the buffer are not modified." ;; Rename the buffer. (if message-send-rename-function (funcall message-send-rename-function) - (when (string-match "\\`\\*" (buffer-name)) + (when (string-match "\\`\\*\\(unsent \\)?" (buffer-name)) (rename-buffer (concat "*sent " (substring (buffer-name) (match-end 0))) t))) ;; Push the current buffer onto the list. @@ -3515,7 +3681,6 @@ Headers already prepared in the buffer are not modified." (nconc message-buffer-list (list (current-buffer)))))) (defvar mc-modes-alist) -(defvar message-get-reply-buffer-function nil) (defun message-setup (headers &optional replybuffer actions) (when (and (boundp 'mc-modes-alist) (not (assq 'message-mode mc-modes-alist))) @@ -3580,12 +3745,12 @@ Headers already prepared in the buffer are not modified." (defun message-set-auto-save-file-name () "Associate the message buffer with a file in the drafts directory." - (when message-autosave-directory + (when message-auto-save-directory (if (gnus-alive-p) (setq message-draft-article (nndraft-request-associate-buffer "drafts")) (setq buffer-file-name (expand-file-name "*message*" - message-autosave-directory)) + message-auto-save-directory)) (setq buffer-auto-save-file-name (make-auto-save-file-name))) (clear-visited-file-modtime))) @@ -3629,10 +3794,10 @@ OTHER-HEADERS is an alist of header/value pairs." "Start editing a reply to the article in the current buffer." (interactive) (let ((cur (current-buffer)) + from subject date to cc + references message-id follow-to (inhibit-point-motion-hooks t) - from date subject mct mft mrt - never-mct to cc - references message-id follow-to gnus-warning) + mct never-mct mft mrt gnus-warning) (save-restriction (message-narrow-to-head) ;; Allow customizations to have their say. @@ -3671,7 +3836,8 @@ OTHER-HEADERS is an alist of header/value pairs." ;; Handle special values of Mail-Copies-To. (when mct (cond - ((and (equal (downcase mct) "never") + ((and (or (equal (downcase mct) "never") + (equal (downcase mct) "nobody")) (or (not (eq message-use-mail-copies-to 'ask)) (message-y-or-n-p (concat "Obey Mail-Copies-To: never? ") t "\ @@ -3681,7 +3847,8 @@ You should normally obey the Mail-Copies-To: header. directs you not to send your response to the author."))) (setq never-mct t) (setq mct nil)) - ((and (equal (downcase mct) "always") + ((and (or (equal (downcase mct) "always") + (equal (downcase mct) "poster")) (or (not (eq message-use-mail-copies-to 'ask)) (message-y-or-n-p (concat "Obey Mail-Copies-To: always? ") t "\ @@ -3767,7 +3934,8 @@ that further discussion should take place only in " (if wide to-address nil))) (setq message-reply-headers - (vector 0 subject from date message-id references 0 0 "")) + (make-full-mail-header-from-decoded-header + 0 subject from date message-id references 0 0 "")) (message-setup `((Subject . ,subject) @@ -3785,22 +3953,20 @@ that further discussion should take place only in " ;;;###autoload (defun message-followup (&optional to-newsgroups) - "Follow up to the message in the current buffer." + "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 mct + references message-id follow-to (inhibit-point-motion-hooks t) - from date subject mct mft mrt (message-this-is-news t) - followup-to distribution newsgroups posted-to - references message-id follow-to gnus-warning) + followup-to distribution newsgroups gnus-warning posted-to mft mrt) (save-restriction (message-narrow-to-head) - ;; Allow customizations to have their say. - ;; This is a followup. (when (message-functionp message-followup-to-function) (setq follow-to (funcall message-followup-to-function))) - ;; Find all relevant headers we need. (setq from (message-fetch-field "from") date (message-fetch-field "date" t) subject (or (message-fetch-field "subject") "none") @@ -3834,7 +4000,8 @@ that further discussion should take place only in " ;; Handle special values of Mail-Copies-To. (when mct (cond - ((and (equal (downcase mct) "never") + ((and (or (equal (downcase mct) "never") + (equal (downcase mct) "nobody")) (or (not (eq message-use-mail-copies-to 'ask)) (message-y-or-n-p (concat "Obey Mail-Copies-To: never? ") t "\ @@ -3843,7 +4010,8 @@ You should normally obey the Mail-Copies-To: header. `Mail-Copies-To: never' directs you not to send your response to the author."))) (setq mct nil)) - ((and (equal (downcase mct) "always") + ((and (or (equal (downcase mct) "always") + (equal (downcase mct) "poster")) (or (not (eq message-use-mail-copies-to 'ask)) (message-y-or-n-p (concat "Obey Mail-Copies-To: always? ") t "\ @@ -3933,7 +4101,8 @@ that further discussion should take place only in " (message-pop-to-buffer (message-buffer-name "followup" from newsgroups)) (setq message-reply-headers - (vector 0 subject from date message-id references 0 0 "")) + (make-full-mail-header-from-decoded-header + 0 subject from date message-id references 0 0 "")) (message-setup `((Subject . ,subject) @@ -4107,10 +4276,12 @@ the message." (let ((funcs message-make-forward-subject-function) (subject (if message-wash-forwarded-subjects (message-wash-subject - (or (eword-decode-unstructured-field-body - (message-fetch-field "Subject")) "")) - (or (eword-decode-unstructured-field-body - (message-fetch-field "Subject")) "")))) + (or (nnheader-decode-subject + (message-fetch-field "Subject")) + "")) + (or (nnheader-decode-subject + (message-fetch-field "Subject")) + "")))) ;; Make sure funcs is a list. (and funcs (not (listp funcs)) @@ -4206,10 +4377,18 @@ Optional NEWS will use news to forward instead of mail." ;; Send it. (let ((message-encoding-buffer (current-buffer)) (message-edit-buffer (current-buffer))) - (message-send-mail)) + (let (message-required-mail-headers) + (message-send-mail))) (kill-buffer (current-buffer))) (message "Resending message to %s...done" address))) +(defun message-bounce-setup-for-mime-edit () + (goto-char (point-min)) + (when (search-forward (concat "\n" mail-header-separator "\n") nil t) + (replace-match "\n\n")) + (set (make-local-variable 'message-setup-hook) nil) + (mime-edit-again)) + ;;;###autoload (defun message-bounce () "Re-mail the current message. @@ -4249,6 +4428,9 @@ you." (message-remove-header message-ignored-bounced-headers t) (goto-char (point-max)) (insert mail-header-separator)) + (when message-bounce-setup-function + (funcall message-bounce-setup-function)) + (run-hooks 'message-bounce-setup-hook) (message-position-point))) ;;; @@ -4326,7 +4508,7 @@ which specify the range to operate on." (goto-char (min start end)) (while (< (point) end1) (or (looking-at "[_\^@- ]") - (insert (following-char) "\b")) + (insert (char-after) "\b")) (forward-char 1))))) ;;;###autoload @@ -4340,7 +4522,7 @@ which specify the range to operate on." (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))) + (if (eq (char-after) (char-after (- (point) 2))) (delete-char -2)))))) (defalias 'message-exchange-point-and-mark 'exchange-point-and-mark) @@ -4465,19 +4647,6 @@ regexp varstr." ;;; @ for MIME Edit mode ;;; -(defun message-maybe-setup-default-charset () - (let ((charset - (and (boundp 'gnus-summary-buffer) - (buffer-live-p gnus-summary-buffer) - (save-excursion - (set-buffer gnus-summary-buffer) - default-mime-charset)))) - (if charset - (progn - (make-local-variable 'default-mime-charset) - (setq default-mime-charset charset) - )))) - (defun message-maybe-encode () (when message-mime-mode (run-hooks 'mime-edit-translate-hook) @@ -4530,34 +4699,54 @@ regexp varstr." ;;; MIME functions ;;; +(defun message-insert-mime-part (file type) + "Insert a multipart/alternative part into the buffer." + (interactive + (let* ((file (read-file-name "Insert file: " nil nil t)) + (type (mm-default-file-encoding file))) + (list file + (completing-read + (format "MIME type for %s: " file) + (mapcar (lambda (m) (list (cdr m))) mailcap-mime-extensions) + nil nil type)))) + (insert (format "<#part type=%s filename=\"%s\"><#/part>\n" + type file))) + (defun message-encode-message-body () - "Examine the message body, encode it, and add the requisite headers." - (when (featurep 'mule) - (let (old-headers) - (save-excursion - (save-restriction - (message-narrow-to-headers-or-head) - (unless (setq old-headers (message-fetch-field "mime-version")) - (message-remove-header - "^Content-Transfer-Encoding:\\|^Content-Type:\\|^Mime-Version:" t)) - (goto-char (point-max)) - (widen) - (narrow-to-region (point) (point-max)) - (let* ((charset (mm-encode-body)) - (encoding (mm-body-encoding))) - (when (consp charset) - (error "Can't encode messages with multiple charsets (yet)")) - (widen) - (message-narrow-to-headers-or-head) - (goto-char (point-max)) - (setq charset (or charset - (mm-mule-charset-to-mime-charset 'ascii))) - ;; We don't insert MIME headers if they only say the default. - (when (and (not old-headers) - (not (and (eq charset 'us-ascii) - (eq encoding '7bit)))) - (mm-insert-rfc822-headers charset encoding)) - (mm-encode-body))))))) + (message-goto-body) + (save-restriction + (narrow-to-region (point) (point-max)) + (let ((new (mml-generate-mime))) + (delete-region (point-min) (point-max)) + (insert new) + (goto-char (point-min)) + (widen) + (forward-line -1) + (let ((beg (point)) + (line (buffer-substring (point) (progn (forward-line 1) (point))))) + (delete-region beg (point)) + (insert "Mime-Version: 1.0\n") + (search-forward "\n\n") + (insert line) + (when (save-excursion + (re-search-backward "^Content-Type: multipart/" nil t)) + (insert "This is a MIME multipart message. If you are reading\n") + (insert "this, you shouldn't.\n\n")))))) + +(defvar message-save-buffer " *encoding") +(defun message-save-drafts () + (interactive) + (if (not (get-buffer message-save-buffer)) + (get-buffer-create message-save-buffer)) + (let ((filename buffer-file-name) + (buffer (current-buffer))) + (set-buffer message-save-buffer) + (erase-buffer) + (insert-buffer buffer) + (mime-edit-translate-buffer) + (write-region (point-min) (point-max) filename) + (set-buffer buffer) + (set-buffer-modified-p nil))) (run-hooks 'message-load-hook)