summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
authorjao <jao@gnu.org>2022-03-11 21:18:32 +0000
committerjao <jao@gnu.org>2022-03-11 21:18:32 +0000
commit30d591f40939dfa2fa3a3b5aee9e666b7686b87b (patch)
treef280cac3a6553e90b9093b87d05a7ecc00e7d76e
parent725a83f63836cc98a64285ed6dc31da3ccc99858 (diff)
downloadelibs-30d591f40939dfa2fa3a3b5aee9e666b7686b87b.tar.gz
elibs-30d591f40939dfa2fa3a3b5aee9e666b7686b87b.tar.bz2
automatic notmuch tagging on gnus' moves
-rw-r--r--gnus.org10
-rw-r--r--lib/net/jao-notmuch-gnus.el46
2 files changed, 38 insertions, 18 deletions
diff --git a/gnus.org b/gnus.org
index a907ccf..2fd5d99 100644
--- a/gnus.org
+++ b/gnus.org
@@ -531,16 +531,10 @@
(gnus-summary-goto-article (cdr jao-gnus--last-move) nil t)))
(add-hook 'gnus-summary-article-move-hook 'jao-gnus-move-hook)
- (defun jao-gnus--tag-archiving ()
- (when (string-match ".+:\\(.+\\)" jao-gnus--archiving-group)
- (let ((tags (match-string 1 jao-gnus--archiving-group)))
- (jao-notmuch-gnus-toggle-tags (split-string tags "\\.")))))
-
(defun jao-gnus-archive (follow)
(interactive "P")
(if jao-gnus--archiving-group
(progn
- (jao-gnus--tag-archiving)
(if (or jao-gnus--archive-as-copy-p
(not (gnus-check-backend-function
'request-move-article gnus-newsgroup-name)))
@@ -648,7 +642,9 @@
;; no html in From: (washing articles from arxiv feeds) and cleaning up
;; addresses
(require 'shr)
- (defvar jao-gnus--from-rx (concat "From: \\\"?\\( " jao-gnus--news-rx "\\)"))
+ (defvar jao-gnus--from-rx
+ (concat "From: \\\"?\\( " jao-gnus--news-rx "\\)"))
+
(defun jao-gnus-remove-anchors ()
(save-excursion
(goto-char (point-min))
diff --git a/lib/net/jao-notmuch-gnus.el b/lib/net/jao-notmuch-gnus.el
index 8b4b9be..4bc86c4 100644
--- a/lib/net/jao-notmuch-gnus.el
+++ b/lib/net/jao-notmuch-gnus.el
@@ -30,16 +30,17 @@
;;; Tagging in notmuch from Gnus buffers
-(defun jao-notmuch-gnus-message-id ()
+
+(defun jao-notmuch-gnus--notmuch-id (id)
+ (when id (if (string-match "<\\(.+\\)>" id) (match-string 1 id) id)))
+
+(defun jao-notmuch-gnus-message-id (&optional no-show)
"Find the id of currently selected message in Gnus or notmuch."
- (when (derived-mode-p 'gnus-summary-mode)
+ (when (and (not no-show) (derived-mode-p 'gnus-summary-mode))
(save-window-excursion (gnus-summary-show-article)))
(cond (gnus-original-article-buffer
(with-current-buffer gnus-original-article-buffer
- (when-let (id (message-field-value "message-id"))
- (if (string-match "<\\(.+\\)>" id)
- (match-string 1 id)
- id))))
+ (jao-notmuch-gnus--notmuch-id (message-field-value "message-id"))))
((derived-mode-p 'notmuch-show-mode 'notmuch-tree-mode)
(notmuch-show-get-message-id))))
@@ -48,15 +49,16 @@
(let ((cmd (format "notmuch search --output=tags 'id:%s'" id)))
(split-string (shell-command-to-string cmd))))
-(defun jao-notmuch-gnus-tag-message (&optional id tags)
+(defun jao-notmuch-gnus-tag-message (&optional id tags no-log)
"Interactively add or remove tags to the current message."
(interactive)
(let* ((id (or id (jao-notmuch-gnus-message-id)))
- (current (jao-notmuch-gnus-message-tags id))
+ (current (unless tags (jao-notmuch-gnus-message-tags id)))
(prompt (format "Change tags %s" (string-join current "/")))
(tags (or tags (notmuch-read-tag-changes current prompt))))
(notmuch-tag (concat "id:" id) tags)
- (message "%s -> %s" current (jao-notmuch-gnus-message-tags id))))
+ (unless no-log
+ (message "%s -> %s" current (jao-notmuch-gnus-message-tags id)))))
(defun jao-notmuch-gnus-show-tags ()
"Display in the echo area the tags of the current message."
@@ -64,9 +66,9 @@
(when-let (id (jao-notmuch-gnus-message-id))
(message "%s" (string-join (jao-notmuch-gnus-message-tags id) " "))))
-(defun jao-notmuch-gnus-toggle-tags (tags)
+(defun jao-notmuch-gnus-toggle-tags (tags &optional id)
"Toggle the given TAGS list for the current Gnus message."
- (let* ((id (jao-notmuch-gnus-message-id))
+ (let* ((id (or id (jao-notmuch-gnus-message-id)))
(current (jao-notmuch-gnus-message-tags id))
(tags (mapcar (lambda (x)
(concat (if (member x current) "-" "+") x))
@@ -74,6 +76,28 @@
(notmuch-tag (concat "id:" id) tags)
(message "New tags: %s" (jao-notmuch-gnus-message-tags id))))
+(defun jao-notmuch-gnus-tag-mark ()
+ "Remove the new tag for an article when it's marked as seen by Gnus."
+ (when-let (id (jao-notmuch-gnus-message-id t))
+ (jao-notmuch-gnus-tag-message id '("-new") t)))
+
+(add-hook 'gnus-mark-article-hook #'jao-notmuch-gnus-tag-mark)
+
+(defun jao-notmuch-gnus--group-tags (group)
+ (when (string-match ".+:\\(.+\\)" group)
+ (split-string (match-string 1 group) "\\.")))
+
+(defun jao-notmuch-gnus-tag-on-move (operation headers from to d)
+ (when-let (id (and to (jao-notmuch-gnus--notmuch-id (mail-header-id headers))))
+ (when-let* ((to-tags (jao-notmuch-gnus--group-tags to))
+ (from-tags (jao-notmuch-gnus--group-tags from))
+ (new-tags (seq-difference to-tags from-tags))
+ (new-tags (mapcar (lambda (x) (concat "+" x)) new-tags)))
+ (notmuch-tag (concat "id:" id) new-tags))))
+
+(add-hook 'gnus-summary-article-move-hook #'jao-notmuch-gnus-tag-on-move)
+(add-hook 'gnus-summary-article-expire-hook #'jao-notmuch-gnus-tag-on-move)
+
;;;; Displaying search results in Gnus