;;; message.el --- composing mail and news messages -*- coding: iso-latin-1 -*-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
:type 'sexp)
(defcustom message-ignored-news-headers
- "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|X-Draft-From:"
+ "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:"
"*Regexp of headers to be removed unconditionally before posting."
:group 'message-news
:group 'message-headers
:type 'regexp)
(defcustom message-ignored-mail-headers
- "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|X-Draft-From:"
+ "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:"
"*Regexp of headers to be removed unconditionally before mailing."
:group 'message-mail
:group 'message-headers
:type 'sexp)
(defcustom message-generate-headers-first nil
- "*If non-nil, generate all possible headers before composing."
+ "*If non-nil, generate all required headers before composing.
+The variables `message-required-news-headers' and
+`message-required-mail-headers' specify which headers to generate.
+
+Note that the variable `message-deletable-headers' specifies headers which
+are to be deleted and then re-generated before sending, so this variable
+will not have a visible effect for those headers."
:group 'message-headers
:type 'boolean)
:group 'message-various
:type 'hook)
-(defcustom message-minibuffer-local-map
+(defcustom message-minibuffer-local-map
(let ((map (make-sparse-keymap 'message-minibuffer-local-map)))
(set-keymap-parent map minibuffer-local-map)
map)
;;;###autoload
(defcustom message-signature-file "~/.signature"
- "*File containing the text inserted at end of message buffer."
- :type 'file
+ "*Name of file containing the text inserted at end of message buffer.
+Ignored if the named file doesn't exist.
+If nil, don't insert a signature."
+ :type '(choice file (const :tags "None" nil))
:group 'message-insertion)
(defcustom message-distribution-function nil
regexp))
(defvar message-shoot-gnksa-feet nil
- "*A list of GNKSA feet you are allowed to shoot.
+ "*A list of GNKSA feet you are allowed to shoot.
Gnus gives you all the opportunity you could possibly want for
shooting yourself in the foot. Also, Gnus allows you to shoot the
feet of Good Net-Keeping Seal of Approval. The following are foot
`empty-article' Allow you to post an empty article;
`quoted-text-only' Allow you to post quoted text only;
`multiple-copies' Allow you to post multiple copies.")
+;; `cancel-messages' Allow you to cancel or supersede others' messages.
(defsubst message-gnksa-enable-p (feature)
(or (not (listp message-shoot-gnksa-feet))
(autoload 'gnus-open-server "gnus-int")
(autoload 'gnus-request-post "gnus-int")
(autoload 'gnus-alive-p "gnus-util")
+ (autoload 'gnus-server-string "gnus")
(autoload 'gnus-group-name-charset "gnus-group")
- (autoload 'rmail-output "rmail"))
+ (autoload 'rmail-output "rmailout"))
\f
(save-restriction
(message-narrow-to-headers)
(unless (re-search-forward (concat "^" (regexp-quote hclean) ":") nil t)
- (insert (car headers) ?\n))))
+ (goto-char (point-max))
+ (if (string-match "\n$" (car headers))
+ (insert (car headers))
+ (insert (car headers) ?\n)))))
(setq headers (cdr headers))))
(define-key message-mode-map "\C-c\C-v" 'message-delete-not-region)
(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 "\M-q" 'message-fill-paragraph)
+ ;;(define-key message-mode-map "\M-q" 'message-fill-paragraph)
(define-key message-mode-map "\C-c\C-a" 'mml-attach-file)
["Newline and Reformat" message-newline-and-reformat t]
["Rename buffer" message-rename-buffer t]
["Spellcheck" ispell-message
- ,@(if (featurep 'xemacs) nil
+ ,@(if (featurep 'xemacs) '(t)
'(:help "Spellcheck this message"))]
["Attach file as MIME" mml-attach-file
- ,@(if (featurep 'xemacs) nil
+ ,@(if (featurep 'xemacs) '(t)
'(:help "Attach a file at point"))]
"----"
["Send Message" message-send-and-exit
- ,@(if (featurep 'xemacs) nil
+ ,@(if (featurep 'xemacs) '(t)
'(:help "Send this message"))]
["Abort Message" message-dont-send
- ,@(if (featurep 'xemacs) nil
+ ,@(if (featurep 'xemacs) '(t)
'(:help "File this draft message and exit"))]
["Kill Message" message-kill-buffer
- ,@(if (featurep 'xemacs) nil
+ ,@(if (featurep 'xemacs) '(t)
'(:help "Delete this message without sending"))]))
(easy-menu-define
(defun message-setup-fill-variables ()
"Setup message fill variables."
+ (set (make-local-variable 'fill-paragraph-function)
+ 'message-fill-paragraph)
(make-local-variable 'paragraph-separate)
(make-local-variable 'paragraph-start)
(make-local-variable 'adaptive-fill-regexp)
(let ((quote-prefix-regexp
;; User should change message-cite-prefix-regexp if
;; message-yank-prefix is set to an abnormal value.
- (concat "\\(" message-cite-prefix-regexp "\\)[ \t]*")))
+ (concat "\\(" message-cite-prefix-regexp "\\)[ \t]*")))
(setq paragraph-start
(concat
(regexp-quote mail-header-separator) "$\\|"
(unless (bolp)
(insert "\n"))))
-(defun message-newline-and-reformat (&optional not-break)
- "Insert four newlines, and then reformat if inside quoted text."
- (interactive)
- (let (quoted point beg end leading-space)
+(defun message-newline-and-reformat (&optional arg not-break)
+ "Insert four newlines, and then reformat if inside quoted text.
+Prefix arg means justify as well."
+ (interactive (list (if current-prefix-arg 'full)))
+ (let (quoted point beg end leading-space bolp)
(setq point (point))
(beginning-of-line)
(setq beg (point))
+ (setq bolp (= beg point))
;; Find first line of the paragraph.
(if not-break
- (while (and (not (eobp))
+ (while (and (not (eobp))
(not (looking-at message-cite-prefix-regexp))
(looking-at paragraph-start))
(forward-line 1)))
(setq leading-space (match-string 0)))
(if (and quoted
(not not-break)
+ (not bolp)
(< (- point beg) (length quoted)))
- ;; break in the cite prefix.
+ ;; break inside the cite prefix.
(setq quoted nil
end nil))
(if quoted
(narrow-to-region beg end)
(if not-break
(setq point nil)
- (insert "\n\n")
+ (if bolp
+ (insert "\n")
+ (insert "\n\n"))
(setq point (point))
(insert "\n\n")
(delete-region (point) (re-search-forward "[ \t]*"))
- (when quoted
+ (when (and quoted (not bolp))
(insert quoted leading-space)))
(if quoted
- (let* ((adaptive-fill-regexp
+ (let* ((adaptive-fill-regexp
(regexp-quote (concat quoted leading-space)))
- (adaptive-fill-first-line-regexp
+ (adaptive-fill-first-line-regexp
adaptive-fill-regexp ))
- (fill-paragraph nil))
- (fill-paragraph nil))
+ (fill-paragraph arg))
+ (fill-paragraph arg))
(if point (goto-char point)))))
-(defun message-fill-paragraph ()
+(defun message-fill-paragraph (&optional arg)
"Like `fill-paragraph'."
- (interactive)
- (message-newline-and-reformat t))
+ (interactive (list (if current-prefix-arg 'full)))
+ (message-newline-and-reformat arg t)
+ t)
(defun message-insert-signature (&optional force)
"Insert a signature. See documentation for variable `message-signature'."
message-cite-function)
(delete-windows-on message-reply-buffer t)
(insert-buffer message-reply-buffer)
- (funcall message-cite-function)
+ (unless arg
+ (funcall message-cite-function))
(message-exchange-point-and-mark)
(unless (bolp)
(insert ?\n))
(while (looking-at "^[ \t]*$")
(forward-line -1))
(forward-line 1)
- (delete-region (point) end))
+ (delete-region (point) end)
+ (unless (search-backward "\n\n" start t)
+ ;; Insert a blank line if it is peeled off.
+ (insert "\n")))
(goto-char start)
(while functions
(funcall (pop functions)))
(pop actions)))
(defun message-send-mail-partially ()
- "Sendmail as message/partial."
+ "Send mail as message/partial."
;; replace the header delimiter with a blank line
(goto-char (point-min))
(re-search-forward
(and news
(or (message-fetch-field "cc")
(message-fetch-field "to"))
- (string= "text/plain"
- (car
- (mail-header-parse-content-type
- (message-fetch-field "content-type"))))))
+ (let ((content-type (message-fetch-field "content-type")))
+ (or
+ (not content-type)
+ (string= "text/plain"
+ (car
+ (mail-header-parse-content-type
+ content-type)))))))
(message-insert-courtesy-copy))
(if (or (not message-send-mail-partially-limit)
(< (point-max) message-send-mail-partially-limit)
- (not (y-or-n-p "The message size is too large, should it be sent partially? ")))
+ (not (y-or-n-p "Message exceeds message-send-mail-partially-limit, send in parts? ")))
(mm-with-unibyte-current-buffer
+ (message "Sending via mail...")
(funcall message-send-mail-function))
(message-send-mail-partially)))
(kill-buffer tembuf))
(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
+ (when group-name-charset
+ (setq message-syntax-checks
(cons '(valid-newsgroups . disabled)
message-syntax-checks)))
(message-cleanup-headers)
(backward-char 1))
(run-hooks 'message-send-news-hook)
(gnus-open-server method)
+ (message "Sending news with %s..." (gnus-server-string method))
(setq result (let ((mail-header-separator ""))
(gnus-request-post method))))
(kill-buffer tembuf))
(hashtb (and (boundp 'gnus-active-hashtb)
gnus-active-hashtb))
errors)
- (if (or (not hashtb)
- (not (boundp 'gnus-read-active-file))
- (not gnus-read-active-file)
- (eq gnus-read-active-file 'some))
- t
- (while groups
- (when (and (not (boundp (intern (car groups) hashtb)))
- (not (equal (car groups) "poster")))
- (push (car groups) errors))
- (pop groups))
- (if (not errors)
- t
- (y-or-n-p
- (format
- "Really post to %s unknown group%s: %s? "
- (if (= (length errors) 1) "this" "these")
- (if (= (length errors) 1) "" "s")
- (mapconcat 'identity errors ", ")))))))
- ;; Check the Newsgroups & Followup-To headers for syntax errors.
- (message-check 'valid-newsgroups
- (let ((case-fold-search t)
- (headers '("Newsgroups" "Followup-To"))
- header error)
- (while (and headers (not error))
- (when (setq header (mail-fetch-field (car headers)))
- (if (or
- (not
- (string-match
- "\\`\\([-+_&.a-zA-Z0-9]+\\)?\\(,[-+_&.a-zA-Z0-9]+\\)*\\'"
- header))
- (memq
- nil (mapcar
- (lambda (g)
- (not (string-match "\\.\\'\\|\\.\\." g)))
- (message-tokenize-header header ","))))
- (setq error t)))
- (unless error
- (pop headers)))
- (if (not error)
- t
+ (while groups
+ (when (and (not (boundp (intern (car groups) hashtb)))
+ (not (equal (car groups) "poster")))
+ (push (car groups) errors))
+ (pop groups))
+ (cond
+ ;; Gnus is not running.
+ ((or (not hashtb)
+ (not (boundp 'gnus-read-active-file)))
+ t)
+ ;; We don't have all the group names.
+ ((and (or (not gnus-read-active-file)
+ (eq gnus-read-active-file 'some))
+ errors)
(y-or-n-p
- (format "The %s header looks odd: \"%s\". Really post? "
- (car headers) header)))))
- (message-check 'repeated-newsgroups
- (let ((case-fold-search t)
- (headers '("Newsgroups" "Followup-To"))
- header error groups group)
- (while (and headers
- (not error))
- (when (setq header (mail-fetch-field (pop headers)))
- (setq groups (message-tokenize-header header ","))
- (while (setq group (pop groups))
- (when (member group groups)
- (setq error group
- groups nil)))))
- (if (not error)
- t
+ (format
+ "Really post to %s possibly unknown group%s: %s? "
+ (if (= (length errors) 1) "this" "these")
+ (if (= (length errors) 1) "" "s")
+ (mapconcat 'identity errors ", "))))
+ ;; There were no errors.
+ ((not errors)
+ t)
+ ;; There are unknown groups.
+ (t
(y-or-n-p
- (format "Group %s is repeated in headers. Really post? " error)))))
- ;; Check the From header.
- (message-check 'from
- (let* ((case-fold-search t)
- (from (message-fetch-field "from"))
- ad)
- (cond
- ((not from)
- (message "There is no From line. Posting is denied.")
- nil)
- ((or (not (string-match
- "@[^\\.]*\\."
- (setq ad (nth 1 (mail-extract-address-components
- from))))) ;larsi@ifi
- (string-match "\\.\\." ad) ;larsi@ifi..uio
- (string-match "@\\." ad) ;larsi@.ifi.uio
- (string-match "\\.$" ad) ;larsi@ifi.uio.
- (not (string-match "^[^@]+@[^@]+$" ad)) ;larsi.ifi.uio
- (string-match "(.*).*(.*)" from)) ;(lars) (lars)
- (message
- "Denied posting -- the From looks strange: \"%s\"." from)
- nil)
- (t t))))))
+ (format
+ "Really post to %s unknown group%s: %s? "
+ (if (= (length errors) 1) "this" "these")
+ (if (= (length errors) 1) "" "s")
+ (mapconcat 'identity errors ", ")))))))
+ ;; Check the Newsgroups & Followup-To headers for syntax errors.
+ (message-check 'valid-newsgroups
+ (let ((case-fold-search t)
+ (headers '("Newsgroups" "Followup-To"))
+ header error)
+ (while (and headers (not error))
+ (when (setq header (mail-fetch-field (car headers)))
+ (if (or
+ (not
+ (string-match
+ "\\`\\([-+_&.a-zA-Z0-9]+\\)?\\(,[-+_&.a-zA-Z0-9]+\\)*\\'"
+ header))
+ (memq
+ nil (mapcar
+ (lambda (g)
+ (not (string-match "\\.\\'\\|\\.\\." g)))
+ (message-tokenize-header header ","))))
+ (setq error t)))
+ (unless error
+ (pop headers)))
+ (if (not error)
+ t
+ (y-or-n-p
+ (format "The %s header looks odd: \"%s\". Really post? "
+ (car headers) header)))))
+ (message-check 'repeated-newsgroups
+ (let ((case-fold-search t)
+ (headers '("Newsgroups" "Followup-To"))
+ header error groups group)
+ (while (and headers
+ (not error))
+ (when (setq header (mail-fetch-field (pop headers)))
+ (setq groups (message-tokenize-header header ","))
+ (while (setq group (pop groups))
+ (when (member group groups)
+ (setq error group
+ groups nil)))))
+ (if (not error)
+ t
+ (y-or-n-p
+ (format "Group %s is repeated in headers. Really post? " error)))))
+ ;; Check the From header.
+ (message-check 'from
+ (let* ((case-fold-search t)
+ (from (message-fetch-field "from"))
+ ad)
+ (cond
+ ((not from)
+ (message "There is no From line. Posting is denied.")
+ nil)
+ ((or (not (string-match
+ "@[^\\.]*\\."
+ (setq ad (nth 1 (mail-extract-address-components
+ from))))) ;larsi@ifi
+ (string-match "\\.\\." ad) ;larsi@ifi..uio
+ (string-match "@\\." ad) ;larsi@.ifi.uio
+ (string-match "\\.$" ad) ;larsi@ifi.uio.
+ (not (string-match "^[^@]+@[^@]+$" ad)) ;larsi.ifi.uio
+ (string-match "(.*).*(.*)" from)) ;(lars) (lars)
+ (message
+ "Denied posting -- the From looks strange: \"%s\"." from)
+ nil)
+ (t t))))))
(defun message-check-news-body-syntax ()
(and
(goto-char (point-min))
(re-search-forward
(concat "^" (regexp-quote mail-header-separator) "$"))
+ (forward-line 1)
(while (and
- (progn
- (end-of-line)
- (< (current-column) 80))
+ (or (looking-at
+ "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)")
+ (let ((p (point)))
+ (end-of-line)
+ (< (- (point) p) 80)))
(zerop (forward-line 1))))
(or (bolp)
(eobp)
(defun message-make-in-reply-to ()
"Return the In-Reply-To header for this message."
(when message-reply-headers
- (mail-header-message-id message-reply-headers)))
+ (let ((from (mail-header-from message-reply-headers))
+ (date (mail-header-date message-reply-headers))
+ (msg-id (mail-header-message-id message-reply-headers)))
+ (when from
+ (let ((stop-pos
+ (string-match " *at \\| *@ \\| *(\\| *<" from)))
+ (concat msg-id (if msg-id " (")
+ (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)
+ "\"" (if msg-id ")")))))))
(defun message-make-distribution ()
"Make a Distribution header."
;; Rename the buffer.
(if message-send-rename-function
(funcall message-send-rename-function)
- (when (string-match "\\`\\*\\(unsent \\)?" (buffer-name))
- (rename-buffer
- (concat "*sent " (substring (buffer-name) (match-end 0))) t)))
+ (when (string-match "\\`\\*\\(sent \\|unsent \\)?\\(.+\\)\\*[^\\*]*"
+ (buffer-name))
+ (let ((name (match-string 2 (buffer-name)))
+ to group)
+ (if (not (or (string-equal name "mail")
+ (string-equal name "news")))
+ (setq name (concat "*sent " name "*"))
+ (setq to (message-fetch-field "to"))
+ (setq group (message-fetch-field "newsgroups"))
+ (setq name
+ (cond
+ (to (concat "*sent mail to "
+ (or (car (mail-extract-address-components to))
+ to) "*"))
+ ((and group (not (string= group "")))
+ (concat "*sent news on " group "*"))
+ (t "*sent mail*"))))
+ (unless (string-equal name (buffer-name))
+ (rename-buffer name t)))))
;; Push the current buffer onto the list.
(when message-max-buffers
(setq message-buffer-list
(if (gnus-alive-p)
(setq message-draft-article
(nndraft-request-associate-buffer "drafts"))
- (setq buffer-file-name (expand-file-name "*message*"
- message-auto-save-directory))
+ (setq buffer-file-name (expand-file-name
+ (if (eq system-type 'windows-nt)
+ "message"
+ "*message*")
+ message-auto-save-directory))
(setq buffer-auto-save-file-name (make-auto-save-file-name)))
(clear-visited-file-modtime)
(setq buffer-file-coding-system message-draft-coding-system)))
mct (message-fetch-field "mail-copies-to")
reply-to (message-fetch-field "reply-to")
mrt (message-fetch-field "mail-reply-to")
- mft (message-fetch-field "mail-followup-to"))
+ mft (and message-use-followup-to
+ (message-fetch-field "mail-followup-to")))
;; Handle special values of Mail-Copies-To.
(when mct
(equal (downcase mct) "poster"))
(setq mct (or mrt reply-to from)))))
- (if (or (not wide)
- to-address)
+ (if (and (not mft)
+ (or (not wide)
+ to-address))
(progn
(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)))
+ (when (and (and wide mct)
+ (not (member (cons 'To mct) follow-to)))
+ (push (cons 'Cc mct) follow-to)))
(let (ccalist)
(save-excursion
(message-set-work-buffer)
(interactive "P")
(unless (message-news-p)
(error "This is not a news article; canceling is impossible"))
- (when (yes-or-no-p "Do you really want to cancel this article? ")
- (let (from newsgroups message-id distribution buf sender)
- (save-excursion
- ;; Get header info from original article.
- (save-restriction
- (message-narrow-to-head-1)
- (setq from (message-fetch-field "from")
- sender (message-fetch-field "sender")
- newsgroups (message-fetch-field "newsgroups")
- message-id (message-fetch-field "message-id" t)
- distribution (message-fetch-field "distribution")))
- ;; Make sure that this article was written by the user.
- (unless (or (and sender
- (string-equal
- (downcase sender)
- (downcase (message-make-sender))))
- (string-equal
- (downcase (cadr (mail-extract-address-components from)))
- (downcase (cadr (mail-extract-address-components
- (message-make-from))))))
- (error "This article is not yours"))
+ (let (from newsgroups message-id distribution buf sender)
+ (save-excursion
+ ;; Get header info from original article.
+ (save-restriction
+ (message-narrow-to-head-1)
+ (setq from (message-fetch-field "from")
+ sender (message-fetch-field "sender")
+ newsgroups (message-fetch-field "newsgroups")
+ message-id (message-fetch-field "message-id" t)
+ distribution (message-fetch-field "distribution")))
+ ;; Make sure that this article was written by the user.
+ (unless (or (message-gnksa-enable-p 'cancel-messages)
+ (and sender
+ (string-equal
+ (downcase sender)
+ (downcase (message-make-sender))))
+ (string-equal
+ (downcase (cadr (mail-extract-address-components from)))
+ (downcase (cadr (mail-extract-address-components
+ (message-make-from))))))
+ (error "This article is not yours"))
+ (when (yes-or-no-p "Do you really want to cancel this article? ")
;; Make control message.
(if arg
(message-news)
(setq buf (set-buffer (get-buffer-create " *message cancel*"))))
(erase-buffer)
(insert "Newsgroups: " newsgroups "\n"
- "From: " from "\n"
+ "From: " from "\n"
"Subject: cmsg cancel " message-id "\n"
"Control: cancel " message-id "\n"
(if distribution
(sender (message-fetch-field "sender"))
(from (message-fetch-field "from")))
;; Check whether the user owns the article that is to be superseded.
- (unless (or (and sender
+ (unless (or (message-gnksa-enable-p 'cancel-messages)
+ (and sender
(string-equal
(downcase sender)
(downcase (message-make-sender))))
;;; Forwarding messages.
+(defvar message-forward-decoded-p nil
+ "Non-nil means the original message is decoded.")
+
(defun message-forward-subject-author-subject (subject)
"Generate a SUBJECT for a forwarded message.
The form is: [Source] Subject, where if the original message was mail,
Source is the sender, and if the original message was news, Source is
the list of newsgroups is was posted to."
(concat "["
- (or (message-fetch-field
- (if (message-news-p) "newsgroups" "from"))
- "(nowhere)")
+ (let ((prefix
+ (or (message-fetch-field
+ (if (message-news-p) "newsgroups" "from"))
+ "(nowhere)")))
+ (if message-forward-decoded-p
+ prefix
+ (mail-decode-encoded-word-string prefix)))
"] " subject))
(defun message-forward-subject-fwd (subject)
(subject (message-fetch-field "Subject")))
(setq subject
(if subject
- (mail-decode-encoded-word-string subject)
+ (if message-forward-decoded-p
+ subject
+ (mail-decode-encoded-word-string subject))
""))
(if message-wash-forwarded-subjects
(setq subject (message-wash-subject subject)))
(setq funcs (cdr funcs)))
subject))))
+(eval-when-compile
+ (defvar gnus-article-decoded-p))
+
;;;###autoload
(defun message-forward (&optional news digest)
"Forward the current message via mail.
Optional DIGEST will use digest to forward."
(interactive "P")
(let* ((cur (current-buffer))
+ (message-forward-decoded-p
+ (if (local-variable-p 'gnus-article-decoded-p (current-buffer))
+ gnus-article-decoded-p ;; In an article buffer.
+ message-forward-decoded-p))
(subject (message-make-forward-subject))
art-beg)
(if news
(if message-forward-as-mime
(insert-buffer-substring cur)
(mml-insert-buffer cur))
- (if message-forward-show-mml
- (let ((target (current-buffer)) tmp)
- (with-temp-buffer
- (mm-disable-multibyte) ;; Must copy buffer in unibyte mode
- (setq tmp (current-buffer))
- (set-buffer cur)
- (mm-with-unibyte-current-buffer
- (set-buffer tmp)
- (insert-buffer-substring cur)
- (set-buffer cur))
- (set-buffer tmp)
- (mm-enable-multibyte)
- (mime-to-mml)
- (goto-char (point-min))
- (when (looking-at "From ")
- (replace-match "X-From-Line: "))
- (set-buffer target)
- (insert-buffer-substring tmp)
- (set-buffer tmp)))
+ (if (and message-forward-show-mml
+ (not message-forward-decoded-p))
+ (insert
+ (with-temp-buffer
+ (mm-disable-multibyte-mule4) ;; Must copy buffer in unibyte mode
+ (insert
+ (with-current-buffer cur
+ (mm-string-as-unibyte (buffer-string))))
+ (mm-enable-multibyte-mule4)
+ (mime-to-mml)
+ (goto-char (point-min))
+ (when (looking-at "From ")
+ (replace-match "X-From-Line: "))
+ (buffer-string)))
(save-restriction
(narrow-to-region (point) (point))
(mml-insert-buffer cur)
(defalias 'message-exchange-point-and-mark 'exchange-point-and-mark)
;; Support for toolbar
-(eval-when-compile
+(eval-when-compile
(defvar tool-bar-map)
(defvar tool-bar-mode))
(load-path (mm-image-load-path)))
;; Zap some items which aren't so relevant and take
;; up space.
- (dolist (key '(print-buffer kill-buffer save-buffer
+ (dolist (key '(print-buffer kill-buffer save-buffer
write-file dired open-file))
(define-key tool-bar-map (vector key) nil))
(tool-bar-add-item-from-menu
(when lines
(insert lines))
(setq content-type-p
- (re-search-backward "^Content-Type:" nil t)))
+ (or mml-boundary
+ (re-search-backward "^Content-Type:" nil t))))
(save-restriction
(message-narrow-to-headers-or-head)
(message-remove-first-header "Content-Type")
(defun message-options-set (symbol value)
(let ((the-cons (assq symbol message-options)))
(if the-cons
- (if value
+ (if value
(setcdr the-cons value)
(setq message-options (delq the-cons message-options)))
(and value
(save-restriction
(message-narrow-to-headers-or-head)
(message-options-set 'message-sender
- (mail-strip-quoted-names
+ (mail-strip-quoted-names
(message-fetch-field "from")))
(message-options-set 'message-recipients
- (mail-strip-quoted-names
- (message-fetch-field "to")))))
+ (mail-strip-quoted-names
+ (concat
+ (or (message-fetch-field "to") "") ", "
+ (or (message-fetch-field "cc") "") ", "
+ (or (message-fetch-field "bcc") ""))))))
(when (featurep 'xemacs)
(require 'messagexmas)
projects / gnus / blobdiff