X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fmessage.el;h=63cdc3e84cb2df7b4f50f7cae8b521af34202646;hb=c5a1ec5514a2c218c037d83b81da9043e9f6c321;hp=65cba471fafac6a512ce54bb5459cb371e3cb95a;hpb=f611a8c4d03d20ade562c17b03bb807d7f65cb8a;p=elisp%2Fgnus.git- diff --git a/lisp/message.el b/lisp/message.el index 65cba47..63cdc3e 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -2,7 +2,8 @@ ;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen -;; Keywords: mail, news +;; MORIOKA Tomohiko +;; Keywords: mail, news, MIME ;; This file is part of GNU Emacs. @@ -29,7 +30,10 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile + (require 'cl) + (require 'smtp) + ) (require 'mailheader) (require 'nnheader) @@ -39,6 +43,7 @@ (if (string-match "XEmacs\\|Lucid" emacs-version) (require 'mail-abbrevs) (require 'mailabbrev)) +(require 'mime-edit) (defgroup message '((user-mail-address custom-variable) (user-full-name custom-variable)) @@ -109,7 +114,7 @@ :type 'integer) (defcustom message-send-rename-function nil - "*Function called to rename the buffer after sending it." + "Function called to rename the buffer after sending it." :group 'message-buffers :type 'function) @@ -122,6 +127,11 @@ mailbox format." (function :tag "Other")) :group 'message-sending) +(defcustom message-encode-function 'message-maybe-encode + "*A function called to encode messages." + :group 'message-sending + :type 'function) + (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. @@ -156,7 +166,7 @@ Otherwise, most addresses look like `angles', but they look like :group 'message-headers) (defcustom message-syntax-checks nil - ;; Guess this one shouldn't be easy to customize... + ; Guess this one shouldn't be easy to customize... "*Controls what syntax checks should not be performed on outgoing posts. To disable checking of long signatures, for instance, add `(signature . disabled)' to this list. @@ -193,7 +203,7 @@ included. Organization, Lines and X-Mailer are optional." :type '(repeat sexp)) (defcustom message-deletable-headers '(Message-ID Date Lines) - "*Headers to be deleted if they already exist and were generated by message previously." + "Headers to be deleted if they already exist and were generated by message previously." :group 'message-headers :type 'sexp) @@ -219,7 +229,7 @@ any confusion." ;;;###autoload (defcustom message-signature-separator "^-- *$" - "*Regexp matching the signature separator." + "Regexp matching the signature separator." :type 'regexp :group 'message-various) @@ -229,7 +239,7 @@ any confusion." :group 'message-various) (defcustom message-interactive nil - "*Non-nil means when sending a message wait for and display errors. + "Non-nil means when sending a message wait for and display errors. nil means let mailer mail back a message to report errors." :group 'message-sending :group 'message-mail @@ -277,13 +287,13 @@ If nil, Message won't autosave." :type 'directory) (defcustom message-forward-start-separator - "------- Start of forwarded message -------\n" + (concat (mime-make-tag "message" "rfc822") "\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) @@ -310,30 +320,31 @@ If nil, Message won't autosave." :type 'regexp) (defcustom message-cancel-message "I am canceling my own article." - "*Message to be inserted in the cancel message." + "Message to be inserted in the cancel message." :group 'message-interface :type 'string) ;; Useful to set in site-init.el ;;;###autoload (defcustom message-send-mail-function 'message-send-mail-with-sendmail - "*Function to call to send the current buffer as mail. + "Function to call to send the current buffer as mail. 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), `message-send-mail-with-mh', `message-send-mail-with-qmail' and -`smtpmail-send-it'." +`message-send-mail-with-smtp'." :type '(radio (function-item message-send-mail-with-sendmail) (function-item message-send-mail-with-mh) (function-item message-send-mail-with-qmail) - (function-item smtpmail-send-it) + (function-item message-send-mail-with-smtp) (function :tag "Other")) :group 'message-sending :group 'message-mail) -(defcustom message-send-news-function 'message-send-news - "*Function to call to send the current buffer as news. +;; 1997-09-29 by MORIOKA Tomohiko +(defcustom message-send-news-function 'message-send-news-with-gnus + "Function to call to send the current buffer as news. The headers should be delimited by a line whose contents match the variable `mail-header-separator'." :group 'message-sending @@ -341,21 +352,21 @@ variable `mail-header-separator'." :type 'function) (defcustom message-reply-to-function nil - "*Function that should return a list of headers. + "Function that should return a list of headers. This function should pick out addresses from the To, Cc, and From headers and respond with new To and Cc headers." :group 'message-interface :type 'function) (defcustom message-wide-reply-to-function nil - "*Function that should return a list of headers. + "Function that should return a list of headers. This function should pick out addresses from the To, Cc, and From headers and respond with new To and Cc headers." :group 'message-interface :type 'function) (defcustom message-followup-to-function nil - "*Function that should return a list of headers. + "Function that should return a list of headers. This function should pick out addresses from the To, Cc, and From headers and respond with new To and Cc headers." :group 'message-interface @@ -381,12 +392,12 @@ command line, because it is even more evil than leaving it out." ;; qmail-related stuff (defcustom message-qmail-inject-program "/var/qmail/bin/qmail-inject" - "*Location of the qmail-inject program." + "Location of the qmail-inject program." :group 'message-sending :type 'file) (defcustom message-qmail-inject-args nil - "*Arguments passed to qmail-inject programs. + "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 @@ -416,32 +427,32 @@ might set this variable to '(\"-f\" \"you@some.where\")." :group 'message-headers :type 'boolean) -(defcustom message-setup-hook nil - "*Normal hook, run each time a new outgoing message is initialized. +(defcustom message-setup-hook + '(message-maybe-setup-default-charset turn-on-mime-edit) + "Normal hook, run each time a new outgoing message is initialized. The function `message-setup' runs this hook." :group 'message-various :type 'hook) (defcustom message-signature-setup-hook nil - "*Normal hook, run each time a new outgoing message is initialized. + "Normal hook, run each time a new outgoing message is initialized. It is run after the headers have been inserted and before the signature is inserted." :group 'message-various :type 'hook) (defcustom message-mode-hook nil - "*Hook run in message mode buffers." + "Hook run in message mode buffers." :group 'message-various :type 'hook) -(defcustom message-header-hook nil - "*Hook run in a message mode buffer narrowed to the headers." +(defcustom message-header-hook '(eword-encode-header) + "Hook run in a message mode buffer narrowed to the headers." :group 'message-various :type 'hook) (defcustom message-header-setup-hook nil - "*Hook called narrowed to the headers when setting up a message -buffer." + "Hook called narrowed to the headers when setting up a message buffer." :group 'message-various :type 'hook) @@ -512,14 +523,14 @@ If a form, the result from the form will be used instead." :type 'function) (defcustom message-expires 14 - "*Number of days before your article expires." + "Number of days before your article expires." :group 'message-news :group 'message-headers :link '(custom-manual "(message)News Headers") :type 'integer) (defcustom message-user-path nil - "*If nil, use the NNTP server name in the Path header. + "If nil, use the NNTP server name in the Path header. If stringp, use this; if non-nil, use no host name (user name only)." :group 'message-news :group 'message-headers @@ -545,6 +556,7 @@ If stringp, use this; if non-nil, use no host name (user name only)." (define-widget 'message-header-lines 'text "All header lines must be LFD terminated." + :format "%t:%n%v" :valid-regexp "^\\'" :error "All header lines must be newline terminated") @@ -795,23 +807,23 @@ Defaults to `text-mode-abbrev-table'.") The cdr of ech entry is a function for applying the face to a region.") (defcustom message-send-hook nil - "*Hook run before sending messages." + "Hook run before sending messages." :group 'message-various :options '(ispell-message) :type 'hook) (defcustom message-send-mail-hook nil - "*Hook run before sending mail messages." + "Hook run before sending mail messages." :group 'message-various :type 'hook) (defcustom message-send-news-hook nil - "*Hook run before sending news messages." + "Hook run before sending news messages." :group 'message-various :type 'hook) (defcustom message-sent-hook nil - "*Hook run after sending messages." + "Hook run after sending messages." :group 'message-various :type 'hook) @@ -905,7 +917,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 . message-fill-references) (X-Mailer) (X-Newsreader)) "Alist used for formatting headers.") @@ -920,7 +932,10 @@ The cdr of ech entry is a function for applying the face to a region.") (autoload 'gnus-output-to-rmail "gnus-util") (autoload 'mail-abbrev-in-expansion-header-p "mailabbrev") (autoload 'nndraft-request-associate-buffer "nndraft") - (autoload 'nndraft-request-expire-articles "nndraft")) + (autoload 'nndraft-request-expire-articles "nndraft") + (autoload 'gnus-open-server "gnus-int") + (autoload 'gnus-request-post "gnus-int") + (autoload 'rmail-output "rmail")) @@ -1255,6 +1270,7 @@ 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-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) @@ -1321,7 +1337,7 @@ C-c C-r message-caesar-buffer-body (rot13 the message body)." (unless (string-match "XEmacs" emacs-version) (set (make-local-variable 'font-lock-defaults) '(message-font-lock-keywords t))) - (gnus-run-hooks 'text-mode-hook 'message-mode-hook)) + (run-hooks 'text-mode-hook 'message-mode-hook)) @@ -1855,27 +1871,36 @@ the user from the mailer." (let ((inhibit-read-only t)) (put-text-property (point-min) (point-max) 'read-only nil)) (message-fix-before-sending) - (gnus-run-hooks 'message-send-hook) + (run-hooks 'message-send-hook) (message "Sending...") - (let ((alist message-send-method-alist) + (let ((message-encoding-buffer + (message-generate-new-buffer-clone-locals " message encoding")) + (message-edit-buffer (current-buffer)) + (message-mime-mode mime-edit-mode-flag) + (alist message-send-method-alist) (success t) elem sent) - (while (and success - (setq elem (pop alist))) - (when (and (or (not (funcall (cadr elem))) - (and (or (not (memq (car elem) - message-sent-message-via)) - (y-or-n-p - (format - "Already sent message via %s; resend? " - (car elem)))) - (setq success (funcall (caddr elem) arg))))) - (setq sent t))) + (save-excursion + (set-buffer message-encoding-buffer) + (erase-buffer) + (insert-buffer message-edit-buffer) + (funcall message-encode-function) + (while (and success + (setq elem (pop alist))) + (when (and (or (not (funcall (cadr elem))) + (and (or (not (memq (car elem) + message-sent-message-via)) + (y-or-n-p + (format + "Already sent message via %s; resend? " + (car elem)))) + (setq success (funcall (caddr elem) arg))))) + (setq sent t)))) (when (and success sent) (message-do-fcc) ;;(when (fboundp 'mail-hist-put-headers-into-history) ;; (mail-hist-put-headers-into-history)) - (gnus-run-hooks 'message-sent-hook) + (run-hooks 'message-sent-hook) (message "Sending...done") ;; Mark the buffer as unmodified and delete autosave. (set-buffer-modified-p nil) @@ -1893,7 +1918,7 @@ the user from the mailer." (defun message-send-via-news (arg) "Send the current message via news." - (funcall message-send-news-function arg)) + (message-send-news arg)) (defun message-fix-before-sending () "Do various things to make the message nice before sending it." @@ -1927,8 +1952,7 @@ the user from the mailer." (require 'mail-utils) (let ((tembuf (message-generate-new-buffer-clone-locals " message temp")) (case-fold-search nil) - (news (message-news-p)) - (mailbuf (current-buffer))) + (news (message-news-p))) (save-restriction (message-narrow-to-headers) ;; Insert some headers. @@ -1936,16 +1960,12 @@ the user from the mailer." (if news nil message-deletable-headers))) (message-generate-headers message-required-mail-headers)) ;; Let the user do all of the above. - (gnus-run-hooks 'message-header-hook)) + (run-hooks 'message-header-hook)) (unwind-protect (save-excursion (set-buffer tembuf) (erase-buffer) - ;; Avoid copying text props. - (insert (format - "%s" (save-excursion - (set-buffer mailbuf) - (buffer-string)))) + (insert-buffer message-encoding-buffer) ;; Remove some headers. (save-restriction (message-narrow-to-headers) @@ -1959,9 +1979,15 @@ the user from the mailer." (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) + ))) (funcall message-send-mail-function)) (kill-buffer tembuf)) - (set-buffer mailbuf) + (set-buffer message-edit-buffer) (push 'mail message-sent-message-via))) (defun message-send-mail-with-sendmail () @@ -1981,7 +2007,7 @@ the user from the mailer." (replace-match "\n") (backward-char 1) (setq delimline (point-marker)) - (gnus-run-hooks 'message-send-mail-hook) + (run-hooks 'message-send-mail-hook) ;; Insert an extra newline if we need it to work around ;; Sun's bug that swallows newlines. (goto-char (1+ delimline)) @@ -2037,7 +2063,7 @@ to find out how to use this." (re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n")) (replace-match "\n") - (gnus-run-hooks 'message-send-mail-hook) + (run-hooks 'message-send-mail-hook) ;; send the message (case (let ((coding-system-for-write 'binary)) @@ -2084,17 +2110,155 @@ to find out how to use this." (concat "^" (symbol-name (car headers)) ": *") nil t) (message-delete-line)) (pop headers)))) - (gnus-run-hooks 'message-send-mail-hook) + (run-hooks 'message-send-mail-hook) ;; Pass it on to mh. (mh-send-letter))) +(defun message-send-mail-with-smtp () + "Send the prepared message buffer with SMTP." + (require 'smtp) + (let ((errbuf (if mail-interactive + (generate-new-buffer " smtp errors") + 0)) + (case-fold-search nil) + resend-to-addresses + delimline) + (unwind-protect + (save-excursion + (goto-char (point-max)) + ;; require one newline at the end. + (or (= (preceding-char) ?\n) + (insert ?\n)) + ;; Change header-delimiter to be what sendmail expects. + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "\n")) + (replace-match "\n") + (backward-char 1) + (setq delimline (point-marker)) + (run-hooks 'message-send-mail-hook) + ;; (sendmail-synch-aliases) + ;; (if mail-aliases + ;; (expand-mail-aliases (point-min) delimline)) + (goto-char (point-min)) + ;; ignore any blank lines in the header + (while (and (re-search-forward "\n\n\n*" delimline t) + (< (point) delimline)) + (replace-match "\n")) + (let ((case-fold-search t)) + (goto-char (point-min)) + (goto-char (point-min)) + (while (re-search-forward "^Resent-to:" delimline t) + (setq resend-to-addresses + (save-restriction + (narrow-to-region (point) + (save-excursion + (end-of-line) + (point))) + (append (mail-parse-comma-list) + resend-to-addresses)))) +;;; Apparently this causes a duplicate Sender. +;;; ;; If the From is different than current user, insert Sender. +;;; (goto-char (point-min)) +;;; (and (re-search-forward "^From:" delimline t) +;;; (progn +;;; (require 'mail-utils) +;;; (not (string-equal +;;; (mail-strip-quoted-names +;;; (save-restriction +;;; (narrow-to-region (point-min) delimline) +;;; (mail-fetch-field "From"))) +;;; (user-login-name)))) +;;; (progn +;;; (forward-line 1) +;;; (insert "Sender: " (user-login-name) "\n"))) + ;; Don't send out a blank subject line + (goto-char (point-min)) + (if (re-search-forward "^Subject:[ \t]*\n" delimline t) + (replace-match "")) + ;; Put the "From:" field in unless for some odd reason + ;; they put one in themselves. + (goto-char (point-min)) + (if (not (re-search-forward "^From:" delimline t)) + (let* ((login user-mail-address) + (fullname (user-full-name))) + (cond ((eq mail-from-style 'angles) + (insert "From: " fullname) + (let ((fullname-start (+ (point-min) 6)) + (fullname-end (point-marker))) + (goto-char fullname-start) + ;; Look for a character that cannot appear unquoted + ;; according to RFC 822. + (if (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" + fullname-end 1) + (progn + ;; Quote fullname, escaping specials. + (goto-char fullname-start) + (insert "\"") + (while (re-search-forward "[\"\\]" + fullname-end 1) + (replace-match "\\\\\\&" t)) + (insert "\"")))) + (insert " <" login ">\n")) + ((eq mail-from-style 'parens) + (insert "From: " login " (") + (let ((fullname-start (point))) + (insert fullname) + (let ((fullname-end (point-marker))) + (goto-char fullname-start) + ;; RFC 822 says \ and nonmatching parentheses + ;; must be escaped in comments. + ;; Escape every instance of ()\ ... + (while (re-search-forward "[()\\]" fullname-end 1) + (replace-match "\\\\\\&" t)) + ;; ... then undo escaping of matching parentheses, + ;; including matching nested parentheses. + (goto-char fullname-start) + (while (re-search-forward + "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)" + fullname-end 1) + (replace-match "\\1(\\3)" t) + (goto-char fullname-start)))) + (insert ")\n")) + ((null mail-from-style) + (insert "From: " login "\n"))))) + ;; Insert an extra newline if we need it to work around + ;; Sun's bug that swallows newlines. + (goto-char (1+ delimline)) + (if (eval mail-mailer-swallows-blank-line) + (newline)) + ;; Find and handle any FCC fields. + (goto-char (point-min)) + (if (re-search-forward "^FCC:" delimline t) + (mail-do-fcc delimline)) + (if mail-interactive + (save-excursion + (set-buffer errbuf) + (erase-buffer)))) + ;; + ;; + ;; + (let ((recipient-address-list + (or resend-to-addresses + (smtp-deduce-address-list (current-buffer) + (point-min) delimline)))) + (smtp-do-bcc delimline) + + (if recipient-address-list + (if (not (smtp-via-smtp recipient-address-list + (current-buffer))) + (error "Sending failed; SMTP protocol error")) + (error "Sending failed; no recipients")) + )) + (if (bufferp errbuf) + (kill-buffer errbuf))))) + (defun message-send-news (&optional arg) (let ((tembuf (message-generate-new-buffer-clone-locals " *message temp*")) (case-fold-search nil) (method (if (message-functionp message-post-method) (funcall message-post-method arg) message-post-method)) - (messbuf (current-buffer)) (message-syntax-checks (if arg (cons '(existing-newsgroups . disabled) @@ -2106,7 +2270,7 @@ to find out how to use this." ;; Insert some headers. (message-generate-headers message-required-news-headers) ;; Let the user do all of the above. - (gnus-run-hooks 'message-header-hook)) + (run-hooks 'message-header-hook)) (message-cleanup-headers) (if (not (message-check-news-syntax)) (progn @@ -2117,11 +2281,7 @@ to find out how to use this." (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-buffer message-encoding-buffer) ;; Remove some headers. (save-restriction (message-narrow-to-headers) @@ -2131,30 +2291,48 @@ to find out how to use this." ;; 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)) - (gnus-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))) + (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))) (kill-buffer tembuf)) - (set-buffer messbuf) + (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)))) +;; 1997-09-29 by MORIOKA Tomohiko +(defun message-send-news-with-gnus (method) + (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) + (gnus-request-post method) + )) + ;;; ;;; Header generation & syntax checking. ;;; @@ -2188,7 +2366,9 @@ to find out how to use this." (message-narrow-to-headers) (message-check-news-header-syntax))) ;; Check the body. - (message-check-news-body-syntax))))) + (save-excursion + (set-buffer message-edit-buffer) + (message-check-news-body-syntax)))))) (defun message-check-news-header-syntax () (and @@ -2449,18 +2629,19 @@ to find out how to use this." (defun message-do-fcc () "Process Fcc headers in the current buffer." (let ((case-fold-search t) - (buf (current-buffer)) + (coding-system-for-write 'raw-text) list file) (save-excursion (set-buffer (get-buffer-create " *message temp*")) (buffer-disable-undo (current-buffer)) (erase-buffer) - (insert-buffer-substring buf) + (insert-buffer-substring message-encoding-buffer) (save-restriction (message-narrow-to-headers) (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) @@ -2899,7 +3080,7 @@ Headers already prepared in the buffer are not modified." (insert "Original-") (beginning-of-line)) (when (or (message-news-p) - (string-match "^[^@]@.+\\..+" secure-sender)) + (string-match "^[^@]+@.+\\..+" secure-sender)) (insert "Sender: " secure-sender "\n"))))))) (defun message-insert-courtesy-copy () @@ -2953,6 +3134,13 @@ Headers already prepared in the buffer are not modified." (widen) (forward-line 1))) +(defun message-fill-references (header value) + (insert (capitalize (symbol-name header)) + ": " + (std11-fill-msg-id-list-string + (if (consp value) (car value) value)) + "\n")) + (defun message-fill-header (header value) (let ((begin (point)) (fill-column 990) @@ -3104,14 +3292,14 @@ Headers already prepared in the buffer are not modified." (delq 'Lines (delq 'Subject (copy-sequence message-required-mail-headers)))))) - (gnus-run-hooks 'message-signature-setup-hook) + (run-hooks 'message-signature-setup-hook) (message-insert-signature) (save-restriction (message-narrow-to-headers) - (gnus-run-hooks 'message-header-setup-hook)) + (run-hooks 'message-header-setup-hook)) (set-buffer-modified-p nil) (setq buffer-undo-list nil) - (gnus-run-hooks 'message-setup-hook) + (run-hooks 'message-setup-hook) (message-position-point) (undo-boundary)) @@ -3386,18 +3574,20 @@ responses here are directed to other newsgroups.")) (unless (message-news-p) (error "This is not a news article; canceling is impossible")) (when (yes-or-no-p "Do you really want to cancel this article? ") - (let (from newsgroups message-id distribution buf) + (let (from newsgroups message-id distribution buf sender) (save-excursion ;; Get header info. from original article. (save-restriction (message-narrow-to-head) (setq from (message-fetch-field "from") + sender (message-fetch-field "sender") newsgroups (message-fetch-field "newsgroups") message-id (message-fetch-field "message-id" t) distribution (message-fetch-field "distribution"))) ;; Make sure that this article was written by the user. (unless (string-equal - (downcase (cadr (mail-extract-address-components from))) + (downcase + (or sender (cadr (std11-extract-address-components from)))) (downcase (message-make-address))) (error "This article is not yours")) ;; Make control message. @@ -3415,8 +3605,10 @@ responses here are directed to other newsgroups.")) message-cancel-message) (message "Canceling your article...") (if (let ((message-syntax-checks - 'dont-check-for-anything-just-trust-me)) - (funcall message-send-news-function)) + 'dont-check-for-anything-just-trust-me) + (message-encoding-buffer (current-buffer)) + (message-edit-buffer (current-buffer))) + (message-send-news)) (message "Canceling your article...done")) (kill-buffer buf))))) @@ -3528,7 +3720,10 @@ Optional NEWS will use news to forward instead of mail." (set-buffer (get-buffer-create " *message resend*")) (buffer-disable-undo (current-buffer)) (erase-buffer) - (message-setup `((To . ,address))) + ;; avoid to turn-on-mime-edit + (let (message-setup-hook) + (message-setup `((To . ,address))) + ) ;; Insert our usual headers. (message-generate-headers '(From Date To)) (message-narrow-to-headers) @@ -3551,7 +3746,7 @@ Optional NEWS will use news to forward instead of mail." (goto-char (point-max))) (insert mail-header-separator) ;; Rename all old ("Also-")Resent headers. - (while (re-search-backward "^\\(Also-\\)?Resent-" beg t) + (while (re-search-backward "^\\(Also-\\)*Resent-" beg t) (beginning-of-line) (insert "Also-")) ;; Quote any "From " lines at the beginning. @@ -3559,7 +3754,9 @@ Optional NEWS will use news to forward instead of mail." (when (looking-at "From ") (replace-match "X-From-Line: ")) ;; Send it. - (message-send-mail) + (let ((message-encoding-buffer (current-buffer)) + (message-edit-buffer (current-buffer))) + (message-send-mail)) (kill-buffer (current-buffer))) (message "Resending message to %s...done" address))) @@ -3715,7 +3912,8 @@ Do a `tab-to-tab-stop' if not in those headers." (defvar gnus-active-hashtb) (defun message-expand-group () - "Expand the group name under point." (let* ((b (save-excursion + "Expand the group name under point." + (let* ((b (save-excursion (save-restriction (narrow-to-region (save-excursion @@ -3809,6 +4007,47 @@ regexp varstr." (cdr local))))) locals))) + +;;; @ 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) + (if (catch 'mime-edit-error + (save-excursion + (mime-edit-translate-body) + )) + (error "Translation error!") + ) + (end-of-invisible) + (run-hooks 'mime-edit-exit-hook) + )) + +(defun message-mime-insert-article (&optional message) + (interactive) + (let ((message-cite-function 'mime-edit-inserted-message-filter) + (message-reply-buffer gnus-original-article-buffer) + ) + (message-yank-original nil) + )) + +(set-alist 'mime-edit-message-inserter-alist + 'message-mode (function message-mime-insert-article)) + ;;; Miscellaneous functions ;; stolen (and renamed) from nnheader.el