: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-headers
:type 'boolean)
-(defcustom message-setup-hook nil
+(defcustom message-setup-hook '(message-mime-setup)
"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-mime-setup-function
- 'turn-on-mime-edit
- "*A function called to set up MIME edit mode."
- :group 'message-various
- :type 'function)
-
(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
: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
:group 'message-various
:type 'hook)
-(defcustom message-encode-header-function
+(defcustom message-header-encode-function
'eword-encode-header
- "A function called to after header encode."
+ "A function called to encode header."
:group 'message-various
:type 'function)
-(defcustom message-after-header-encode-hook nil
+(defcustom message-header-encoded-hook nil
"Hook run in a message mode after header encoded. Buffer narrowed
to the headers."
:group 'message-various
;;;
;;; Utility functions.
;;;
+(defun message-eval-parameter (parameter)
+ (condition-case ()
+ (if (symbolp parameter)
+ (if (functionp parameter)
+ (funcall parameter)
+ (eval parameter))
+ parameter)
+ (error nil)))
+
+(defsubst message-get-parameter (key &optional alist)
+ (unless alist
+ (setq alist message-parameter-alist))
+ (cdr (assq key alist)))
+
+(defmacro message-get-parameter-with-eval (key &optional alist)
+ `(message-eval-parameter (message-get-parameter ,alist ,key)))
(defmacro message-y-or-n-p (question show &rest text)
"Ask QUESTION, displaying the rest of the arguments in a temp. buffer if SHOW"
(defun message-fetch-reply-field (header)
"Fetch FIELD from the message we're replying to."
- (let ((buffer (message-get-reply-buffer)))
+ (let ((buffer (message-eval-parameter message-reply-buffer)))
(when (and buffer
(buffer-name buffer))
(save-excursion
(- max rank)
(1+ max)))))
(message-sort-headers-1))))
-
-(defun message-eval-parameter (parameter)
- (condition-case ()
- (if (symbolp parameter)
- (if (functionp parameter)
- (funcall parameter)
- (eval parameter))
- parameter)
- (error nil)))
-
-(defun message-get-reply-buffer ()
- (message-eval-parameter message-reply-buffer))
-
-(defun message-get-original-reply-buffer ()
- (message-eval-parameter
- (cdr (assq 'original-buffer message-parameter-alist))))
\f
;;;
prefix, and don't delete any headers."
(interactive "P")
(let ((modified (buffer-modified-p))
- (buffer (message-get-reply-buffer)))
+ (buffer (message-eval-parameter message-reply-buffer)))
(when (and buffer
message-cite-function)
(delete-windows-on buffer t)
(interactive)
(set-buffer-modified-p t)
(save-buffer)
- (let ((actions message-postpone-actions))
+ (let ((actions message-postpone-actions)
+ (frame (selected-frame))
+ (org-frame message-original-frame))
(message-bury (current-buffer))
- (message-do-actions actions)))
+ (message-do-actions actions)
+ (message-delete-frame frame org-frame)))
(defun message-kill-buffer ()
"Kill the current buffer."
(message-generate-headers message-required-mail-headers))
;; Let the user do all of the above.
(run-hooks 'message-header-hook)
- (when (functionp message-encode-header-function)
- (funcall message-encode-header-function))
- (run-hooks 'message-after-header-encode-hook))
- (unwind-protect
- (save-excursion
- (set-buffer tembuf)
- (erase-buffer)
- (insert-buffer message-encoding-buffer)
- ;; Remove some headers.
- (save-restriction
- (message-narrow-to-headers)
+ (when (functionp message-header-encode-function)
+ (funcall message-header-encode-function))
+ (run-hooks 'message-header-encoded-hook))
+ (if (not (message-check-mail-syntax))
+ (progn
+ (message "")
+ ;;(message "Posting not performed")
+ 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)
- )))
- (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)
+ (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)
+ )))
+ (funcall message-send-mail-function))
+ (kill-buffer tembuf))
+ (set-buffer message-edit-buffer)
+ (push 'mail message-sent-message-via))))
(defun message-send-mail-with-sendmail ()
"Send off the prepared buffer with sendmail."
(message-generate-headers message-required-news-headers)
;; Let the user do all of the above.
(run-hooks 'message-header-hook)
- (when (functionp message-encode-header-function)
- (funcall message-encode-header-function))
- (run-hooks 'message-after-header-encode-hook))
+ (when (functionp message-header-encode-function)
+ (funcall message-header-encode-function))
+ (run-hooks 'message-header-encoded-hook))
(message-cleanup-headers)
(if (not (message-check-news-syntax))
(progn
+ (message "")
;;(message "Posting not performed")
nil)
(unwind-protect
(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))
(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)
- (when (functionp message-encode-header-function)
- (funcall message-encode-header-function))
- (run-hooks 'message-after-header-encode-hook))
- (run-hooks 'message-before-do-fcc-hook)
+ (message-remove-header "fcc" nil t)))
(goto-char (point-min))
(re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
(replace-match "" t t)
"Return the In-Reply-To header for this message."
(when message-reply-headers
(let ((from (mail-header-from message-reply-headers))
- (date (mail-header-date message-reply-headers)))
- (when from
- (let ((stop-pos
- (string-match " *at \\| *@ \\| *(\\| *<" from)))
- (concat (if (and stop-pos
- (not (zerop stop-pos)))
- (substring from 0 stop-pos) from)
- "'s message of \""
- (if (or (not date) (string= date ""))
- "(unknown date)" date)
- "\""))))))
+ (date (mail-header-date message-reply-headers))
+ (msg-id (mail-header-message-id message-reply-headers)))
+ (when msg-id
+ (concat msg-id
+ (when from
+ (let ((stop-pos
+ (string-match " *at \\| *@ \\| *(\\| *<" from)))
+ (concat " ("
+ (if (and stop-pos
+ (not (zerop stop-pos)))
+ (substring from 0 stop-pos) from)
+ "'s message of \""
+ (if (or (not date) (string= date ""))
+ "(unknown date)" date)
+ "\")"))))))))
(defun message-make-distribution ()
"Make a Distribution header."
(when actions
(setq message-send-actions actions))
(setq message-reply-buffer
- (or (cdr (assq 'reply-buffer message-parameter-alist))
+ (or (message-get-parameter 'reply-buffer)
replybuffer))
(goto-char (point-min))
;; Insert all the headers.
(run-hooks 'message-header-setup-hook))
(set-buffer-modified-p nil)
(setq buffer-undo-list nil)
- (when (functionp message-mime-setup-function)
- (funcall message-mime-setup-function))
(run-hooks 'message-setup-hook)
(message-position-point)
(undo-boundary))
(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))
(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)))
;;;
(cdr local)))))
locals)))
-
;;; @ for MIME Edit mode
;;;
(defun message-mime-insert-article (&optional message)
(interactive)
(let ((message-cite-function 'mime-edit-inserted-message-filter)
- (message-reply-buffer (message-get-original-reply-buffer))
+ (message-reply-buffer
+ (message-get-parameter-with-eval 'original-buffer))
(start (point)))
(message-yank-original nil)
(save-excursion
(set-alist 'mime-edit-message-inserter-alist
'message-mode (function message-mime-insert-article))
+(defun message-mime-encode (start end &optional orig-buf)
+ (save-restriction
+ (narrow-to-region start end)
+ (when (with-current-buffer orig-buf
+ mime-edit-mode-flag)
+ (run-hooks 'mime-edit-translate-hook)
+ (mime-edit-translate-buffer)
+ )
+ (goto-char start)
+ (and (search-forward (concat "\n" mail-header-separator "\n") nil t)
+ (replace-match "\n\n"))
+ ))
+
+(set-alist 'format-alist
+ 'mime-message
+ '("MIME message."
+ "1\\(^\\)"
+ nil
+ message-mime-encode
+ t nil))
+
+(defun message-mime-setup ()
+ (turn-on-mime-edit)
+ (add-to-list 'buffer-file-format 'mime-message))
+
;;; Miscellaneous functions
;; stolen (and renamed) from nnheader.el
projects / elisp / gnus.git- / blobdiff