X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch-mua.el;h=74dfb38459127491d9c378da8f471a4c8f32ce2f;hp=23f3d8b12cf10dbca3f6e8cdc8079718fbc04ab5;hb=a4617f29ce81e7ae3e0cb747fdb9070f88407a28;hpb=3b807db52b1c5e638f78df94f075389277bd3532 diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el index 23f3d8b1..74dfb384 100644 --- a/emacs/notmuch-mua.el +++ b/emacs/notmuch-mua.el @@ -21,6 +21,8 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) + (require 'message) (require 'mm-view) (require 'format-spec) @@ -28,8 +30,7 @@ (require 'notmuch-lib) (require 'notmuch-address) (require 'notmuch-draft) - -(eval-when-compile (require 'cl)) +(require 'notmuch-message) (declare-function notmuch-show-insert-body "notmuch-show" (msg body depth)) (declare-function notmuch-fcc-header-setup "notmuch-maildir-fcc" ()) @@ -120,7 +121,9 @@ multiple parts get a header." "Message body text indicating that an attachment is expected. This is not used unless `notmuch-mua-attachment-check' is added -to `notmuch-mua-send-hook'.") +to `notmuch-mua-send-hook'." + :type 'regexp + :group 'notmuch-send) ;; @@ -134,17 +137,21 @@ Typically this is added to `notmuch-mua-send-hook'." ;; When the message mentions attachment... (save-excursion (message-goto-body) - (loop while (re-search-forward notmuch-mua-attachment-regexp (point-max) t) - ;; For every instance of the "attachment" string - ;; found, examine the text properties. If the text - ;; has either a `face' or `syntax-table' property - ;; then it is quoted text and should *not* cause the - ;; user to be asked about a missing attachment. - if (let ((props (text-properties-at (match-beginning 0)))) - (not (or (memq 'syntax-table props) - (memq 'face props)))) - return t - finally return nil)) + ;; Limit search from reaching other possible parts of the message + (let ((search-limit (search-forward "\n<#" nil t))) + (message-goto-body) + (cl-loop while (re-search-forward notmuch-mua-attachment-regexp + search-limit t) + ;; For every instance of the "attachment" string + ;; found, examine the text properties. If the text + ;; has either a `face' or `syntax-table' property + ;; then it is quoted text and should *not* cause the + ;; user to be asked about a missing attachment. + if (let ((props (text-properties-at (match-beginning 0)))) + (not (or (memq 'syntax-table props) + (memq 'face props)))) + return t + finally return nil))) ;; ...but doesn't have a part with a filename... (save-excursion (message-goto-body) @@ -197,11 +204,13 @@ Typically this is added to `notmuch-mua-send-hook'." (defun notmuch-mua-reply-crypto (parts) "Add mml sign-encrypt flag if any part of original message is encrypted." - (loop for part in parts - if (notmuch-match-content-type (plist-get part :content-type) "multipart/encrypted") - do (mml-secure-message-sign-encrypt) - else if (notmuch-match-content-type (plist-get part :content-type) "multipart/*") - do (notmuch-mua-reply-crypto (plist-get part :content)))) + (cl-loop for part in parts + if (notmuch-match-content-type (plist-get part :content-type) + "multipart/encrypted") + do (mml-secure-message-sign-encrypt) + else if (notmuch-match-content-type (plist-get part :content-type) + "multipart/*") + do (notmuch-mua-reply-crypto (plist-get part :content)))) ;; 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 @@ -243,22 +252,29 @@ Typically this is added to `notmuch-mua-send-hook'." ;; the original message. ((same-window-regexps '("\\*mail .*"))) - ;; We modify message-header-format-alist to get around a bug in message.el. - ;; See the comment above on notmuch-mua-insert-references. + ;; We modify message-header-format-alist to get around + ;; a bug in message.el. See the comment above on + ;; notmuch-mua-insert-references. (let ((message-header-format-alist - (loop for pair in message-header-format-alist - if (eq (car pair) 'References) - collect (cons 'References - (apply-partially - 'notmuch-mua-insert-references - (cdr pair))) - else - collect pair))) + (cl-loop for pair in message-header-format-alist + if (eq (car pair) 'References) + collect (cons 'References + (apply-partially + 'notmuch-mua-insert-references + (cdr pair))) + else + collect pair))) (notmuch-mua-mail (plist-get reply-headers :To) (notmuch-sanitize (plist-get reply-headers :Subject)) (notmuch-headers-plist-to-alist reply-headers) nil (notmuch-mua-get-switch-function)))) + ;; Create a buffer-local queue for tag changes triggered when + ;; sending the reply. + (when notmuch-message-replied-tags + (setq-local notmuch-message-queued-tag-changes + (list (cons query-string notmuch-message-replied-tags)))) + ;; Insert the message body - but put it in front of the signature ;; if one is present, and after any other content ;; message*setup-hooks may have added to the message body already. @@ -281,27 +297,29 @@ Typically this is added to `notmuch-mua-send-hook'." (insert "From: " from "\n") (insert "Date: " date "\n\n") - (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) - ;; Ensure that any encrypted parts are - ;; decrypted during the generation of the reply - ;; text. - (notmuch-show-process-crypto process-crypto) - ;; Don't indent multipart sub-parts. - (notmuch-show-indent-multipart nil)) - ;; We don't want sigstatus buttons (an information leak and usually wrong anyway). - (letf (((symbol-function 'notmuch-crypto-insert-sigstatus-button) #'ignore) - ((symbol-function 'notmuch-crypto-insert-encstatus-button) #'ignore)) - (notmuch-show-insert-body original (plist-get original :body) 0) - (buffer-substring-no-properties (point-min) (point-max)))))) + (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) + ;; Ensure that any encrypted parts are + ;; decrypted during the generation of the reply + ;; text. + (notmuch-show-process-crypto process-crypto) + ;; Don't indent multipart sub-parts. + (notmuch-show-indent-multipart nil)) + ;; We don't want sigstatus buttons (an information leak and usually wrong anyway). + (cl-letf (((symbol-function 'notmuch-crypto-insert-sigstatus-button) #'ignore) + ((symbol-function 'notmuch-crypto-insert-encstatus-button) #'ignore)) + (notmuch-show-insert-body original (plist-get original :body) 0) + (buffer-substring-no-properties (point-min) (point-max)))))) (set-mark (point)) (goto-char start) @@ -322,7 +340,7 @@ Typically this is added to `notmuch-mua-send-hook'." (set-buffer-modified-p nil)) (define-derived-mode notmuch-message-mode message-mode "Message[Notmuch]" - "Notmuch message composition mode. Mostly like `message-mode'" + "Notmuch message composition mode. Mostly like `message-mode'." (notmuch-address-setup)) (put 'notmuch-message-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify) @@ -371,10 +389,13 @@ modified. This function is notmuch addaptation of (unless (assq 'From other-headers) (push (cons 'From (message-make-from - (notmuch-user-name) (notmuch-user-primary-email))) other-headers)) + (notmuch-user-name) + (notmuch-user-primary-email))) + other-headers)) (notmuch-mua-pop-to-buffer (message-buffer-name "mail" to) - (or switch-function (notmuch-mua-get-switch-function))) + (or switch-function + (notmuch-mua-get-switch-function))) (let ((headers (append ;; The following is copied from `message-mail' @@ -472,7 +493,8 @@ the From: address." (list (cons 'From (notmuch-mua-prompt-for-sender))))) forward-subject ;; Comes from the first message and is ;; applied later. - forward-references) ;; List of accumulated message-references of forwarded messages + forward-references ;; List of accumulated message-references of forwarded messages + forward-queries) ;; List of corresponding message-query ;; Generate the template for the outgoing message. (notmuch-mua-mail nil "" other-headers nil (notmuch-mua-get-switch-function)) @@ -486,12 +508,14 @@ the From: address." (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)) + (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)) - (push (message-fetch-field "Message-ID") forward-references)) + (push (message-fetch-field "Message-ID") forward-references) + (push id forward-queries)) ;; Make a copy ready to be forwarded in the ;; composition buffer. (message-forward-make-body temp-buffer) @@ -510,6 +534,14 @@ the From: address." (message-add-header (concat "References: " (mapconcat 'identity forward-references " ")))) + ;; Create a buffer-local queue for tag changes triggered when + ;; sending the message. + (when notmuch-message-forwarded-tags + (setq-local notmuch-message-queued-tag-changes + (cl-loop for id in forward-queries + collect + (cons id notmuch-message-forwarded-tags)))) + ;; `message-forward-make-body' shows the User-agent header. Hide ;; it again. (message-hide-headers) @@ -588,10 +620,11 @@ unencrypted. Really send? ")))) (run-hooks 'notmuch-mua-send-hook) (when (and (notmuch-mua-check-no-misplaced-secure-tag) (notmuch-mua-check-secure-tag-has-newline)) - (letf (((symbol-function 'message-do-fcc) #'notmuch-maildir-message-do-fcc)) - (if exit - (message-send-and-exit arg) - (message-send arg))))) + (cl-letf (((symbol-function 'message-do-fcc) + #'notmuch-maildir-message-do-fcc)) + (if exit + (message-send-and-exit arg) + (message-send arg))))) (defun notmuch-mua-send-and-exit (&optional arg) (interactive "P")