;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
;; Keiichi Suzuki <kei-suzu@mail.wbs.ne.jp>
+;; Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
+;; Katsumi Yamaoka <yamaoka@jpl.org>
;; Keywords: mail, news, MIME
;; This file is part of GNU Emacs.
(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."
: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-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
:group 'message-buffers
:type 'boolean)
+(defcustom message-kill-buffer-query-function 'yes-or-no-p
+ "*A function called to query the user whether to kill buffer anyway or not.
+If it is t, the buffer will be killed peremptorily."
+ :type '(radio (function-item yes-or-no-p)
+ (function-item y-or-n-p)
+ (function-item nnheader-Y-or-n-p)
+ (function :tag "Other" t))
+ :group 'message-buffers)
+
(defvar gnus-local-organization)
(defcustom message-user-organization
(or (and (boundp 'gnus-local-organization)
: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-headers
:type 'boolean)
-(defcustom message-setup-hook
- '(message-maybe-setup-default-charset turn-on-mime-edit)
+(defcustom message-setup-hook '(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
: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-postpone-actions nil
"A list of actions to be performed after postponing a message.")
(defvar message-original-frame nil)
+(defvar message-parameter-alist nil)
+(defvar message-startup-parameter-alist nil)
(define-widget 'message-header-lines 'text
"All header lines must be LFD terminated."
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.")
(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)
(Lines)
(Expires)
(Message-ID)
- ;; (References . message-shorten-references)
(References . message-fill-header)
(User-Agent))
"Alist used for formatting headers.")
(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)))))
(let* ((inhibit-point-motion-hooks t)
(value (mail-fetch-field header nil (not not-all))))
(when value
- (nnheader-replace-chars-in-string value ?\n ? ))))
+ (while (string-match "\n[\t ]+" value)
+ (setq value (replace-match " " t t value)))
+ value)))
(defun message-narrow-to-field ()
"Narrow the buffer to the header on the current line."
(defun message-fetch-reply-field (header)
"Fetch FIELD from the message we're replying to."
- (when (and message-reply-buffer
- (buffer-name message-reply-buffer))
- (save-excursion
- (set-buffer message-reply-buffer)
- (message-fetch-field header))))
+ (let ((buffer (message-get-reply-buffer)))
+ (when (and buffer
+ (buffer-name buffer))
+ (save-excursion
+ (set-buffer buffer)
+ (message-fetch-field header)))))
(defun message-set-work-buffer ()
(if (get-buffer " *message work*")
(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
;;;
(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)
(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 "\t" 'message-tab))
+ (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
message-mode-menu message-mode-map "Message Menu."
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)
(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))
;;(when (fboundp 'mail-hist-define-keys)
;; (mail-hist-define-keys))
(when (string-match "XEmacs\\|Lucid" emacs-version)
(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")
Just \\[universal-argument] as argument means don't indent, insert no
prefix, and don't delete any headers."
(interactive "P")
- (let ((modified (buffer-modified-p)))
- (when (and message-reply-buffer
+ (let ((modified (buffer-modified-p))
+ (buffer (message-get-reply-buffer)))
+ (when (and buffer
message-cite-function)
- (gnus-copy-article-buffer)
- (setq message-reply-buffer gnus-article-copy)
- (delete-windows-on message-reply-buffer t)
- (insert-buffer message-reply-buffer)
+ (delete-windows-on buffer t)
+ (insert-buffer buffer)
(funcall message-cite-function)
(message-exchange-point-and-mark)
(unless (bolp)
(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
"Kill the current buffer."
(interactive)
(when (or (not (buffer-modified-p))
- (yes-or-no-p "Message modified; kill anyway? "))
+ (eq t message-kill-buffer-query-function)
+ (funcall message-kill-buffer-query-function
+ "The buffer modified; kill anyway? "))
(let ((actions message-kill-actions)
(frame (selected-frame))
(org-frame message-original-frame))
(setq buffer-file-name nil)
(kill-buffer (current-buffer))
(message-do-actions actions)
- (message-delete-frame frame org-frame))))
+ (message-delete-frame frame org-frame)))
+ (message ""))
(defun message-delete-frame (frame org-frame)
"Delete frame for editing message."
"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.
(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)
(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)
- )))
- (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
;; 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
"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"))
(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)
(unwind-protect
(save-excursion
(set-buffer tembuf)
- (buffer-disable-undo (current-buffer))
+ (buffer-disable-undo)
(erase-buffer)
(insert-buffer message-encoding-buffer)
;; Remove some headers.
;; 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)
;;; 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)
(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))
(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))
(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)
(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)
(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."
(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."
(defvar mule-version)
(defvar emacs-beta-version)
(defvar xemacs-codename)
+(defvar gnus-inviolable-extended-version)
(defun message-make-user-agent ()
- "Return user-agent info."
- (let ((user-agent
- (concat
- ;; SEMI: '("SEMI" "CODENAME" V1 V2 V3)
- (format "%s/%s (%s)"
- (nth 0 mime-user-interface-version)
- (mapconcat #'number-to-string
- (cdr (cdr mime-user-interface-version))
- ".")
- (nth 1 mime-user-interface-version))
- ;; FLIM: "FLIM VERSION - \"CODENAME\"[...]"
- (if (string-match
- "\\`\\([^ ]+\\) \\([^ ]+\\) - \"\\([^\"]+\\)\"\\(.*\\)\\'"
- mime-library-version-string)
- (format " %s/%s (%s%s)"
- (match-string 1 mime-library-version-string)
- (match-string 2 mime-library-version-string)
- (match-string 3 mime-library-version-string)
- (match-string 4 mime-library-version-string))
- " FLIM")
- "\n "
- ;; EMACS/VERSION
- (if (featurep 'xemacs)
- ;; XEmacs
- (concat
- (format "XEmacs/%d.%d" emacs-major-version emacs-minor-version)
- (if (and (boundp 'emacs-beta-version) emacs-beta-version)
- (format "beta%d" emacs-beta-version)
- "")
- (if (and (boundp 'xemacs-codename) xemacs-codename)
- (concat " (" xemacs-codename ")")
- "")
- )
- ;; not XEmacs
- (concat
- (format "Emacs/%d.%d" emacs-major-version emacs-minor-version)
- (if (>= emacs-major-version 20)
- (if (and (boundp 'enable-multibyte-characters)
- enable-multibyte-characters)
- "" ; Should return " (multibyte)"?
- " (unibyte)"))
- ))
- ;; MULE[/VERSION]
- (if (featurep 'mule)
- (if (and (boundp 'mule-version) mule-version)
- (concat " MULE/" mule-version)
- " MULE") ; no mule-version
- "") ; not Mule
- ;; Meadow/VERSION
- (if (featurep 'meadow)
- (let ((version (Meadow-version)))
- (if (string-match "\\`Meadow.\\([^ ]*\\)\\( (.*)\\)\\'" version)
- (concat " Meadow/"
- (match-string 1 version)
- (match-string 2 version)
- )
- "Meadow")) ; unknown format
- "") ; not Meadow
- )))
- (if message-user-agent
- (concat message-user-agent "\n " user-agent)
- user-agent)))
+ "Return user-agent info if the value `message-user-agent' is non-nil. If the
+\"User-Agent\" field has already exist, it's value will be added in the return
+string."
+ (when message-user-agent
+ (save-excursion
+ (goto-char (point-min))
+ (let ((case-fold-search t)
+ user-agent start p end)
+ (if (re-search-forward "^User-Agent:[\t ]*" nil t)
+ (progn
+ (setq start (match-beginning 0)
+ p (match-end 0)
+ end (std11-field-end)
+ user-agent (buffer-substring-no-properties p end))
+ (delete-region start (1+ end))
+ (concat message-user-agent " " user-agent))
+ message-user-agent)))))
(defun message-generate-headers (headers)
"Prepare article HEADERS.
(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.
(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]*")
(search-backward ":" )
(widen)
(forward-char 1)
- (if (= (following-char) ? )
+ (if (eq (char-after) ? )
(forward-char 1)
(insert " ")))
(t
((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
"")
(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))))
;; 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.
mc-modes-alist))
(when actions
(setq message-send-actions actions))
- (setq message-reply-buffer replybuffer)
+ (setq message-reply-buffer
+ (or (cdr (assq 'reply-buffer message-parameter-alist))
+ replybuffer))
(goto-char (point-min))
;; Insert all the headers.
(mail-header-format
(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)))
"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.
;; 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 "\
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 "\
(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)
;;;###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")
;; 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 "\
`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 "\
(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)
(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)))
;;;
(goto-char (min start end))
(while (< (point) end1)
(or (looking-at "[_\^@- ]")
- (insert (following-char) "\b"))
+ (insert (char-after) "\b"))
(forward-char 1)))))
;;;###autoload
(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)
(message "No matching groups")
(save-selected-window
(pop-to-buffer "*Completions*")
- (buffer-disable-undo (current-buffer))
+ (buffer-disable-undo)
(let ((buffer-read-only nil))
(erase-buffer)
(let ((standard-output (current-buffer)))
;;; @ 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)
(run-hooks 'mime-edit-exit-hook)
))
-;;; XXX: currently broken; message-yank-original resets message-reply-buffer.
-(defun message-mime-insert-article (&optional message)
- (interactive)
+(defun message-mime-insert-article (&optional full-headers)
+ (interactive "P")
(let ((message-cite-function 'mime-edit-inserted-message-filter)
- (message-reply-buffer gnus-original-article-buffer)
- )
+ (message-reply-buffer (message-get-original-reply-buffer))
+ (start (point)))
(message-yank-original nil)
- ))
+ (save-excursion
+ (narrow-to-region (goto-char start)
+ (if (search-forward "\n\n" nil t)
+ (1- (point))
+ (point-max)))
+ (goto-char (point-min))
+ (let ((message-included-forward-headers
+ (if full-headers "" message-included-forward-headers)))
+ (message-remove-header message-included-forward-headers t nil t))
+ (widen))))
(set-alist 'mime-edit-message-inserter-alist
'message-mode (function message-mime-insert-article))
;;; 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)
- (save-excursion
- (save-restriction
- (message-narrow-to-headers-or-head)
- (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.
- (unless (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)
projects / elisp / gnus.git- / blobdiff