From 423641eae24a15573c16e61e388c6df474748b6e Mon Sep 17 00:00:00 2001
From: jao <jao@gnu.org>
Date: Sun, 15 Aug 2021 05:44:23 +0100
Subject: nnnotmuch: there is hope

---
 lib/net/nnnotmuch.el | 289 +++++++++++++++++++++++++--------------------------
 1 file changed, 141 insertions(+), 148 deletions(-)

(limited to 'lib/net')

diff --git a/lib/net/nnnotmuch.el b/lib/net/nnnotmuch.el
index 7aa62eb..a5fe09d 100644
--- a/lib/net/nnnotmuch.el
+++ b/lib/net/nnnotmuch.el
@@ -46,7 +46,41 @@
 
 (nnoo-define-basics nnnotmuch)
 
-(deffoo nnnotmuch-retrieve-headers (sequence &optional group server fetch-old)
+(deffoo nnnotmuch-open-server (server &optional defs)
+  (nnoo-change-server 'nnnotmuch server defs)
+  (setq nnnotmuch-article-files nil)
+  (cond
+   ((not (file-exists-p nnnotmuch-directory))
+    (nnnotmuch-close-server)
+    (nnheader-report 'nnnotmuch "Directory doesn't exist: %s" nnnotmuch-directory))
+   ((not (file-directory-p (file-truename nnnotmuch-directory)))
+    (nnnotmuch-close-server)
+    (nnheader-report 'nnnotmuch "Not a directory: %s" nnnotmuch-directory))
+   (t
+    (nnheader-report 'nnnotmuch "Opened server %s using directory %s"
+		     server nnnotmuch-directory)
+    t)))
+
+(deffoo nnnotmuch-close-server (server)
+  (setq nnnotmuch-article-files nil))
+
+(deffoo nnnotmuch-request-regenerate (server)
+  (setq nnnotmuch-article-files nil)
+  (nnnotmuch--tag "*" "-nnnotmuch")
+  t)
+
+(deffoo nnnotmuch-request-list (&optional _server)
+  (with-current-buffer nntp-server-buffer
+    (erase-buffer)
+    (dolist (s nnnotmuch-saved-searches)
+      (when-let (q (plist-get s :query))
+        (let ((name (plist-get s :name))
+              (total (nnnotmuch--count q)))
+          (insert (format "%s %d 1 y\n" name total))))))
+  t)
+
+(deffoo nnnotmuch-retrieve-headers (sequence &optional group server _fetch-old)
+  (message "retrieving headers for sequence %s" sequence)
   (when (nnnotmuch-set-group-context group server)
     (with-current-buffer nntp-server-buffer
       (erase-buffer)
@@ -59,7 +93,7 @@
 	    'headers
 	  (while sequence
 	    (setq article (car sequence))
-	    (setq file (nnnotmuch-article-to-file article))
+	    (setq file (nnnotmuch-article-to-file article group))
 	    (when (and file
 		       (file-exists-p file)
 		       (not (file-directory-p file)))
@@ -86,189 +120,148 @@
 	  (nnheader-fold-continuation-lines)
 	  'headers)))))
 
-(deffoo nnnotmuch-open-server (server &optional defs)
-  (nnoo-change-server 'nnnotmuch server defs)
-  (cond
-   ((not (file-exists-p nnnotmuch-directory))
-    (nnnotmuch-close-server)
-    (nnheader-report 'nnnotmuch "Directory doesn't exist: %s" nnnotmuch-directory))
-   ((not (file-directory-p (file-truename nnnotmuch-directory)))
-    (nnnotmuch-close-server)
-    (nnheader-report 'nnnotmuch "Not a directory: %s" nnnotmuch-directory))
-   (t
-    (nnheader-report 'nnnotmuch "Opened server %s using directory %s"
-		     server nnnotmuch-directory)
-    t)))
-
-(deffoo nnnotmuch-request-regenerate (server)
-  (nnnotmuch-set-group-context nil server)
-  t)
-
-(deffoo nnnotmuch-request-article (id &optional group server buffer)
-  (nnnotmuch-set-group-context group server)
+(deffoo nnnotmuch-request-article (id &optional group _server buffer)
+  ;; (nnnotmuch-set-group-context group server)
   (let* ((nntp-server-buffer (or buffer nntp-server-buffer))
 	 (file-name-coding-system nnmail-pathname-coding-system)
-	 (path (if (stringp id)
-                   (nnnotmuch--find-message-file id)
-                 (nnnotmuch-article-to-file id))))
+	 (d (nnnotmuch--article-data id group))
+         (id (car d))
+         (file (or (cadr d) (nnnotmuch--find-message-file id))))
     (cond
-     ((not path)
+     ((not file)
       (nnheader-report 'nnnotmuch "No such article: %s" id))
-     ((not (file-exists-p path))
-      (nnheader-report 'nnnotmuch "No such file: %s" path))
-     ((file-directory-p path)
-      (nnheader-report 'nnnotmuch "File is a directory: %s" path))
-     ((not (save-excursion (nnmail-find-file path)))
-      (nnheader-report 'nnnotmuch "Couldn't read file: %s" path))
+     ((not (file-exists-p file))
+      (nnheader-report 'nnnotmuch "No such file: %s" file))
+     ((file-directory-p file)
+      (nnheader-report 'nnnotmuch "File is a directory: %s" file))
+     ((not (save-excursion (nnmail-find-file file)))
+      (nnheader-report 'nnnotmuch "Couldn't read file: %s" file))
      (t
+      (nnnotmuch--tag id "+nnnotmuch")
       (nnheader-report 'nnnotmuch "Article %s retrieved" id)
       (cons group id)))))
 
-(deffoo nnnotmuch-request-group (group &optional server _dont-check info)
-  (cond
-   ((not (nnnotmuch-set-group-context group server))
-    (nnheader-report 'nnnotmuch "Invalid group"))
-   (t
-    (let* ((info (or info (gnus-get-info group)))
-           (num-headers (length nnnotmuch-article-files))
-           (status (format "211 %d %d %d %s" num-headers 1 num-headers group)))
-      (with-current-buffer nntp-server-buffer
-        (erase-buffer)
-        (nnheader-insert "%s\n" status)
-        ;; (when info
-        ;;   (gnus-info-set-marks
-        ;;    info
-        ;;    (append (assq-delete-all 'seen (gnus-info-marks info))
-        ;;            (list `(seen (1 . ,num-headers))))
-        ;;    t))
-        ))
-    t)))
-
-(deffoo nnnotmuch-request-group-scan (group &optional server info)
-  (setq nnnotmuch-article-files nil)
-  (nnnotmuch-set-group-context group server)
-  (gnus-get-unread-articles-in-group
-   (or info (gnus-get-info gnus-newsgroup-name))
-   (gnus-active (gnus-info-group info))))
+(deffoo nnnotmuch-request-expire-articles (articles group &optional _server _force)
+  (let ((excluded) (ids))
+    (dolist (a articles)
+      (if-let (id (car (nnnotmuch--article-data a group)))
+          (push id ids)
+        (push a excluded)))
+    (when ids
+      (nnnotmuch--tag (mapconcat #'identity ids " OR ") "+deleted +nnnotmuch"))
+    excluded))
+
+;; (deffoo nnnotmuch-request-move-article
+;;     (article group server accept-form &optional last _move-is-internal)
+;;   (error "Not implemented yet"))
+
+(deffoo nnnotmuch-request-group (group &optional server _dont-check _info)
+  (message "opening %s" group)
+  (if (nnnotmuch-set-group-context group server)
+      (let ((n (length (cdr (assoc group nnnotmuch-article-files)))))
+        (message "we found here %s articles" n)
+        (with-current-buffer nntp-server-buffer
+          (erase-buffer)
+          (nnheader-insert "211 %d %d %d %s\n" n 1 n group)
+          n))
+    (message "we didn't find anything!!")
+    (nnheader-report 'nnnotmuch "Invalid group")))
+
+(deffoo nnnotmuch-request-group-scan (group &optional server _info)
+  (nnnotmuch-set-group-context group server))
 
 (deffoo nnnotmuch-request-scan (&optional group server)
   (nnnotmuch-set-group-context group server))
 
 (deffoo nnnotmuch-close-group (_group &optional _server)
-  (setq nnnotmuch-article-files nil)
   t)
 
-(deffoo nnnotmuch-request-create-group (group &optional server _args)
-  (nnnotmuch-set-group-context nil server)
-  (nnmail-activate 'nnnotmuch)
-  (error "Not implemented yet"))
-
-(deffoo nnnotmuch-request-list (&optional _server)
-  (with-current-buffer nntp-server-buffer
-    (erase-buffer)
-    (dolist (s nnnotmuch-saved-searches)
-      (when-let (q (plist-get s :query))
-        (let* ((name (plist-get s :name))
-               (total (nnnotmuch--count-files q))
-               (new (nnnotmuch--count-files q t))
-               (first (1+ (- total new))))
-          (insert (format "%s %d %d y\n" name total first))))))
-  t)
+(deffoo nnnotmuch-request-create-group (group &optional _server _args)
+  (let ((query (read-string "Query: ")))
+    (add-to-list 'nnnotmuch-saved-searches `(:name ,group :query ,query))))
 
 (deffoo nnnotmuch-request-newgroups (_date &optional server)
   (nnnotmuch-request-list server))
 
-(deffoo nnnotmuch-request-list-newsgroups (&optional _server)
-  nil)
-
-(deffoo nnnotmuch-request-expire-articles (articles group &optional server force)
-  (nnnotmuch-set-group-context group server)
-  (when (eq 'delete nnmail-expiry-target)
-    (error "Not implemented yet")))
-
-(deffoo nnnotmuch-request-move-article
-    (article group server accept-form &optional last _move-is-internal)
-  (error "Not implemented yet"))
-
-(deffoo nnnotmuch-request-accept-article (group &optional server last)
-  (error "Not implemented yet"))
-
-(deffoo nnnotmuch-request-post (&optional server)
-  (nnmail-do-request-post 'nnnotmuch-request-accept-article server))
-
-(deffoo nnnotmuch-request-update-info (group info &optional server)
-  (when-let (n (nnnotmuch--count-files (nnnotmuch--find-query group)))
-    (gnus-set-active (gnus-group-prefixed-name group `(nnnotmuch ,server))
-                     (cons 1 n))))
-
-(deffoo nnnotmuch-request-replace-article (article group buffer)
-  (error "Not implemented yet"))
-
-(deffoo nnnotmuch-request-delete-group (group &optional force server)
-  (error "Not implemented yet"))
-
-(deffoo nnnotmuch-request-rename-group (group new-name &optional server)
-  (error "Not implemented yet"))
-
-(deffoo nnnotmuch-set-status (article name value &optional group server)
-  (nnnotmuch-set-group-context group server)
-  (let ((file (nnnotmuch-article-to-file article)))
-    (cond
-     ((not (file-exists-p file))
-      (nnheader-report 'nnnotmuch "File %s does not exist" file))
-     (t
-      (message "Setting status %s to %s" name value)
-      ;; (with-temp-file file
-      ;;   (nnheader-insert-file-contents file)
-      ;;   (nnmail-replace-status name value))
-      t))))
+;; (deffoo nnnotmuch-request-rename-group (group new-name &optional _server)
+;;   (error "Not implemented yet"))
 
 
 
 (defvar nnnotmuch-article-files nil)
 
-(defun nnnotmuch-article-to-file (article)
-  (when (numberp article)
-    (elt nnnotmuch-article-files (1- article))))
-
 (defun nnnotmuch--find-query (name)
   (when-let (s (seq-find (lambda (s) (string= (plist-get s :name) name))
                          nnnotmuch-saved-searches))
     (plist-get s :query)))
 
-(defun nnnotmuch--find-group-message-ids (group &optional search)
-  (when-let (q (or search (nnnotmuch--find-query group)))
-    (notmuch-query-get-message-ids q)))
-
 (defun nnnotmuch--find-message-file (id)
-  (let ((q (notmuch-id-to-query id)))
-    (string-trim
-     (shell-command-to-string
-      (format "notmuch search --output=files %s" q)))))
-
-(defun nnnotmuch--count-files (query &optional unread)
-  (let ((cmd (format "notmuch count --output=files -- %s%s"
-                     (shell-quote-argument (format "(%s)" query))
-                     (if unread " AND tag:unread" ""))))
+  (car (split-string
+        (shell-command-to-string
+         (format "notmuch search --output=files %s"
+                 (if (string-prefix-p "id:" id) id (concat "id:" id)))))))
+
+(defun nnnotmuch--article-data (article group)
+  (cond ((stringp article) (list article))
+        ((numberp article)
+         (when-let (data (cdr (assoc group nnnotmuch-article-files)))
+           (elt data (1- article))))))
+
+(defun nnnotmuch-article-to-file (article group)
+  (when-let (d (nnnotmuch--article-data article group))
+    (or (cadr d) (nnnotmuch--find-message-file (car d)))))
+
+(defun nnnotmuch--count (query &optional context)
+  (let ((cmd (format "notmuch count -- '(%s)%s'"
+                     query
+                     (if context (concat " AND " context) ""))))
     (string-to-number (shell-command-to-string cmd))))
 
-(defun nnnotmuch--query-files (query)
-  (let ((cmd (format "notmuch search --sort=oldest-first --output=files -- %s"
-                     (shell-quote-argument query))))
+(defun nnnotmuch--search (query &optional context)
+  (let ((cmd (format "notmuch search --sort=oldest-first --output=messages -- %s%s"
+                     (shell-quote-argument (format "(%s)" query))
+                     (if context (concat " AND " context) ""))))
     (split-string (shell-command-to-string cmd))))
 
-(defun nnnotmuch--find-group-files (group)
-  (when-let (q (nnnotmuch--find-query group))
-    (nnnotmuch--query-files q)))
+(defun nnnotmuch--tag (query tags)
+  (let ((cmd (format "notmuch tag %s -- '(%s)'" tags query)))
+    (shell-command-to-string cmd)))
+
+(defun nnnotmuch--ids-query (ids) (mapconcat #'identity ids " OR "))
+
+(defun nnnotmuch--init-data (full-group query)
+  (nnnotmuch--tag (concat query " AND NOT tag:new AND not tag:nnnotmuch")
+                  "+nnnotmuch")
+  (let* ((ids (nnnotmuch--search query "tag:nnnotmuch"))
+         (info (gnus-get-info full-group))
+         (read (when (> (length ids) 0) (list (cons 1 (length ids)))))
+         (marks (list (cons 'seen read))))
+    (gnus-info-set-marks info marks)
+    (setf (gnus-info-read info) read)
+    (gnus-set-info full-group info)
+    (message "group %s - %s" full-group (gnus-get-info full-group))
+    (mapcar #'list ids)))
+
+(defun nnnotmuch--set-group-data (group data)
+  (setf (alist-get group nnnotmuch-article-files nil t #'string=) data))
 
 (defun nnnotmuch-set-group-context (group &optional server)
-  (when (and server
-	     (not (nnnotmuch-server-opened server)))
+  (when (and server (not (nnnotmuch-server-opened server)))
     (nnnotmuch-open-server server))
-  (setq nnnotmuch-current-group group
-	nnnotmuch-article-files (nnnotmuch--find-group-files group))
-  t)
-
+  (when-let (query (nnnotmuch--find-query group))
+    (setq nnnotmuch-current-group group)
+    (let* ((full-group (gnus-group-prefixed-name group `(nnnotmuch ,server)))
+           (data (or (cdr (assoc group nnnotmuch-article-files))
+                     (nnnotmuch--init-data full-group query)))
+           (ids (nnnotmuch--search query "tag:new AND NOT tag:nnnotmuch"))
+           (new-data (mapcar (lambda (id)
+                               (list id (nnnotmuch--find-message-file id)))
+                             ids)))
+      (when (> (length ids) 0)
+        (nnnotmuch--tag (nnnotmuch--ids-query ids) "-new"))
+      (nnnotmuch--set-group-data group (append data new-data))
+      (gnus-set-active (gnus-group-prefixed-name group `(nnnotmuch ,server))
+                       (cons 1 (+ (length new-data) (length data)))))))
 
 
 
-- 
cgit v1.2.3