From 1763647df5586d9b488f37c20721877039abe215 Mon Sep 17 00:00:00 2001
From: jao <jao@gnu.org>
Date: Mon, 16 Aug 2021 13:25:39 +0100
Subject: nnnm: clean ups, basics working

---
 lib/net/nnnm.el | 275 ++++++++++++++++++++++++++------------------------------
 1 file changed, 126 insertions(+), 149 deletions(-)

(limited to 'lib')

diff --git a/lib/net/nnnm.el b/lib/net/nnnm.el
index 173c975..3df1386 100644
--- a/lib/net/nnnm.el
+++ b/lib/net/nnnm.el
@@ -28,17 +28,96 @@
 (require 'nnheader)
 (require 'nnmail)
 (require 'nnoo)
-(require 'notmuch)
+
 
 (nnoo-declare nnnm)
 
-(defvoo nnnm-directory message-directory
-  "Spool directory for the nnnm mail backend.")
+(defvoo nnnm-saved-searches nil)
 
-(defvoo nnnm-inhibit-expiry nil
-  "If non-nil, inhibit expiry.")
+(defvar nnnm-maildir nil)
 
-(defvoo nnnm-saved-searches nil)
+
+
+(defvar nnnm--group-data nil)
+
+(defun nnnm--group-data (group) (cdr (assoc group nnnm--group-data)))
+
+(defun nnnm--set-group-data (group data)
+  (setf (alist-get group nnnm--group-data nil t #'string=) data))
+
+
+(defun nnnm--find-query (name)
+  (when-let (s (seq-find (lambda (s) (string= (plist-get s :name) name))
+                         nnnm-saved-searches))
+    (plist-get s :query)))
+
+(defun nnnm--find-message-file (id)
+  (car (split-string
+        (shell-command-to-string
+         (format "notmuch search --output=files %s"
+                 (if (string-prefix-p "id:" id) id (concat "id:" id)))))))
+
+(defun nnnm--article-data (article group)
+  (cond ((stringp article) (list article))
+        ((numberp article)
+         (when-let (data (nnnm--group-data group))
+           (elt data (1- article))))))
+
+(defun nnnm-article-to-file (article group)
+  (when-let (d (nnnm--article-data article group))
+    (or (cadr d) (nnnm--find-message-file (car d)))))
+
+(defun nnnm--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 nnnm--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 nnnm--tag (query tags)
+  (let ((cmd (format "notmuch tag %s -- '(%s)'" tags query)))
+    (shell-command-to-string cmd)))
+
+(defun nnnm--ids-query (ids) (mapconcat #'identity ids " OR "))
+
+(defun nnnm--init-group-data (full-group query)
+  (nnnm--tag (concat query " AND NOT tag:new AND not tag:nnnm") "+new")
+  (let* ((ids (nnnm--search query "tag:nnnm"))
+         (nids (length ids))
+         (info (gnus-get-info full-group))
+         (read (when (> nids 0) (list (cons 1 nids))))
+         (marks (list (cons 'seen read))))
+    (message "*** group info before %s - %s" full-group (gnus-get-info full-group))
+    (gnus-info-set-marks info marks)
+    (setf (gnus-info-read info) read)
+    (gnus-set-info full-group info)
+    (message "*** group info after %s" (gnus-get-info full-group))
+    (mapcar #'list ids)))
+
+(defun nnnm--update-group-data (group &optional server)
+  ;; (when (and server (not (nnnm-server-opened server)))
+  ;;   (nnnm-open-server server))
+  (when-let (query (nnnm--find-query group))
+    (let* ((full-group (gnus-group-prefixed-name group `(nnnm ,server)))
+           (data (or (nnnm--group-data group)
+                     (nnnm--init-group-data full-group query)))
+           (ids (nnnm--search query "tag:new AND NOT tag:nnnm"))
+           (nids (length ids))
+           (new-data (mapcar (lambda (id)
+                               (list id (nnnm--find-message-file id)))
+                             ids)))
+      (when (> nids 0)
+        (nnnm--tag (nnnm--ids-query ids) "-new")
+        (nnheader-report 'nnnm "%s: %d new messages retrieved" group nids))
+      (nnnm--set-group-data group (append data new-data))
+      (gnus-set-active (gnus-group-prefixed-name group `(nnnm ,server))
+                       (cons 1 (+ nids (length data))))
+      (length ids))))
 
 
 
@@ -48,24 +127,18 @@
 
 (deffoo nnnm-open-server (server &optional defs)
   (nnoo-change-server 'nnnm server defs)
-  (setq nnnm-article-files nil)
-  (cond
-   ((not (file-exists-p nnnm-directory))
-    (nnnm-close-server)
-    (nnheader-report 'nnnm "Directory doesn't exist: %s" nnnm-directory))
-   ((not (file-directory-p (file-truename nnnm-directory)))
-    (nnnm-close-server)
-    (nnheader-report 'nnnm "Not a directory: %s" nnnm-directory))
-   (t
-    (nnheader-report 'nnnm "Opened server %s using directory %s"
-		     server nnnm-directory)
-    t)))
-
-(deffoo nnnm-close-server (server)
-  (setq nnnm-article-files nil))
-
-(deffoo nnnm-request-regenerate (server)
-  (setq nnnm-article-files nil)
+  (setq nnnm--group-data nil)
+  ;; (when (and nnnm-maildir (file-exists-p nnnm-maildir))
+  ;;     )
+  (message "defs: %s" defs)
+  (nnheader-report 'nnnm "Opened server %s using maildir %s" server nnnm-maildir)
+  t)
+
+(deffoo nnnm-close-server (_server)
+  (setq nnnm--group-data nil))
+
+(deffoo nnnm-request-regenerate (_server)
+  (setq nnnm--group-data nil)
   (nnnm--tag "*" "-nnnm")
   t)
 
@@ -73,72 +146,52 @@
   (with-current-buffer nntp-server-buffer
     (erase-buffer)
     (dolist (s nnnm-saved-searches)
-      (when-let (q (plist-get s :query))
+      (when-let (query (plist-get s :query))
         (let ((name (plist-get s :name))
-              (total (nnnm--count q)))
+              (total (nnnm--count query)))
           (insert (format "%s %d 1 y\n" name total))))))
   t)
 
 (deffoo nnnm-retrieve-headers (sequence &optional group server _fetch-old)
-  (message "retrieving headers for sequence %s" sequence)
-  (when (nnnm-set-group-context group server)
+  (when (nnnm--update-group-data group server)
     (with-current-buffer nntp-server-buffer
-      (erase-buffer)
-      (let* ((file nil)
-	     (number (length sequence))
-	     (count 0)
-	     (file-name-coding-system nnmail-pathname-coding-system)
-	     beg article)
+      (delete-region (point-min) (point-max))
+      (let ((file-name-coding-system nnmail-pathname-coding-system)
+	    (count -1))
 	(if (stringp (car sequence))
 	    'headers
-	  (while sequence
-	    (setq article (car sequence))
-	    (setq file (nnnm-article-to-file article group))
-	    (when (and file
-		       (file-exists-p file)
-		       (not (file-directory-p file)))
+          (dolist (article sequence)
+            (when-let (file (nnnm-article-to-file article group))
 	      (insert (format "221 %d Article retrieved.\n" article))
-	      (setq beg (point))
-	      (nnheader-insert-head file)
-	      (goto-char beg)
+              (save-excursion (nnheader-insert-head file))
 	      (if (re-search-forward "\n\r?\n" nil t)
 		  (forward-char -1)
 		(goto-char (point-max))
 		(insert "\n\n"))
 	      (insert ".\n")
 	      (delete-region (point) (point-max)))
-	    (setq sequence (cdr sequence))
-	    (setq count (1+ count))
-	    (and (numberp nnmail-large-newsgroup)
-		 (> number nnmail-large-newsgroup)
-		 (zerop (% count 20))
-		 (nnheader-message 6 "nnnm: Receiving headers... %d%%"
-				   (floor (* count 100.0) number))))
-          (and (numberp nnmail-large-newsgroup)
-		 (> number nnmail-large-newsgroup)
-		 (nnheader-message 6 "nnml: Receiving headers...done"))
-	  (nnheader-fold-continuation-lines)
+            (when (zerop (% (cl-incf count) 20))
+	      (nnheader-message 6 "nnnm: Receiving headers... %d%%"
+				(floor (* count 100.0) (length sequence)))))
+          (nnheader-fold-continuation-lines)
 	  'headers)))))
 
 (deffoo nnnm-request-article (id &optional group _server buffer)
-  ;; (nnnm-set-group-context group server)
   (let* ((nntp-server-buffer (or buffer nntp-server-buffer))
 	 (file-name-coding-system nnmail-pathname-coding-system)
 	 (d (nnnm--article-data id group))
          (id (car d))
-         (file (or (cadr d) (nnnm--find-message-file id))))
+         (file (when id (or (cadr d) (nnnm--find-message-file id)))))
     (cond
      ((not file)
       (nnheader-report 'nnnm "No such article: %s" id))
      ((not (file-exists-p file))
       (nnheader-report 'nnnm "No such file: %s" file))
-     ((file-directory-p file)
-      (nnheader-report 'nnnm "File is a directory: %s" file))
      ((not (save-excursion (nnmail-find-file file)))
       (nnheader-report 'nnnm "Couldn't read file: %s" file))
      (t
       (nnnm--tag id "+nnnm")
-      (nnheader-report 'nnnm "Article %s retrieved" id)
+      (nnheader-report 'nnnm "Article %s retrieved and tagged" id)
       (cons group id)))))
 
 (deffoo nnnm-request-expire-articles (articles group &optional _server _force)
@@ -148,120 +201,44 @@
           (push id ids)
         (push a excluded)))
     (when ids
-      (nnnm--tag (mapconcat #'identity ids " OR ") "+deleted +nnnm"))
+      (nnnm--tag (nnnm--ids-query ids) "+deleted +nnnm"))
     excluded))
 
 ;; (deffoo nnnm-request-move-article
 ;;     (article group server accept-form &optional last _move-is-internal)
 ;;   (error "Not implemented yet"))
 
-(deffoo nnnm-request-group (group &optional server _dont-check _info)
-  (message "opening %s" group)
-  (if (nnnm-set-group-context group server)
-      (let ((n (length (cdr (assoc group nnnm-article-files)))))
-        (message "we found here %s articles" n)
+(deffoo nnnm-request-group (group &optional server _dont-check info)
+  (nnheader-message 7 "nnnm: Opening %s -- %s" info group)
+  (if (nnnm--update-group-data group server)
+      (let ((n (length (nnnm--group-data group))))
         (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 'nnnm "Invalid group")))
 
+(deffoo nnnm-request-newgroups (_date &optional server)
+  (nnnm-request-list server))
+
 (deffoo nnnm-request-group-scan (group &optional server _info)
-  (nnnm-set-group-context group server))
+  (nnnm--set-group-data group nil)
+  (nnnm--update-group-data group server))
 
 (deffoo nnnm-request-scan (&optional group server)
-  (nnnm-set-group-context group server))
-
-(deffoo nnnm-close-group (_group &optional _server)
-  t)
+  (if group
+      (nnnm--update-group-data group server)
+    (setq nnnm--group-data nil)))
 
 (deffoo nnnm-request-create-group (group &optional _server _args)
   (let ((query (read-string "Query: ")))
     (add-to-list 'nnnm-saved-searches `(:name ,group :query ,query))))
 
-(deffoo nnnm-request-newgroups (_date &optional server)
-  (nnnm-request-list server))
-
 ;; (deffoo nnnm-request-rename-group (group new-name &optional _server)
 ;;   (error "Not implemented yet"))
 
-
-
-(defvar nnnm-article-files nil)
-
-(defun nnnm--find-query (name)
-  (when-let (s (seq-find (lambda (s) (string= (plist-get s :name) name))
-                         nnnm-saved-searches))
-    (plist-get s :query)))
-
-(defun nnnm--find-message-file (id)
-  (car (split-string
-        (shell-command-to-string
-         (format "notmuch search --output=files %s"
-                 (if (string-prefix-p "id:" id) id (concat "id:" id)))))))
-
-(defun nnnm--article-data (article group)
-  (cond ((stringp article) (list article))
-        ((numberp article)
-         (when-let (data (cdr (assoc group nnnm-article-files)))
-           (elt data (1- article))))))
-
-(defun nnnm-article-to-file (article group)
-  (when-let (d (nnnm--article-data article group))
-    (or (cadr d) (nnnm--find-message-file (car d)))))
-
-(defun nnnm--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 nnnm--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))))
+(deffoo nnnm-close-group (_group &optional _server) t)
 
-(defun nnnm--tag (query tags)
-  (let ((cmd (format "notmuch tag %s -- '(%s)'" tags query)))
-    (shell-command-to-string cmd)))
-
-(defun nnnm--ids-query (ids) (mapconcat #'identity ids " OR "))
-
-(defun nnnm--init-data (full-group query)
-  (nnnm--tag (concat query " AND NOT tag:new AND not tag:nnnm")
-                  "+nnnm")
-  (let* ((ids (nnnm--search query "tag:nnnm"))
-         (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 nnnm--set-group-data (group data)
-  (setf (alist-get group nnnm-article-files nil t #'string=) data))
-
-(defun nnnm-set-group-context (group &optional server)
-  (when (and server (not (nnnm-server-opened server)))
-    (nnnm-open-server server))
-  (when-let (query (nnnm--find-query group))
-    (setq nnnm-current-group group)
-    (let* ((full-group (gnus-group-prefixed-name group `(nnnm ,server)))
-           (data (or (cdr (assoc group nnnm-article-files))
-                     (nnnm--init-data full-group query)))
-           (ids (nnnm--search query "tag:new AND NOT tag:nnnm"))
-           (new-data (mapcar (lambda (id)
-                               (list id (nnnm--find-message-file id)))
-                             ids)))
-      (when (> (length ids) 0)
-        (nnnm--tag (nnnm--ids-query ids) "-new"))
-      (nnnm--set-group-data group (append data new-data))
-      (gnus-set-active (gnus-group-prefixed-name group `(nnnm ,server))
-                       (cons 1 (+ (length new-data) (length data)))))))
 
 
 
-- 
cgit v1.2.3