;;; Code:
+(eval-when-compile (require 'cl-lib))
+
(require 'message)
(require 'mm-view)
(require 'format-spec)
(require 'notmuch-draft)
(require 'notmuch-message)
-(eval-when-compile (require 'cl))
-
(declare-function notmuch-show-insert-body "notmuch-show" (msg body depth))
(declare-function notmuch-fcc-header-setup "notmuch-maildir-fcc" ())
(declare-function notmuch-maildir-message-do-fcc "notmuch-maildir-fcc" ())
"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)
;;
;; 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)
(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
;; 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)
;; 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))))))
+ (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)
(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)
(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))
;; 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)
(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)
(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")
projects / notmuch / blobdiff