nnnm: rock bottom

1 files changed, 46 insertions, 32 deletions

diff --git a/lib/net/nnnm.el b/lib/net/nnnm.el
index b5f4fe0..552e95c 100644
--- a/lib/net/nnnm.el
+++ b/lib/net/nnnm.el
@@ -85,26 +85,42 @@
 
 (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))))
+(defun nnnm--prefixed (group server)
+  (gnus-group-prefixed-name group `(nnnm ,server)))
+
+(defun nnnm--get-group-marks (group server)
+  (gnus-info-marks (gnus-get-info (nnnm--prefixed group server))))
+
+(defun nnnm--set-group-marks (marks group server)
+  (let* ((full-group (nnnm--prefixed group server))
+         (info (gnus-get-info full-group)))
     (gnus-info-set-marks info marks)
-    (setf (gnus-info-read info) read)
-    (gnus-set-info full-group info)
-    (mapcar #'list ids)))
+    (gnus-set-info full-group info)))
+
+(defun nnnm--subtract-from-ranges (ranges lst)
+  (let ((ranges (gnus-uncompress-sequence ranges)))
+    (dolist (n lst)
+      (let ((rs (seq-group-by (lambda (r) (> n r)) ranges)))
+        (setq ranges
+              (append (alist-get t rs) (mapcar #'1- (alist-get nil rs))))))
+    (gnus-compress-sequence ranges)))
+
+(defun nnnm--remove-articles-from-marks (ranges group server)
+  (let ((marks (nnnm--get-group-marks group server))
+        (lst (gnus-uncompress-sequence ranges))
+        (new-marks))
+    (dolist (m marks)
+      (push (cons (car m) (nnnm--subtract-from-ranges (cdr m))) lst))
+    (nnnm--set-group-marks marks group server)))
+
+(defun nnnm--set-active (n group server)
+  (gnus-set-active (nnnm--prefixed group server) (cons 1 n)))
 
 (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"))
+    (let* ((data (or (nnnm--group-data group)
+                     (mapcar #'list (nnnm--search query "NOT tag:new"))))
+           (ids (nnnm--search query "tag:new"))
            (nids (length ids))
            (new-data (mapcar (lambda (id)
                                (list id (nnnm--find-message-file id)))
@@ -113,8 +129,7 @@
         (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))))
+      (nnnm--set-active (+ nids (length data)) group server)
       (length ids))))
 
 
@@ -129,10 +144,7 @@
 (deffoo nnnm-open-server (server &optional defs)
   (nnoo-change-server 'nnnm server defs)
   (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)
+  (nnheader-report 'nnnm "Opened server %s" server)
   t)
 
 (deffoo nnnm-close-server (_server)
@@ -140,7 +152,6 @@
 
 (deffoo nnnm-request-regenerate (_server)
   (setq nnnm--group-data nil)
-  (nnnm--tag "*" "-nnnm")
   t)
 
 (deffoo nnnm-request-list (&optional _server)
@@ -191,19 +202,23 @@
      ((not (save-excursion (nnmail-find-file file)))
       (nnheader-report 'nnnm "Couldn't read file: %s" file))
      (t
-      (nnnm--tag id "+nnnm")
+      (nnnm--tag id "-unread")
       (nnheader-report 'nnnm "Article %s retrieved and tagged" id)
       (cons group id)))))
 
 (deffoo nnnm-request-expire-articles (articles group &optional _server _force)
-  (let ((excluded) (ids))
-    (dolist (a articles)
-      (if-let (id (car (nnnm--article-data a group)))
-          (push id ids)
-        (push a excluded)))
+  (let* ((articles (gnus-uncompress-range articles))
+         (ids (mapcar (lambda (a) (car (nnnm--article-data a group))) articles)))
     (when ids
-      (nnnm--tag (nnnm--ids-query ids) "+deleted +nnnm"))
-    excluded))
+      (nnnm--tag (nnnm--ids-query ids) "+deleted")
+      (let ((data (nnnm--group-data group)))
+        (dolist (id ids)
+          (setq data
+                (cl-delete-if (lambda (d) (string= (car d) id)) data :count 1)))
+        (nnnm--set-group-data group data)
+        (nnnm--remove-articles-from-marks articles group server)
+        (nnnm--set-active (length data) group server)))
+    articles))
 
 (deffoo nnnm-request-set-mark (group actions &optional _server)
   (message "set marks: %s: %S" group actions)
@@ -244,7 +259,6 @@
 
 (deffoo nnnm-close-group (_group &optional _server) t)
 
-
 
 
 (provide 'nnnm)