mirrors
/
ambevar-dotfiles
mirror of https://gitlab.com/ambrevar/dotfiles/
1
0
Fork 0
Code Issues Releases Wiki Activity

Notmuch: Generalize Yhetil matching.

master
Pierre Neidhardt 2020-12-01 10:09:22 +01:00
parent 5c9da660cb
commit 107d5f5212
1 changed files with 22 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
.emacs.d/lisp/init-notmuch.el
View File

@ -115,49 +115,39 @@
;; Extend `notmuch-show-stash-mlarchive-link':
(defvar ambrevar/known-mailing-list-archives
'(("help-guix@gnu.org" . "guix-user")
("guix-devel@gnu.org" . "guix-devel")
("debbugs.gnu.org" . "guix-bugs"))
'(("help-guix@gnu.org" . "guix")
("guix-devel@gnu.org" . "guix")
("debbugs.gnu.org" . "guix"))
"Alist of mail adresses and their Yhetil name.
Alternatively the key may just be a host name against which a
recipient will be matched.")
(defun ambrevar/guess-yhetil-link (message-id)
(let* ((all-addresses
(mapcar #'second
(mail-extract-address-components
(mapconcat #'identity
(list
(notmuch-show-get-header :To)
(notmuch-show-get-header :Cc))
", ")
'all)))
(mailing-list
(cdr (seq-find
(lambda (pair)
(let ((address-or-host (car pair)))
(if (string-match "@" address-or-host)
(member address-or-host all-addresses)
(seq-find (lambda (address)
(string-match address-or-host address))
all-addresses))))
ambrevar/known-mailing-list-archives))))
(let* ((all-addresses (mapcar #'second
(mail-extract-address-components
(mapconcat #'identity
(list
(notmuch-show-get-header :To)
(notmuch-show-get-header :Cc))
", ")
'all)))
(match-address (lambda (address-or-host)
(if (string-match "@" address-or-host)
(member address-or-host all-addresses)
(seq-find (lambda (address)
(string-match address-or-host address))
all-addresses))))
(mailing-list (alist-get
(seq-find match-address
(mapcar #'car ambrevar/known-mailing-list-archives))
ambrevar/known-mailing-list-archives
nil nil #'string=)))
(when mailing-list
(concat "https://yhetil.org/"
mailing-list "/" message-id))))
(defun ambrevar/guess-yhetil-link-prefer-patches (message-id)
(let ((ambrevar/known-mailing-list-archives
(copy-alist
ambrevar/known-mailing-list-archives)))
(push '("debbugs.gnu.org" . "guix-patches")
ambrevar/known-mailing-list-archives)
(ambrevar/guess-yhetil-link message-id)))
(add-to-list 'notmuch-show-stash-mlarchive-link-alist
(cons "Yhetil" #'ambrevar/guess-yhetil-link))
(add-to-list 'notmuch-show-stash-mlarchive-link-alist
(cons "Yhetil/patches" #'ambrevar/guess-yhetil-link-prefer-patches))
(setq notmuch-show-stash-mlarchive-link-default "Yhetil")