;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile
+ (require 'cl)
+ (defvar gnus-list-identifiers)) ; gnus-sum is required where necessary
+
(require 'mailheader)
(require 'nnheader)
-(require 'easymenu)
-(if (string-match "XEmacs\\|Lucid" emacs-version)
- (require 'mail-abbrevs)
- (require 'mailabbrev))
+;; This is apparently necessary even though things are autoloaded:
+(if (featurep 'xemacs)
+ (require 'mail-abbrevs))
(require 'mail-parse)
-(require 'mm-bodies)
-(require 'mm-encode)
(require 'mml)
(defgroup message '((user-mail-address custom-variable)
Don't touch this variable unless you really know what you're doing.
Checks include subject-cmsg multiple-headers sendsys message-id from
-long-lines control-chars size new-text redirected-followup signature
-approved sender empty empty-headers message-id from subject
-shorten-followup-to existing-newsgroups buffer-file-name unchanged
-newsgroups."
- :group 'message-news)
+long-lines control-chars size new-text quoting-style
+redirected-followup signature approved sender empty empty-headers
+message-id from subject shorten-followup-to existing-newsgroups
+buffer-file-name unchanged newsgroups."
+ :group 'message-news
+ :type '(repeat sexp))
(defcustom message-required-news-headers
'(From Newsgroups Subject Date Message-ID
:group 'message-interface
:type 'regexp)
-(defcustom message-forward-ignored-headers "Content-Transfer-Encoding"
+(defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus"
"*All headers that match this regexp will be deleted when forwarding a message."
:group 'message-forwarding
:type '(choice (const :tag "None" nil)
:group 'message-insertion
:type 'regexp)
+(defcustom message-cite-prefix-regexp
+ "[ \t]*\\(\\(\\w\\|[_-\\.]\\)+>+[ \t]*\\|[]>»|:}+ ]*[]>»|:}+][ \t]*\\)+"
+ "*Regexp matching the longest possible citation prefix on a line."
+ :group 'message-insertion
+ :type 'regexp)
+
(defcustom message-cancel-message "I am canceling my own article.\n"
"Message to be inserted in the cancel message."
:group 'message-interface
:group 'message-sending
:type 'sexp)
-;; Ignore errors in case this is used in Emacs 19.
-;; Don't use ignore-errors because this is copied into loaddefs.el.
;;;###autoload
-(ignore-errors
- (define-mail-user-agent 'message-user-agent
- 'message-mail 'message-send-and-exit
- 'message-kill-buffer 'message-send-hook))
+(define-mail-user-agent 'message-user-agent
+ 'message-mail 'message-send-and-exit
+ 'message-kill-buffer 'message-send-hook)
(defvar message-mh-deletable-headers '(Message-ID Date Lines Sender)
"If non-nil, delete the deletable headers before feeding to mh.")
:type '(choice (const :tag "unique" unique)
(const :tag "unsent" unsent)))
-(defcustom message-default-charset nil
- "Default charset used in non-MULE XEmacsen."
+(defcustom message-default-charset
+ (and (not (mm-multibyte-p)) 'iso-8859-1)
+ "Default charset used in non-MULE Emacsen.
+If nil, you might be asked to input the charset."
:group 'message
:type 'symbol)
-(defcustom message-dont-reply-to-names rmail-dont-reply-to-names
+(defcustom message-dont-reply-to-names
+ (and (boundp 'rmail-dont-reply-to-names) rmail-dont-reply-to-names)
"*A regexp specifying names to prune when doing wide replies.
A value of nil means exclude your own name only."
:group 'message
:group 'message-faces)
(defvar message-font-lock-keywords
- (let* ((cite-prefix "A-Za-z")
- (cite-suffix (concat cite-prefix "0-9_.@-"))
- (content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)"))
+ (let ((content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)\n?"))
`((,(concat "^\\([Tt]o:\\)" content)
(1 'message-header-name-face)
(2 'message-header-to-face nil t))
`((,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$")
1 'message-separator-face))
nil)
- (,(concat "^[ \t]*"
- "\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
- "[:>|}].*")
+ (,(concat "^\\(" message-cite-prefix-regexp "\\).*")
(0 'message-cited-text-face))
("<#/?\\(multipart\\|part\\|external\\|mml\\).*>"
(0 'message-mml-face))))
:type '(choice (const :tag "unlimited" nil)
(integer 1000000)))
+(defcustom message-alternative-emails nil
+ "A regexp to match the alternative email addresses.
+The first matched address (not primary one) is used in the From field."
+ :group 'message-headers
+ :type '(choice (const :tag "Always use primary" nil)
+ regexp))
+
;;; Internal variables.
+(defvar message-sending-message "Sending...")
(defvar message-buffer-list nil)
(defvar message-this-is-news nil)
(defvar message-this-is-mail nil)
(User-Agent))
"Alist used for formatting headers.")
+(defvar message-options nil
+ "Some saved answers when sending message.")
+
(eval-and-compile
(autoload 'message-setup-toolbar "messagexmas")
(autoload 'mh-new-draft-name "mh-comp")
(autoload 'mh-send-letter "mh-comp")
(autoload 'gnus-point-at-eol "gnus-util")
(autoload 'gnus-point-at-bol "gnus-util")
+ (autoload 'gnus-output-to-rmail "gnus-util")
(autoload 'gnus-output-to-mail "gnus-util")
(autoload 'mail-abbrev-in-expansion-header-p "mailabbrev")
(autoload 'nndraft-request-associate-buffer "nndraft")
(autoload 'gnus-open-server "gnus-int")
(autoload 'gnus-request-post "gnus-int")
(autoload 'gnus-alive-p "gnus-util")
+ (autoload 'gnus-group-name-charset "gnus-group")
(autoload 'rmail-output "rmail"))
\f
`(delete-region (progn (beginning-of-line) (point))
(progn (forward-line ,(or n 1)) (point))))
+(defun message-unquote-tokens (elems)
+ "Remove double quotes (\") from strings in list."
+ (mapcar (lambda (item)
+ (while (string-match "^\\(.*\\)\"\\(.*\\)$" item)
+ (setq item (concat (match-string 1 item)
+ (match-string 2 item))))
+ item)
+ elems))
+
(defun message-tokenize-header (header &optional separator)
"Split HEADER into a list of header elements.
-\",\" is used as the separator."
+SEPARATOR is a string of characters to be used as separators. \",\"
+is used by default."
(if (not header)
nil
(let ((regexp (format "[%s]+" (or separator ",")))
((and (eq (char-after) ?\))
(not quoted))
(setq paren nil))))
- (nreverse elems)))))
+ (nreverse elems)))))
(defun message-mail-file-mbox-p (file)
"Say whether FILE looks like a Unix mbox file."
(when value
(while (string-match "\n[\t ]+" value)
(setq value (replace-match " " t t value)))
- ;; We remove all text props.
- (format "%s" value))))
+ (set-text-properties 0 (length value) nil value)
+ value)))
(defun message-narrow-to-field ()
"Narrow the buffer to the header on the current line."
(and (listp form) (eq (car form) 'lambda))
(byte-code-function-p form)))
+(defun message-strip-list-identifiers (subject)
+ "Remove list identifiers in `gnus-list-identifiers'."
+ (require 'gnus-sum) ; for gnus-list-identifiers
+ (let ((regexp (if (stringp gnus-list-identifiers)
+ gnus-list-identifiers
+ (mapconcat 'identity gnus-list-identifiers " *\\|"))))
+ (if (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp
+ " *\\)\\)+\\(Re: +\\)?\\)") subject)
+ (concat (substring subject 0 (match-beginning 1))
+ (or (match-string 3 subject)
+ (match-string 5 subject))
+ (substring subject
+ (match-end 1)))
+ subject)))
+
(defun message-strip-subject-re (subject)
"Remove \"Re:\" from subject lines."
(if (string-match message-subject-re-regexp subject)
C-c C-a mml-attach-file (attach a file as MIME).
M-RET message-newline-and-reformat (break the line and reformat)."
(interactive)
+ (if (local-variable-p 'mml-buffer-list (current-buffer))
+ (mml-destroy-buffers))
(kill-all-local-variables)
(set (make-local-variable 'message-reply-buffer) nil)
(make-local-variable 'message-send-actions)
(error "Face %s not configured for %s mode" face mode-name)))
"")
facemenu-remove-face-function t)
- (make-local-variable 'paragraph-separate)
- (make-local-variable 'paragraph-start)
- ;; `-- ' precedes the signature. `-----' appears at the start of the
- ;; lines that delimit forwarded messages.
- ;; Lines containing just >= 3 dashes, perhaps after whitespace,
- ;; are also sometimes used and should be separators.
- (setq paragraph-start
- (concat (regexp-quote mail-header-separator)
- "$\\|[ \t]*[a-z0-9A-Z]*>+[ \t]*$\\|[ \t]*$\\|"
- "-- $\\|---+$\\|"
- page-delimiter
- ;;!!! Uhm... shurely this can't be right?
- "[> " (regexp-quote message-yank-prefix) "]+$"))
- (setq paragraph-separate paragraph-start)
(make-local-variable 'message-reply-headers)
(setq message-reply-headers nil)
(make-local-variable 'message-newsreader)
(set (make-local-variable 'message-sent-message-via) nil)
(set (make-local-variable 'message-checksum) nil)
(set (make-local-variable 'message-mime-part) 0)
+ (message-setup-fill-variables)
;;(when (fboundp 'mail-hist-define-keys)
;; (mail-hist-define-keys))
- (when (string-match "XEmacs\\|Lucid" emacs-version)
- (message-setup-toolbar))
+ (if (featurep 'xemacs)
+ (message-setup-toolbar)
+ (set (make-local-variable 'font-lock-defaults)
+ '(message-font-lock-keywords t)))
(easy-menu-add message-mode-menu message-mode-map)
(easy-menu-add message-mode-field-menu message-mode-map)
;; Allow mail alias things.
(mail-abbrevs-setup)
(mail-aliases-setup)))
(message-set-auto-save-file-name)
- (unless (string-match "XEmacs" emacs-version)
- (set (make-local-variable 'font-lock-defaults)
- '(message-font-lock-keywords t)))
- (make-local-variable 'adaptive-fill-regexp)
- (setq adaptive-fill-regexp
- (concat "[ \t]*[-a-z0-9A-Z]*\\(>[ \t]*\\)+[ \t]*\\|" adaptive-fill-regexp))
- (unless (boundp 'adaptive-fill-first-line-regexp)
- (setq adaptive-fill-first-line-regexp nil))
- (make-local-variable 'adaptive-fill-first-line-regexp)
- (setq adaptive-fill-first-line-regexp
- (concat "[ \t]*[-a-z0-9A-Z]*\\(>[ \t]*\\)+[ \t]*\\|"
- adaptive-fill-first-line-regexp))
- (make-local-variable 'auto-fill-inhibit-regexp)
- (setq auto-fill-inhibit-regexp "^[A-Z][^: \n\t]+:")
(mm-enable-multibyte)
(make-local-variable 'indent-tabs-mode) ;Turn off tabs for indentation.
(setq indent-tabs-mode nil)
(mml-mode)
(run-hooks 'text-mode-hook 'message-mode-hook))
+(defun message-setup-fill-variables ()
+ "Setup message fill variables."
+ (make-local-variable 'paragraph-separate)
+ (make-local-variable 'paragraph-start)
+ (make-local-variable 'adaptive-fill-regexp)
+ (unless (boundp 'adaptive-fill-first-line-regexp)
+ (setq adaptive-fill-first-line-regexp nil))
+ (make-local-variable 'adaptive-fill-first-line-regexp)
+ (make-local-variable 'auto-fill-inhibit-regexp)
+ (let ((quote-prefix-regexp
+ (concat
+ "[ \t]*" ; possible initial space
+ "\\(\\(" (regexp-quote message-yank-prefix) "\\|" ; user's prefix
+ "\\w+>\\|" ; supercite-style prefix
+ "[|:>]" ; standard prefix
+ "\\)[ \t]*\\)+"))) ; possible space after each prefix
+ (setq paragraph-start
+ (concat
+ (regexp-quote mail-header-separator) "$\\|"
+ "[ \t]*$\\|" ; blank lines
+ "-- $\\|" ; signature delimiter
+ "---+$\\|" ; delimiters for forwarded messages
+ page-delimiter "$\\|" ; spoiler warnings
+ ".*wrote:$\\|" ; attribution lines
+ quote-prefix-regexp "$")) ; empty lines in quoted text
+ (setq paragraph-separate paragraph-start)
+ (setq adaptive-fill-regexp
+ (concat quote-prefix-regexp "\\|" adaptive-fill-regexp))
+ (setq adaptive-fill-first-line-regexp
+ (concat quote-prefix-regexp "\\|"
+ adaptive-fill-first-line-regexp))
+ (setq auto-fill-inhibit-regexp "^[A-Z][^: \n\t]+:")))
+
\f
;;;
(mail-fetch-field "to")
(not (string-match "\\` *\\'" (mail-fetch-field "to"))))
(insert ", "))
- (insert (or (message-fetch-reply-field "reply-to")
+ (insert (or (message-fetch-reply-field "mail-reply-to")
+ (message-fetch-reply-field "reply-to")
(message-fetch-reply-field "from") "")))
(defun message-widen-reply ()
(defun message-newline-and-reformat ()
"Insert four newlines, and then reformat if inside quoted text."
(interactive)
- (let ((prefix "[]>»|:}+ \t]*")
- (supercite-thing "[-._a-zA-Z0-9]*[>]+[ \t]*")
- quoted point)
+ (let (quoted point)
(unless (bolp)
(save-excursion
(beginning-of-line)
- (when (looking-at (concat prefix
- supercite-thing))
+ (when (looking-at message-cite-prefix-regexp)
(setq quoted (match-string 0))))
(insert "\n"))
(setq point (point))
(put-text-property (point-min) (point-max) 'read-only nil))
(message-fix-before-sending)
(run-hooks 'message-send-hook)
- (message "Sending...")
+ (message message-sending-message)
(let ((alist message-send-method-alist)
(success t)
- elem sent)
+ elem sent
+ (message-options message-options))
+ (message-options-set-recipient)
(while (and success
(setq elem (pop alist)))
- (when (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 (funcall (cadr elem))
+ (when (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))))
(unless (or sent (not success))
(error "No methods specified to send by"))
(when (and success sent)
(defun message-send-mail-partially ()
"Sendmail as message/partial."
+ ;; replace the header delimiter with a blank line
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "\n"))
+ (replace-match "\n")
+ (run-hooks 'message-send-mail-hook)
(let ((p (goto-char (point-min)))
(tembuf (message-generate-new-buffer-clone-locals " message temp"))
(curbuf (current-buffer))
;; require one newline at the end.
(or (= (preceding-char) ?\n)
(insert ?\n))
- (when (and news
+ (when
+ (save-restriction
+ (message-narrow-to-headers)
+ (and news
(or (message-fetch-field "cc")
- (message-fetch-field "to")))
+ (message-fetch-field "to"))
+ (string= "text/plain"
+ (car
+ (mail-header-parse-content-type
+ (message-fetch-field "content-type"))))))
(message-insert-courtesy-copy))
(if (or (not message-send-mail-partially-limit)
(< (point-max) message-send-mail-partially-limit)
(method (if (message-functionp message-post-method)
(funcall message-post-method arg)
message-post-method))
+ (group-name-charset (gnus-group-name-charset method ""))
+ (rfc2047-header-encoding-alist
+ (if group-name-charset
+ (cons (cons "Newsgroups" group-name-charset)
+ rfc2047-header-encoding-alist)
+ rfc2047-header-encoding-alist))
(messbuf (current-buffer))
(message-syntax-checks
(if arg
(message-generate-headers message-required-news-headers)
;; Let the user do all of the above.
(run-hooks 'message-header-hook))
+ (if group-name-charset
+ (setq message-syntax-checks
+ (cons '(valid-newsgroups . disabled)
+ message-syntax-checks)))
(message-cleanup-headers)
(if (not (message-check-news-syntax))
nil
(format
"Your .sig is %d lines; it should be max 4. Really post? "
(1- (count-lines (point) (point-max)))))
- t))))
+ t))
+ ;; Ensure that text follows last quoted portion.
+ (message-check 'quoting-style
+ (goto-char (point-max))
+ (let ((no-problem t))
+ (when (search-backward-regexp "^>[^\n]*\n>" nil t)
+ (setq no-problem nil)
+ (while (not (eobp))
+ (when (and (not (eolp)) (looking-at "[^> \t]"))
+ (setq no-problem t))
+ (forward-line)))
+ (if no-problem
+ t
+ (y-or-n-p "Your text should follow quoted text. Really post? "))))))
(defun message-checksum ()
"Return a \"checksum\" for the current buffer."
(while (setq file (message-fetch-field "fcc"))
(push file list)
(message-remove-header "fcc" nil t)))
+ (message-encode-message-body)
+ (save-restriction
+ (message-narrow-to-headers)
+ (let ((mail-parse-charset message-default-charset)
+ (rfc2047-header-encoding-alist
+ (cons '("Newsgroups" . default)
+ rfc2047-header-encoding-alist)))
+ (mail-encode-encoded-word-buffer)))
(goto-char (point-min))
- (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
- (replace-match "" t t)
+ (when (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$")
+ nil t)
+ (replace-match "" t t ))
;; Process FCC operations.
(while list
(setq file (pop list))
(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)
"Append this article to Unix/babyl mail file.."
(if (and (file-readable-p filename)
(mail-file-babyl-p filename))
- (rmail-output-to-rmail-file filename t)
+ (gnus-output-to-rmail filename t)
(gnus-output-to-mail filename t)))
(defun message-cleanup-headers ()
(defun message-make-in-reply-to ()
"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)
- "\""))))))
+ (mail-header-message-id message-reply-headers)))
(defun message-make-distribution ()
"Make a Distribution header."
(message-insert-signature)
(save-restriction
(message-narrow-to-headers)
+ (if message-alternative-emails
+ (message-use-alternative-email-as-from))
(run-hooks 'message-header-setup-hook))
(set-buffer-modified-p nil)
(setq buffer-undo-list nil)
(Subject . ,(or subject ""))))))
(defun message-get-reply-headers (wide &optional to-address)
- (let (follow-to mct never-mct from to cc reply-to ccalist)
+ (let (follow-to mct never-mct from to cc reply-to mrt mft ccalist)
;; Find all relevant headers we need.
(setq from (message-fetch-field "from")
to (message-fetch-field "to")
cc (message-fetch-field "cc")
mct (message-fetch-field "mail-copies-to")
- reply-to (message-fetch-field "reply-to"))
+ reply-to (message-fetch-field "reply-to")
+ mrt (message-fetch-field "mail-reply-to")
+ mft (message-fetch-field "mail-followup-to"))
;; Handle special values of Mail-Copies-To.
(when mct
(setq mct nil))
((or (equal (downcase mct) "always")
(equal (downcase mct) "poster"))
- (setq mct (or reply-to from)))))
+ (setq mct (or mrt reply-to from)))))
(if (or (not wide)
to-address)
(progn
- (setq follow-to (list (cons 'To (or to-address reply-to from))))
- (when (and wide mct)
- (push (cons 'Cc mct) follow-to)))
+ (setq follow-to (list (cons 'To (or to-address mrt reply-to from))))
+ (when (and wide (or mft mct))
+ (push (cons 'Cc (or mft mct)) follow-to)))
(let (ccalist)
(save-excursion
(message-set-work-buffer)
- (unless never-mct
- (insert (or reply-to from "")))
- (insert (if to (concat (if (bolp) "" ", ") to "") ""))
- (insert (if mct (concat (if (bolp) "" ", ") mct) ""))
- (insert (if cc (concat (if (bolp) "" ", ") cc) ""))
+ (if (and mft
+ message-use-followup-to
+ (or (not (eq message-use-followup-to 'ask))
+ (message-y-or-n-p
+ (concat "Obey Mail-Followup-To? ") t "\
+You should normally obey the Mail-Followup-To: header. In this
+article, it has the value of
+
+" mft "
+
+which directs your response to " (if (string-match "," mft)
+ "the specified addresses"
+ "that address only") ".
+
+If a message is posted to several mailing lists, Mail-Followup-To is
+often used to direct the following discussion to one list only,
+because discussions that are spread over several lists tend to be
+fragmented and very difficult to follow.
+
+Also, some source/announcement lists are not indented for discussion;
+responses here are directed to other addresses.")))
+ (insert mft)
+ (unless never-mct
+ (insert (or mrt reply-to from "")))
+ (insert (if to (concat (if (bolp) "" ", ") to "") ""))
+ (insert (if mct (concat (if (bolp) "" ", ") mct) ""))
+ (insert (if cc (concat (if (bolp) "" ", ") cc) "")))
(goto-char (point-min))
(while (re-search-forward "[ \t]+" nil t)
(replace-match " " t t))
(goto-char (point-min))
;; Perhaps "Mail-Copies-To: never" removed the only address?
(when (eobp)
- (insert (or reply-to from "")))
+ (insert (or mrt reply-to from "")))
(setq ccalist
(mapcar
(lambda (addr)
(push ccs follow-to)))))
follow-to))
-
;;;###autoload
(defun message-reply (&optional to-address wide)
"Start editing a reply to the article in the current buffer."
(interactive)
+ (require 'gnus-sum) ; for gnus-list-identifiers
(let ((cur (current-buffer))
from subject date reply-to to cc
references message-id follow-to
date (message-fetch-field "date")
from (message-fetch-field "from")
subject (or (message-fetch-field "subject") "none"))
- ;; Remove any (buggy) Re:'s that are present and make a
- ;; proper one.
- (when (string-match message-subject-re-regexp subject)
- (setq subject (substring subject (match-end 0))))
- (setq subject (concat "Re: " subject))
+ (if gnus-list-identifiers
+ (setq subject (message-strip-list-identifiers subject)))
+ (setq subject (concat "Re: " (message-strip-subject-re subject)))
(when (and (setq gnus-warning (message-fetch-field "gnus-warning"))
(string-match "<[^>]+>" gnus-warning))
"Follow up to the message in the current buffer.
If TO-NEWSGROUPS, use that as the new Newsgroups line."
(interactive)
+ (require 'gnus-sum) ; for gnus-list-identifiers
(let ((cur (current-buffer))
- from subject date reply-to mct
+ from subject date reply-to mrt mct
references message-id follow-to
(inhibit-point-motion-hooks t)
(message-this-is-news t)
newsgroups (message-fetch-field "newsgroups")
posted-to (message-fetch-field "posted-to")
reply-to (message-fetch-field "reply-to")
+ mrt (message-fetch-field "mail-reply-to")
distribution (message-fetch-field "distribution")
mct (message-fetch-field "mail-copies-to"))
(when (and (setq gnus-warning (message-fetch-field "gnus-warning"))
(let ((case-fold-search t))
(string-match "world" distribution)))
(setq distribution nil))
- ;; Remove any (buggy) Re:'s that are present and make a
- ;; proper one.
- (when (string-match message-subject-re-regexp subject)
- (setq subject (substring subject (match-end 0))))
- (setq subject (concat "Re: " subject))
+ (if gnus-list-identifiers
+ (setq subject (message-strip-list-identifiers subject)))
+ (setq subject (concat "Re: " (message-strip-subject-re subject)))
(widen))
(message-pop-to-buffer (message-buffer-name "followup" from newsgroups))
does not read the newsgroup, so he wouldn't see any replies sent to it."))
(progn
(setq message-this-is-news nil)
- (cons 'To (or reply-to from "")))
+ (cons 'To (or mrt reply-to from "")))
(cons 'Newsgroups newsgroups)))
(t
(if (or (equal followup-to newsgroups)
(equal (downcase mct) "nobody"))))
(list (cons 'Cc (if (or (equal (downcase mct) "always")
(equal (downcase mct) "poster"))
- (or reply-to from "")
+ (or mrt reply-to from "")
mct)))))
cur)
(setq buf (set-buffer (get-buffer-create " *message cancel*"))))
(erase-buffer)
(insert "Newsgroups: " newsgroups "\n"
- "From: " (message-make-from) "\n"
+ "From: " from "\n"
"Subject: cmsg cancel " message-id "\n"
"Control: cancel " message-id "\n"
(if distribution
subject))))
;;;###autoload
-(defun message-forward (&optional news)
+(defun message-forward (&optional news digest)
"Forward the current message via mail.
-Optional NEWS will use news to forward instead of mail."
+Optional NEWS will use news to forward instead of mail.
+Optional DIGEST will use digest to forward."
(interactive "P")
(let* ((cur (current-buffer))
(subject (if message-forward-show-mml
(message-goto-body)
(goto-char (point-max)))
(if message-forward-as-mime
- (if message-forward-show-mml
- (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n")
- (insert "\n\n<#part type=message/rfc822 disposition=inline"
- " buffer=\"" (buffer-name cur) "\">\n"))
+ (if digest
+ (insert "\n<#multipart type=digest>\n")
+ (if message-forward-show-mml
+ (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n")
+ (insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n")))
(insert "\n-------------------- Start of forwarded message --------------------\n"))
- (let ((b (point))
- e)
- (if message-forward-show-mml
- (insert-buffer-substring cur)
- (unless message-forward-as-mime
+ (let ((b (point)) e)
+ (if digest
+ (if message-forward-as-mime
+ (insert-buffer-substring cur)
+ (mml-insert-buffer cur))
+ (if message-forward-show-mml
+ (insert-buffer-substring cur)
(mml-insert-buffer cur)))
(setq e (point))
(if message-forward-as-mime
- (if message-forward-show-mml
- (insert "<#/mml>\n")
- (insert "<#/part>\n"))
+ (if digest
+ (insert "<#/multipart>\n")
+ (if message-forward-show-mml
+ (insert "<#/mml>\n")
+ (insert "<#/part>\n")))
(insert "\n-------------------- End of forwarded message --------------------\n"))
- (when (and (or message-forward-show-mml
- (not message-forward-as-mime))
- (not current-prefix-arg)
- message-forward-ignored-headers)
- (save-restriction
- (narrow-to-region b e)
- (goto-char b)
- (narrow-to-region (point) (or (search-forward "\n\n" nil t) (point)))
- (message-remove-header message-forward-ignored-headers t))))
+ (if (and digest message-forward-as-mime)
+ (save-restriction
+ (narrow-to-region b e)
+ (goto-char b)
+ (narrow-to-region (point)
+ (or (search-forward "\n\n" nil t) (point)))
+ (delete-region (point-min) (point-max)))
+ (when (and (not current-prefix-arg)
+ message-forward-ignored-headers)
+ (save-restriction
+ (narrow-to-region b e)
+ (goto-char b)
+ (narrow-to-region (point)
+ (or (search-forward "\n\n" nil t) (point)))
+ (message-remove-header message-forward-ignored-headers t)))))
(message-position-point)))
;;;###autoload
;;;###autoload
(defun message-bounce ()
"Re-mail the current message.
-This only makes sense if the current message is a bounce message than
+This only makes sense if the current message is a bounce message that
contains some mail you have written which has been bounced back to
you."
(interactive)
(if (re-search-forward "^[^ \n\t]+:" nil t)
(match-beginning 0)
(point))))
+ (mm-enable-multibyte)
+ (mime-to-mml)
(save-restriction
(message-narrow-to-head)
(message-remove-header message-ignored-bounced-headers t)
(defalias 'message-exchange-point-and-mark 'exchange-point-and-mark)
;; Support for toolbar
-(when (string-match "XEmacs\\|Lucid" emacs-version)
+(when (featurep 'xemacs)
(require 'messagexmas))
;;; Group name completion.
;;; Miscellaneous functions
-;; stolen (and renamed) from nnheader.el
-(defun message-replace-chars-in-string (string from to)
- "Replace characters in STRING from FROM to TO."
- (let ((string (substring string 0)) ;Copy string.
- (len (length string))
- (idx 0))
- ;; Replace all occurrences of FROM with TO.
- (while (< idx len)
- (when (= (aref string idx) from)
- (aset string idx to))
- (setq idx (1+ idx)))
- string))
+(defsubst message-replace-chars-in-string (string from to)
+ (mm-subst-char-in-string from to string))
;;;
;;; MIME functions
(if (fboundp 'mail-abbrevs-setup)
(let ((mail-abbrev-mode-regexp "")
(minibuffer-setup-hook 'mail-abbrevs-setup))
- (read-from-minibuffer prompt)))
- (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook))
- (read-string prompt)))
+ (read-from-minibuffer prompt))
+ (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook))
+ (read-string prompt))))
+
+(defun message-use-alternative-email-as-from ()
+ (require 'mail-utils)
+ (let* ((fields '("To" "Cc"))
+ (emails
+ (split-string
+ (mail-strip-quoted-names
+ (mapconcat 'message-fetch-reply-field fields ","))
+ "[ \f\t\n\r\v,]+"))
+ email)
+ (while emails
+ (if (string-match message-alternative-emails (car emails))
+ (setq email (car emails)
+ emails nil))
+ (pop emails))
+ (unless (or (not email) (equal email user-mail-address))
+ (goto-char (point-max))
+ (insert "From: " email "\n"))))
+
+(defun message-options-get (symbol)
+ (cdr (assq symbol message-options)))
+
+(defun message-options-set (symbol value)
+ (let ((the-cons (assq symbol message-options)))
+ (if the-cons
+ (if value
+ (setcdr the-cons value)
+ (setq message-options (delq the-cons message-options)))
+ (and value
+ (push (cons symbol value) message-options))))
+ value)
+
+(defun message-options-set-recipient ()
+ (save-restriction
+ (message-narrow-to-headers-or-head)
+ (message-options-set 'message-sender
+ (mail-strip-quoted-names
+ (message-fetch-field "from")))
+ (message-options-set 'message-recipients
+ (mail-strip-quoted-names
+ (message-fetch-field "to")))))
(provide 'message)
projects / gnus / blobdiff