X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fmessage.el;h=0a32d12f5910859d6973be6b391aa9e596f53650;hb=625b891fc07e1e5fc5f2658176b6c0e3cb244ee0;hp=0c9a0f826f6450b00024ad08094dead9bd9bf8de;hpb=f1978432e2f74cfd77f0ad0db0ce8e99b79003e6;p=elisp%2Fgnus.git- diff --git a/lisp/message.el b/lisp/message.el index 0c9a0f8..0a32d12 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -1,5 +1,5 @@ ;;; message.el --- composing mail and news messages -;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. +;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: mail, news @@ -169,7 +169,8 @@ Don't touch this variable unless you really know what you're doing. Checks include subject-cmsg multiple-headers sendsys message-id from long-lines control-chars size new-text redirected-followup signature approved sender empty empty-headers message-id from subject -shorten-followup-to existing-newsgroups buffer-file-name unchanged." +shorten-followup-to existing-newsgroups buffer-file-name unchanged +newsgroups." :group 'message-news) (defcustom message-required-news-headers @@ -251,7 +252,7 @@ should return the new buffer name." :group 'message-buffers :type '(choice (const :tag "off" nil) (const :tag "unique" unique) - (const :tag "unsuniqueent" unsent) + (const :tag "unsent" unsent) (function fun))) (defcustom message-kill-buffer-on-exit nil @@ -278,30 +279,7 @@ If t, use `message-user-organization-file'." :type 'file :group 'message-headers) -(defcustom message-forward-start-separator - "------- Start of forwarded message -------\n" - "*Delimiter inserted before forwarded messages." - :group 'message-forwarding - :type 'string) - -(defcustom message-forward-end-separator - "------- End of forwarded message -------\n" - "*Delimiter inserted after forwarded messages." - :group 'message-forwarding - :type 'string) - -(defcustom message-signature-before-forwarded-message t - "*If non-nil, put the signature before any included forwarded message." - :group 'message-forwarding - :type 'boolean) - -(defcustom message-included-forward-headers - "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-\\|^Message-ID:\\|^References:\\|^Content-Transfer-Encoding:\\|^Content-Type:\\|^Mime-Version:" - "*Regexp matching headers to be included in forwarded messages." - :group 'message-forwarding - :type 'regexp) - -(defcustom message-make-forward-subject-function +(defcustom message-make-forward-subject-function 'message-forward-subject-author-subject "*A list of functions that are called to generate a subject header for forwarded messages. The subject generated by the previous function is passed into each @@ -322,7 +300,7 @@ The provided functions are: :group 'message-forwarding :type 'boolean) -(defcustom message-ignored-resent-headers "^Return-receipt\\|^X-Gnus" +(defcustom message-ignored-resent-headers "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:" "*All headers that match this regexp will be deleted when resending a message." :group 'message-interface :type 'regexp) @@ -344,7 +322,7 @@ The provided functions are: The headers should be delimited by a line whose contents match the variable `mail-header-separator'. -Legal values include `message-send-mail-with-sendmail' (the default), +Valid values include `message-send-mail-with-sendmail' (the default), `message-send-mail-with-mh', `message-send-mail-with-qmail' and `smtpmail-send-it'." :type '(radio (function-item message-send-mail-with-sendmail) @@ -448,6 +426,11 @@ The function `message-setup' runs this hook." :group 'message-various :type 'hook) +(defcustom message-cancel-hook nil + "Hook run when cancelling articles." + :group 'message-various + :type 'hook) + (defcustom message-signature-setup-hook nil "Normal hook, run each time a new outgoing message is initialized. It is run after the headers have been inserted and before @@ -478,8 +461,7 @@ the signature is inserted." ;;;###autoload (defcustom message-yank-prefix "> " - "*Prefix inserted on the lines of yanked messages. -nil means use indentation." + "*Prefix inserted on the lines of yanked messages." :type 'string :group 'message-insertion) @@ -496,6 +478,7 @@ Predefined functions include `message-cite-original' and `message-cite-original-without-signature'. Note that `message-cite-original' uses `mail-citation-hook' if that is non-nil." :type '(radio (function-item message-cite-original) + (function-item message-cite-original-without-signature) (function-item sc-cite-original) (function :tag "Other")) :group 'message-insertion) @@ -620,11 +603,10 @@ actually occur." ;; Ignore errors in case this is used in Emacs 19. ;; Don't use ignore-errors because this is copied into loaddefs.el. ;;;###autoload -(condition-case nil - (define-mail-user-agent 'message-user-agent - 'message-mail 'message-send-and-exit - 'message-kill-buffer 'message-send-hook) - (error nil)) +(ignore-errors + (define-mail-user-agent 'message-user-agent + 'message-mail 'message-send-and-exit + 'message-kill-buffer 'message-send-hook)) (defvar message-mh-deletable-headers '(Message-ID Date Lines Sender) "If non-nil, delete the deletable headers before feeding to mh.") @@ -662,6 +644,11 @@ Valid valued are `unique' and `unsent'." :type '(choice (const :tag "unique" unique) (const :tag "unsent" unsent))) +(defcustom message-default-charset nil + "Default charset used in non-MULE XEmacsen." + :group 'message + :type 'symbol) + ;;; Internal variables. ;;; Well, not really internal. @@ -789,6 +776,18 @@ Defaults to `text-mode-abbrev-table'.") "Face used for displaying cited text names." :group 'message-faces) +(defface message-mml-face + '((((class color) + (background dark)) + (:foreground "ForestGreen")) + (((class color) + (background light)) + (:foreground "ForestGreen")) + (t + (:bold t))) + "Face used for displaying MML." + :group 'message-faces) + (defvar message-font-lock-keywords (let* ((cite-prefix "A-Za-z") (cite-suffix (concat cite-prefix "0-9_.@-")) @@ -819,7 +818,9 @@ Defaults to `text-mode-abbrev-table'.") (,(concat "^[ \t]*" "\\([" cite-prefix "]+[" cite-suffix "]*\\)?" "[:>|}].*") - (0 'message-cited-text-face)))) + (0 'message-cited-text-face)) + ("<#/?\\(multipart\\|part\\|external\\).*>" + (0 'message-mml-face)))) "Additional expressions to highlight in Message mode.") ;; XEmacs does it like this. For Emacs, we have to set the @@ -859,14 +860,18 @@ The cdr of ech entry is a function for applying the face to a region.") (defvar message-send-coding-system 'binary "Coding system to encode outgoing mail.") +(defvar message-draft-coding-system + mm-auto-save-coding-system + "Coding system to compose mail.") + ;;; Internal variables. -(defvar message-default-charset nil) (defvar message-buffer-list nil) (defvar message-this-is-news nil) (defvar message-this-is-mail nil) (defvar message-draft-article nil) (defvar message-mime-part nil) +(defvar message-posting-charset nil) ;; Byte-compiler warning (defvar gnus-active-hashtb) @@ -1036,7 +1041,8 @@ The cdr of ech entry is a function for applying the face to a region.") (when value (while (string-match "\n[\t ]+" value) (setq value (replace-match " " t t value))) - value))) + ;; We remove all text props.delete-region + (format "%s" value)))) (defun message-narrow-to-field () "Narrow the buffer to the header on the current line." @@ -1125,9 +1131,21 @@ Return the number of headers removed." (forward-line 1) (if (re-search-forward "^[^ \t]" nil t) (goto-char (match-beginning 0)) - (point-max)))) + (goto-char (point-max))))) number)) +(defun message-remove-first-header (header) + "Remove the first instance of HEADER if there is more than one." + (let ((count 0) + (regexp (concat "^" (regexp-quote header) ":"))) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (incf count))) + (while (> count 1) + (message-remove-header header nil t) + (decf count)))) + (defun message-narrow-to-headers () "Narrow the buffer to the head of the message." (widen) @@ -1197,6 +1215,7 @@ Point is left at the beginning of the narrowed-to region." (defun message-sort-headers-1 () "Sort the buffer as headers using `message-rank' text props." (goto-char (point-min)) + (require 'sort) (sort-subr nil 'message-next-header (lambda () @@ -1263,6 +1282,7 @@ Point is left at the beginning of the narrowed-to region." (define-key message-mode-map "\C-c\C-y" 'message-yank-original) (define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message) (define-key message-mode-map "\C-c\C-w" 'message-insert-signature) + (define-key message-mode-map "\C-c\M-h" 'message-insert-headers) (define-key message-mode-map "\C-c\C-r" 'message-caesar-buffer-body) (define-key message-mode-map "\C-c\C-o" 'message-sort-headers) (define-key message-mode-map "\C-c\M-r" 'message-rename-buffer) @@ -1277,7 +1297,7 @@ Point is left at the beginning of the narrowed-to region." (define-key message-mode-map "\C-c\C-z" 'message-kill-to-signature) (define-key message-mode-map "\M-\r" 'message-newline-and-reformat) - (define-key message-mode-map "\C-c\C-a" 'message-insert-mime-part) + (define-key message-mode-map "\C-c\C-a" 'mml-attach-file) (define-key message-mode-map "\t" 'message-tab)) @@ -1296,6 +1316,7 @@ Point is left at the beginning of the narrowed-to region." ["Newline and Reformat" message-newline-and-reformat t] ["Rename buffer" message-rename-buffer t] ["Spellcheck" ispell-message t] + ["Attach file as MIME" mml-attach-file t] "----" ["Send Message" message-send-and-exit t] ["Abort Message" message-dont-send t] @@ -1327,6 +1348,7 @@ Point is left at the beginning of the narrowed-to region." "Major mode for editing mail and news to be sent. Like Text Mode but with these additional commands: C-c C-s message-send (send the message) C-c C-c message-send-and-exit +C-c C-d Pospone sending the message C-c C-k Kill the message C-c C-f move to a header field (and create it if there isn't): C-c C-f C-t move to To C-c C-f C-s move to Subject C-c C-f C-c move to Cc C-c C-f C-b move to Bcc @@ -1344,12 +1366,13 @@ 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)." +C-c C-r message-caesar-buffer-body (rot13 the message body). +C-c C-a mml-attach-file (attach a file as MIME)." (interactive) (kill-all-local-variables) (set (make-local-variable 'message-reply-buffer) nil) - (make-local-variable 'message-send-actions) - (make-local-variable 'message-exit-actions) + (make-local-variable 'message-send-actions) + (make-local-variable 'message-exit-actions) (make-local-variable 'message-kill-actions) (make-local-variable 'message-postpone-actions) (make-local-variable 'message-draft-article) @@ -1417,6 +1440,9 @@ C-c C-r message-caesar-buffer-body (rot13 the message body)." (concat "[ \t]*[-a-z0-9A-Z]*>+[ \t]*\\|" adaptive-fill-first-line-regexp)) (mm-enable-multibyte) + (make-local-variable 'indent-tabs-mode) ;Turn off tabs for indentation. + (setq indent-tabs-mode nil) + (mml-mode) (run-hooks 'text-mode-hook 'message-mode-hook)) @@ -1487,13 +1513,14 @@ C-c C-r message-caesar-buffer-body (rot13 the message body)." (interactive) (if (looking-at "[ \t]*\n") (expand-abbrev)) (goto-char (point-min)) - (search-forward (concat "\n" mail-header-separator "\n") nil t)) + (or (search-forward (concat "\n" mail-header-separator "\n") nil t) + (search-forward "\n\n" nil t))) (defun message-goto-eoh () "Move point to the end of the headers." (interactive) (message-goto-body) - (forward-line -2)) + (forward-line -1)) (defun message-goto-signature () "Move point to the beginning of the message signature. @@ -1592,8 +1619,7 @@ With the prefix argument FORCE, insert the header anyway." (eq force 0)) (save-excursion (goto-char (point-max)) - (not (re-search-backward - message-signature-separator nil t)))) + (not (re-search-backward message-signature-separator nil t)))) ((and (null message-signature) force) t) @@ -1732,7 +1758,7 @@ Numeric argument means justify as well." (goto-char (point-min)) (search-forward (concat "\n" mail-header-separator "\n") nil t) (let ((fill-prefix message-yank-prefix)) - (fill-individual-paragraphs (point) (point-max) justifyp t)))) + (fill-individual-paragraphs (point) (point-max) justifyp)))) (defun message-indent-citation () "Modify text just inserted from a message to be cited. @@ -1812,13 +1838,9 @@ 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 "!")) + (mml-quote-region start end) (goto-char end) - (when (re-search-backward "^-- $" start t) + (when (re-search-backward message-signature-separator start t) ;; Also peel off any blank lines before the signature. (forward-line -1) (while (looking-at "^[ \t]*$") @@ -1833,7 +1855,7 @@ prefix, and don't delete any headers." (insert "\n")) (funcall message-citation-line-function)))) -(defvar mail-citation-hook) ;Compiler directive +(defvar mail-citation-hook) ;Compiler directive (defun message-cite-original () "Cite function in the standard Message manner." (if (and (boundp 'mail-citation-hook) @@ -1846,11 +1868,7 @@ 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 "!")) + (mml-quote-region start end) (goto-char start) (while functions (funcall (pop functions))) @@ -1992,11 +2010,14 @@ the user from the mailer." (car elem)))) (setq success (funcall (caddr elem) arg))))) (setq sent t))) + (unless sent + (error "No methods specified to send by")) (when (and success sent) (message-do-fcc) ;;(when (fboundp 'mail-hist-put-headers-into-history) ;; (mail-hist-put-headers-into-history)) - (run-hooks 'message-sent-hook) + (save-excursion + (run-hooks 'message-sent-hook)) (message "Sending...done") ;; Mark the buffer as unmodified and delete auto-save. (set-buffer-modified-p nil) @@ -2035,7 +2056,8 @@ the user from the mailer." (message-check 'invisible-text (when (text-property-any (point-min) (point-max) 'invisible t) (put-text-property (point-min) (point-max) 'invisible nil) - (unless (yes-or-no-p "Invisible text found and made visible; continue posting? ") + (unless (yes-or-no-p + "Invisible text found and made visible; continue posting? ") (error "Invisible text found and made visible"))))) (defun message-add-action (action &rest types) @@ -2071,10 +2093,8 @@ the user from the mailer." (let ((message-deletable-headers (if news nil message-deletable-headers))) (message-generate-headers message-required-mail-headers)) - (mail-encode-encoded-word-buffer) ;; Let the user do all of the above. (run-hooks 'message-header-hook)) - (message-encode-message-body) (unwind-protect (save-excursion (set-buffer tembuf) @@ -2085,10 +2105,15 @@ the user from the mailer." (set-buffer mailbuf) (buffer-string)))) ;; Remove some headers. + (message-encode-message-body) (save-restriction (message-narrow-to-headers) + ;; We (re)generate the Lines header. + (when (memq 'Lines message-required-mail-headers) + (message-generate-headers '(Lines))) ;; Remove some headers. - (message-remove-header message-ignored-mail-headers t)) + (message-remove-header message-ignored-mail-headers t) + (mail-encode-encoded-word-buffer)) (goto-char (point-max)) ;; require one newline at the end. (or (= (preceding-char) ?\n) @@ -2239,59 +2264,60 @@ to find out how to use this." message-syntax-checks) message-syntax-checks)) result) - (save-restriction - (message-narrow-to-headers) - ;; Insert some headers. - (message-generate-headers message-required-news-headers) - (mail-encode-encoded-word-buffer) - ;; Let the user do all of the above. - (run-hooks 'message-header-hook)) - (message-cleanup-headers) - (if (not (message-check-news-syntax)) + (if (not (message-check-news-body-syntax)) nil - (message-encode-message-body) - (unwind-protect - (save-excursion - (set-buffer tembuf) - (buffer-disable-undo) - (erase-buffer) - ;; Avoid copying text props. - (insert (format - "%s" (save-excursion - (set-buffer messbuf) - (buffer-string)))) - ;; Remove some headers. - (save-restriction - (message-narrow-to-headers) + (save-restriction + (message-narrow-to-headers) + ;; Insert some headers. + (message-generate-headers message-required-news-headers) + ;; Let the user do all of the above. + (run-hooks 'message-header-hook)) + (message-cleanup-headers) + (if (not (message-check-news-syntax)) + nil + (unwind-protect + (save-excursion + (set-buffer tembuf) + (buffer-disable-undo) + (erase-buffer) + ;; Avoid copying text props. + (insert (format + "%s" (save-excursion + (set-buffer messbuf) + (buffer-string)))) + (message-encode-message-body) ;; Remove some headers. - (message-remove-header message-ignored-news-headers t)) - (goto-char (point-max)) - ;; require one newline at the end. - (or (= (preceding-char) ?\n) - (insert ?\n)) - (let ((case-fold-search t)) - ;; Remove the delimiter. - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n")) - (replace-match "\n") - (backward-char 1)) - (run-hooks 'message-send-news-hook) - ;;(require (car method)) - ;;(funcall (intern (format "%s-open-server" (car method))) - ;;(cadr method) (cddr method)) - ;;(setq result - ;; (funcall (intern (format "%s-request-post" (car method))) - ;; (cadr method))) - (gnus-open-server method) - (setq result (gnus-request-post method))) - (kill-buffer tembuf)) - (set-buffer messbuf) - (if result - (push 'news message-sent-message-via) - (message "Couldn't send message via news: %s" - (nnheader-get-report (car method))) - nil)))) + (save-restriction + (message-narrow-to-headers) + ;; We (re)generate the Lines header. + (when (memq 'Lines message-required-mail-headers) + (message-generate-headers '(Lines))) + ;; Remove some headers. + (message-remove-header message-ignored-news-headers t) + (let ((mail-parse-charset message-posting-charset)) + (mail-encode-encoded-word-buffer))) + (goto-char (point-max)) + ;; require one newline at the end. + (or (= (preceding-char) ?\n) + (insert ?\n)) + (let ((case-fold-search t)) + ;; Remove the delimiter. + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "\n")) + (replace-match "\n") + (backward-char 1)) + (run-hooks 'message-send-news-hook) + (gnus-open-server method) + (setq result (let ((mail-header-separator "")) + (gnus-request-post method)))) + (kill-buffer tembuf)) + (set-buffer messbuf) + (if result + (push 'news message-sent-message-via) + (message "Couldn't send message via news: %s" + (nnheader-get-report (car method))) + nil))))) ;;; ;;; Header generation & syntax checking. @@ -2310,17 +2336,23 @@ to find out how to use this." (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-news-header-syntax))) - ;; Check the body. - (message-check-news-body-syntax))))) + ;; We narrow to the headers and check them first. + (save-excursion + (save-restriction + (message-narrow-to-headers) + (message-check-news-header-syntax)))))) (defun message-check-news-header-syntax () (and + ;; Check Newsgroups header. + (message-check 'newsgroyps + (let ((group (message-fetch-field "newsgroups"))) + (or + (and group + (not (string-match "\\`[ \t]*\\'" group))) + (ignore + (message + "The newsgroups field is empty or missing. Posting is denied."))))) ;; Check the Subject header. (message-check 'subject (let* ((case-fold-search t) @@ -2483,12 +2515,15 @@ to find out how to use this." (message-check 'from (let* ((case-fold-search t) (from (message-fetch-field "from")) - (ad (nth 1 (mail-extract-address-components from)))) + ad) (cond ((not from) (message "There is no From line. Posting is denied.") nil) - ((or (not (string-match "@[^\\.]*\\." ad)) ;larsi@ifi + ((or (not (string-match + "@[^\\.]*\\." + (setq ad (nth 1 (mail-extract-address-components + from))))) ;larsi@ifi (string-match "\\.\\." ad) ;larsi@ifi..uio (string-match "@\\." ad) ;larsi@.ifi.uio (string-match "\\.$" ad) ;larsi@ifi.uio. @@ -2550,15 +2585,12 @@ to find out how to use this." ;; Check the length of the signature. (message-check 'signature (goto-char (point-max)) - (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? " - (1- (count-lines (point) (point-max))))) - 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? " + (1- (count-lines (point) (point-max))))) + t)))) (defun message-checksum () "Return a \"checksum\" for the current buffer." @@ -2669,7 +2701,7 @@ If NOW, use that time instead." 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))))) + (format "%s%02d%02d" sign (/ zone 3600) (/ (% zone 3600) 60))))) (defun message-make-message-id () "Make a unique Message-ID." @@ -2973,7 +3005,7 @@ Headers already prepared in the buffer are not modified." ;; colon, if there is none. (if (/= (char-after) ? ) (insert " ") (forward-char 1)) ;; Find out whether the header is empty... - (looking-at "[ \t]*$"))) + (looking-at "[ \t]*\n[^ \t]"))) ;; So we find out what value we should insert. (setq value (cond @@ -3159,10 +3191,6 @@ Headers already prepared in the buffer are not modified." (defun message-buffer-name (type &optional to group) "Return a new (unique) buffer name based on TYPE and TO." (cond - ;; Check whether `message-generate-new-buffers' is a function, - ;; and if so, call it. - ((message-functionp message-generate-new-buffers) - (funcall message-generate-new-buffers type to group)) ;; Generate a new buffer name The Message Way. ((eq message-generate-new-buffers 'unique) (generate-new-buffer-name @@ -3174,6 +3202,10 @@ Headers already prepared in the buffer are not modified." "") (if (and group (not (string= group ""))) (concat " on " group) "") "*"))) + ;; Check whether `message-generate-new-buffers' is a function, + ;; and if so, call it. + ((message-functionp message-generate-new-buffers) + (funcall message-generate-new-buffers type to group)) ((eq message-generate-new-buffers 'unsent) (generate-new-buffer-name (concat "*unsent " type @@ -3297,7 +3329,8 @@ Headers already prepared in the buffer are not modified." (setq buffer-file-name (expand-file-name "*message*" message-auto-save-directory)) (setq buffer-auto-save-file-name (make-auto-save-file-name))) - (clear-visited-file-modtime))) + (clear-visited-file-modtime) + (setq buffer-file-coding-system message-draft-coding-system))) (defun message-disassociate-draft () "Disassociate the message buffer from the drafts directory." @@ -3305,6 +3338,23 @@ Headers already prepared in the buffer are not modified." (nndraft-request-expire-articles (list message-draft-article) "drafts" nil t))) +(defun message-insert-headers () + "Generate the headers for the article." + (interactive) + (save-excursion + (save-restriction + (message-narrow-to-headers) + (when (message-news-p) + (message-generate-headers + (delq 'Lines + (delq 'Subject + (copy-sequence message-required-news-headers))))) + (when (message-mail-p) + (message-generate-headers + (delq 'Lines + (delq 'Subject + (copy-sequence message-required-mail-headers)))))))) + ;;; @@ -3342,6 +3392,7 @@ OTHER-HEADERS is an alist of header/value pairs." from subject date reply-to to cc references message-id follow-to (inhibit-point-motion-hooks t) + (message-this-is-mail t) mct never-mct gnus-warning) (save-restriction (message-narrow-to-head) @@ -3601,6 +3652,7 @@ responses here are directed to other newsgroups.")) "") mail-header-separator "\n" message-cancel-message) + (run-hooks 'message-cancel-hook) (message "Canceling your article...") (if (let ((message-syntax-checks 'dont-check-for-anything-just-trust-me)) @@ -3692,7 +3744,7 @@ header line with the old Message-ID." (replace-match "")) (buffer-string))) - + ;;; Forwarding messages. (defun message-forward-subject-author-subject (subject) @@ -3743,32 +3795,15 @@ Optional NEWS will use news to forward instead of mail." (let ((cur (current-buffer)) (subject (message-make-forward-subject)) art-beg) - (if news (message-news nil subject) (message-mail nil subject)) + (if news + (message-news nil subject) + (message-mail nil subject)) ;; Put point where we want it before inserting the forwarded ;; message. - (if message-signature-before-forwarded-message - (goto-char (point-max)) - (message-goto-body)) - ;; Make sure we're at the start of the line. - (unless (eolp) - (insert "\n")) - ;; Narrow to the area we are to insert. - (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 art-beg) - (narrow-to-region (point) (if (search-forward "\n\n" nil t) - (1- (point)) - (point))) - (goto-char (point-min)) - (message-remove-header message-included-forward-headers t nil t) - (widen) + (message-goto-body) + (insert "\n\n<#part type=message/rfc822 disposition=inline>\n") + (mml-insert-buffer cur) + (insert "<#/part>\n") (message-position-point))) ;;;###autoload @@ -3813,7 +3848,8 @@ Optional NEWS will use news to forward instead of mail." (when (looking-at "From ") (replace-match "X-From-Line: ")) ;; Send it. - (let (message-required-mail-headers) + (let ((message-inhibit-body-encoding t) + message-required-mail-headers) (message-send-mail)) (kill-buffer (current-buffer))) (message "Resending message to %s...done" address))) @@ -3825,33 +3861,27 @@ This only makes sense if the current message is a bounce message than contains some mail you have written which has been bounced back to you." (interactive) - (let ((cur (current-buffer)) + (let ((handles (mm-dissect-buffer)) boundary) (message-pop-to-buffer (message-buffer-name "bounce")) - (insert-buffer-substring cur) - (undo-boundary) - (message-narrow-to-head) - (if (and (message-fetch-field "Mime-Version") - (setq boundary (message-fetch-field "Content-Type"))) - (if (string-match "boundary=\"\\([^\"]+\\)\"" boundary) - (setq boundary (concat (match-string 1 boundary) " *\n" - "Content-Type: message/rfc822")) - (setq boundary nil))) - (widen) - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (or (and boundary - (re-search-forward boundary nil t) - (forward-line 2)) - (and (re-search-forward message-unsent-separator nil t) - (forward-line 1)) - (re-search-forward "^Return-Path:.*\n" nil t)) - ;; We remove everything before the bounced mail. - (delete-region - (point-min) - (if (re-search-forward "^[^ \n\t]+:" nil t) - (match-beginning 0) - (point))) + (if (stringp (car handles)) + ;; This is a MIME bounce. + (mm-insert-part (car (last handles))) + ;; This is a non-MIME bounce, so we try to remove things + ;; manually. + (mm-insert-part (car (last handles))) + (undo-boundary) + (goto-char (point-min)) + (search-forward "\n\n" nil t) + (or (and (re-search-forward message-unsent-separator nil t) + (forward-line 1)) + (re-search-forward "^Return-Path:.*\n" nil t)) + ;; We remove everything before the bounced mail. + (delete-region + (point-min) + (if (re-search-forward "^[^ \n\t]+:" nil t) + (match-beginning 0) + (point)))) (save-restriction (message-narrow-to-head) (message-remove-header message-ignored-bounced-headers t) @@ -4088,42 +4118,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))) +(defvar message-inhibit-body-encoding nil) (defun message-encode-message-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")))))) - -(run-hooks 'message-load-hook) + (unless message-inhibit-body-encoding + (let ((mail-parse-charset (or mail-parse-charset + message-default-charset + message-posting-charset)) + (case-fold-search t) + lines content-type-p) + (message-goto-body) + (save-restriction + (narrow-to-region (point) (point-max)) + (let ((new (mml-generate-mime))) + (when new + (delete-region (point-min) (point-max)) + (insert new) + (goto-char (point-min)) + (if (eq (aref new 0) ?\n) + (delete-char 1) + (search-forward "\n\n") + (setq lines (buffer-substring (point-min) (1- (point)))) + (delete-region (point-min) (point)))))) + (save-restriction + (message-narrow-to-headers-or-head) + (message-remove-header "Mime-Version") + (goto-char (point-max)) + (insert "MIME-Version: 1.0\n") + (when lines + (insert lines)) + (setq content-type-p + (re-search-backward "^Content-Type:" nil t))) + (save-restriction + (message-narrow-to-headers-or-head) + (message-remove-first-header "Content-Type") + (message-remove-first-header "Content-Transfer-Encoding")) + ;; We always make sure that the message has a Content-Type header. + ;; This is because some broken MTAs and MUAs get awfully confused + ;; when confronted with a message with a MIME-Version header and + ;; without a Content-Type header. For instance, Solaris' + ;; /usr/bin/mail. + (unless content-type-p + (goto-char (point-min)) + (re-search-forward "^MIME-Version:") + (forward-line 1) + (insert "Content-Type: text/plain; charset=us-ascii\n"))))) (provide 'message) +(run-hooks 'message-load-hook) + ;;; message.el ends here