X-Git-Url: https://git.notmuchmail.org/git?a=blobdiff_plain;f=emacs%2Fnotmuch-mua.el;h=cfdac0ef803a1f86b0a6e8d9317ee4519aecb92b;hb=dc13fcbf8755506b2681ef3c44da98737ddab8e8;hp=d4fad7b743100c977184a296d7eebc30b6d4289b;hpb=8d3d92bd8e854322e8fa4ae589c3082447613568;p=notmuch diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el index d4fad7b7..cfdac0ef 100644 --- a/emacs/notmuch-mua.el +++ b/emacs/notmuch-mua.el @@ -28,7 +28,7 @@ (eval-when-compile (require 'cl)) -(declare-function notmuch-show-insert-bodypart "notmuch-show" (msg part depth &optional hide)) +(declare-function notmuch-show-insert-body "notmuch-show" (msg body depth)) (declare-function notmuch-fcc-header-setup "notmuch-maildir-fcc" ()) (declare-function notmuch-fcc-handler "notmuch-maildir-fcc" (destdir)) @@ -93,6 +93,23 @@ Note that these functions use `mail-citation-hook' if that is non-nil." :link '(custom-manual "(message)Insertion Variables") :group 'notmuch-reply) +(defcustom notmuch-mua-reply-insert-header-p-function + 'notmuch-show-reply-insert-header-p-never + "Function to decide which parts get a header when replying. + +This function specifies which parts of a mime message with +mutiple parts get a header." + :type '(radio (const :tag "No part headers" + notmuch-show-reply-insert-header-p-never) + (const :tag "All except multipart/* and hidden parts" + notmuch-show-reply-insert-header-p-trimmed) + (const :tag "Only for included text parts" + notmuch-show-reply-insert-header-p-minimal) + (const :tag "Exactly as in show view" + notmuch-show-insert-header-p) + (function :tag "Other")) + :group 'notmuch-reply) + ;; (defun notmuch-mua-get-switch-function () @@ -144,31 +161,6 @@ Note that these functions use `mail-citation-hook' if that is non-nil." else if (notmuch-match-content-type (plist-get part :content-type) "multipart/*") do (notmuch-mua-reply-crypto (plist-get part :content)))) -(defun notmuch-mua-get-quotable-parts (parts) - (loop for part in parts - if (notmuch-match-content-type (plist-get part :content-type) "multipart/alternative") - collect (let* ((subparts (plist-get part :content)) - (types (mapcar (lambda (part) (plist-get part :content-type)) subparts)) - (chosen-type (car (notmuch-multipart/alternative-choose types)))) - (loop for part in (reverse subparts) - if (notmuch-match-content-type (plist-get part :content-type) chosen-type) - return part)) - else if (notmuch-match-content-type (plist-get part :content-type) "multipart/*") - append (notmuch-mua-get-quotable-parts (plist-get part :content)) - else if (notmuch-match-content-type (plist-get part :content-type) "text/*") - collect part)) - -(defun notmuch-mua-insert-quotable-part (message part) - ;; We don't want text properties leaking from the show renderer into - ;; the reply so we use a temp buffer. Also we don't want hooks, such - ;; as notmuch-wash-*, to be run on the quotable part so we set - ;; notmuch-show-insert-text/plain-hook to nil. - (insert (with-temp-buffer - (let ((notmuch-show-insert-text/plain-hook nil)) - ;; Show the part but do not add buttons. - (notmuch-show-insert-bodypart message part 0 'no-buttons)) - (buffer-substring-no-properties (point-min) (point-max))))) - ;; There is a bug in emacs 23's message.el that results in a newline ;; not being inserted after the References header, so the next header ;; is concatenated to the end of it. This function fixes the problem, @@ -247,10 +239,18 @@ Note that these functions use `mail-citation-hook' if that is non-nil." (insert "From: " from "\n") (insert "Date: " date "\n\n") - ;; Get the parts of the original message that should be quoted; this includes - ;; all the text parts, except the non-preferred ones in a multipart/alternative. - (let ((quotable-parts (notmuch-mua-get-quotable-parts (plist-get original :body)))) - (mapc (apply-partially 'notmuch-mua-insert-quotable-part original) quotable-parts)) + (insert (with-temp-buffer + (let + ;; Don't attempt to clean up messages, excerpt + ;; citations, etc. in the original message before + ;; quoting. + ((notmuch-show-insert-text/plain-hook nil) + ;; Don't omit long parts. + (notmuch-show-max-text-part-size 0) + ;; Insert headers for parts as appropriate for replying. + (notmuch-show-insert-header-p-function notmuch-mua-reply-insert-header-p-function)) + (notmuch-show-insert-body original (plist-get original :body) 0) + (buffer-substring-no-properties (point-min) (point-max))))) (set-mark (point)) (goto-char start) @@ -407,25 +407,53 @@ the From: address first." (list (cons 'From (notmuch-mua-prompt-for-sender)))))) (notmuch-mua-mail nil nil other-headers nil (notmuch-mua-get-switch-function)))) -(defun notmuch-mua-new-forward-message (&optional prompt-for-sender) - "Invoke the notmuch message forwarding window. - -The current buffer must contain an RFC2822 message to forward. +(defun notmuch-mua-new-forward-messages (messages &optional prompt-for-sender) + "Compose a new message forwarding MESSAGES. -If PROMPT-FOR-SENDER is non-nil, the user will be prompted for -the From: address first." - (let* ((cur (current-buffer)) - (message-forward-decoded-p nil) - (subject (message-make-forward-subject)) - (other-headers +If PROMPT-FOR-SENDER is non-nil, the user will be prompteed for +the From: address." + (let* ((other-headers (when (or prompt-for-sender notmuch-always-prompt-for-sender) - (list (cons 'From (notmuch-mua-prompt-for-sender)))))) - (notmuch-mua-mail nil subject other-headers nil (notmuch-mua-get-switch-function)) - (message-forward-make-body cur) - ;; `message-forward-make-body' shows the User-agent header. Hide - ;; it again. - (message-hide-headers) - (set-buffer-modified-p nil))) + (list (cons 'From (notmuch-mua-prompt-for-sender))))) + forward-subject) ;; Comes from the first message and is + ;; applied later. + + ;; Generate the template for the outgoing message. + (notmuch-mua-mail nil "" other-headers nil (notmuch-mua-get-switch-function)) + + (save-excursion + ;; Insert all of the forwarded messages. + (mapc (lambda (id) + (let ((temp-buffer (get-buffer-create + (concat "*notmuch-fwd-raw-" id "*")))) + ;; Get the raw version of this message in the buffer. + (with-current-buffer temp-buffer + (erase-buffer) + (let ((coding-system-for-read 'no-conversion)) + (call-process notmuch-command nil t nil "show" "--format=raw" id)) + ;; Because we process the messages in reverse order, + ;; always generate a forwarded subject, then use the + ;; last (i.e. first) one. + (setq forward-subject (message-make-forward-subject))) + ;; Make a copy ready to be forwarded in the + ;; composition buffer. + (message-forward-make-body temp-buffer) + ;; Kill the temporary buffer. + (kill-buffer temp-buffer))) + ;; `message-forward-make-body' always puts the message at + ;; the top, so do them in reverse order. + (reverse messages)) + + ;; Add in the appropriate subject. + (save-restriction + (message-narrow-to-headers) + (message-remove-header "Subject") + (message-add-header (concat "Subject: " forward-subject))) + + ;; `message-forward-make-body' shows the User-agent header. Hide + ;; it again. + (message-hide-headers) + (set-buffer-modified-p nil)))) (defun notmuch-mua-new-reply (query-string &optional prompt-for-sender reply-all) "Compose a reply to the message identified by QUERY-STRING.