(require 'mail-parse)
(require 'mm-bodies)
(require 'mm-encode)
+ (require 'mml)
)
(defgroup message '((user-mail-address custom-variable)
: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.
: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.
: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)
: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
(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.")
(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)
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)
(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))
(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.
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
(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.
(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."
(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)
;; 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)
(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)
(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))
(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)
(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))
;; 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.
(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)))
;;;
;;; 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 ()
projects / elisp / gnus.git- / blobdiff