ambevar-dotfiles/.emacs.d/lisp/patch-notmuch.el

72 lines
3.0 KiB
EmacsLisp

(require 'notmuch-message)
(defun ambrevar/org-notmuch-get (field &optional name)
"Return list of emails from FIELD ready for Org capture.
With NAME, return name instead."
(when field
(mapconcat (if name #'car #'cadr) (mail-extract-address-components field 'all) "|")))
;; TODO: Report org-notmuch-store-link upstream.
(defun org-notmuch-store-link ()
"Store a link to a notmuch search or message."
(when (or (eq major-mode 'notmuch-show-mode)
(eq major-mode 'notmuch-tree-mode))
(let* ((message-id (notmuch-show-get-message-id t))
(subject (notmuch-show-get-subject))
(to (notmuch-show-get-to))
(cc (notmuch-show-get-cc))
(from (notmuch-show-get-from))
(date (org-trim (notmuch-show-get-date)))
desc link)
(org-store-link-props :type "notmuch" :from from :to to :date date
:subject subject :message-id message-id
:to-names (ambrevar/org-notmuch-get to 'name)
:to-addresses (ambrevar/org-notmuch-get to)
:cc-names (ambrevar/org-notmuch-get cc 'name)
:cc-addresses (ambrevar/org-notmuch-get cc))
(setq desc (org-email-link-description))
(setq link (concat "notmuch:id:" message-id))
(org-add-link-props :link link :description desc)
link)))
;; From https://notmuchmail.org/pipermail/notmuch/2018/026423.html
;; attachment checks
;;
;; should be sent upstream, but needs unit tests in test/T310-emacs.sh
(defcustom notmuch-message-attach-regex
"\\b\\(attache\?ment\\|attached\\|attach\\|pi[èe]ce\s+jointe?\\)\\b"
"Pattern of text announcing there should be an attachment.
This is used by `notmuch-message-check-attach' to check email
bodies for words that might indicate the email should have an
attachement. If the pattern matches and there is no attachment (a
`<#part ...>' magic block), notmuch will show a confirmation
prompt before sending the email.
The default regular expression is deliberately liberal: we prefer
false positive than forgotten attachments. This should be
customized for non-english languages and notmuch welcomes
additions to the pattern for your native language, unless it
conflicts with common words in other languages."
:type '(regexp)
:group 'notmuch-send)
(defun notmuch-message-check-attach ()
"""Check for missing attachments.
This is normally added to `message-send-hook' and is configured
through `notmuch-message-attach-regex'."""
(save-excursion ;; XXX: this fails somehow: point is at the end of the buffer on error
(goto-char (point-min))
(if (re-search-forward notmuch-message-attach-regex nil t)
(progn
(goto-char (point-min))
(unless (re-search-forward "<#part [^>]*filename=[^>]*>" nil t)
(or (y-or-n-p "Email seem to refer to attachment, but nothing attached, send anyways?")
(error "No attachment found, aborting")))))))
(add-hook 'message-send-hook 'notmuch-message-check-attach)
(provide 'patch-notmuch)