lisp/gnus/nnir.el: Improve marks handling

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index ca78e7c99b440ed1ec9c6a34b5b4b232cf9be460..b5390fe938f203d6c709998f27241fdd59739a35 100644 (file)
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,10 @@
+2013-04-10  Andrew Cohen  <cohen@bu.edu>
+
+       * nnir.el (number-sequence): No longer used.
+       (nnir-request-set-mark): New function.
+       (nnir-request-update-info): Improve marks updating.
+       (nnir-request-scan): Don't duplicate marks updating.
+
 2013-04-04  Andrew Cohen  <cohen@bu.edu>
 
        * nnir.el (gnus-nnir-group-p): New function.

diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el
index b96f0c1cb789a9621cc31002688943aa35c149f3..c6baa301c0629a773cc00b76a313eb9674d3345f 100644 (file)
--- a/lisp/gnus/nnir.el
+++ b/lisp/gnus/nnir.el
@@ -173,15 +173,7 @@
 
 ;; For Emacs <22.2 and XEmacs.
 (eval-and-compile
-  (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))
-  (unless (fboundp 'number-sequence)
-    (defun number-sequence (from to)
-      (let (seq (n 0) (next from))
-       (while (<= next to)
-         (setq seq (cons next seq)
-               n (1+ n)
-               next (+ from  n )))
-       (nreverse seq)))))
+  (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
 
 (require 'nnoo)
 (require 'gnus-group)
@@ -846,11 +838,31 @@ skips all prompting."
        (artnumber (nnir-article-number article)))
     (gnus-request-update-mark artgroup artnumber mark)))
 
+(deffoo nnir-request-set-mark (group actions &optional server)
+  (let (mlist)
+    (dolist (action actions)
+      (destructuring-bind (range action marks) action
+        (let ((articles-by-group (nnir-categorize
+                                  (gnus-uncompress-range range)
+                                  nnir-article-group nnir-article-number)))
+          (dolist (artgroup articles-by-group)
+            (push (list
+                  (car artgroup)
+                  (list (gnus-compress-sequence
+                         (sort (cadr artgroup) '<)) action marks)) mlist)))))
+    (dolist (request (nnir-categorize  mlist car cadr))
+      (gnus-request-set-mark (car request) (cadr request)))))
+
 
 (deffoo nnir-request-update-info (group info &optional server)
-  (let ((articles-by-group
+  (nnir-possibly-change-group group)
+  ;; clear out all existing marks.
+  (gnus-info-set-marks info nil)
+  (gnus-info-set-read info nil)
+  (let ((group (gnus-group-guess-full-name-from-command-method group))
+       (articles-by-group
         (nnir-categorize
-         (number-sequence 1 (nnir-artlist-length nnir-artlist))
+         (gnus-uncompress-range (cons 1 (nnir-artlist-length nnir-artlist)))
          nnir-article-group nnir-article-ids)))
     (gnus-set-active group
                     (cons 1 (nnir-artlist-length nnir-artlist)))
@@ -864,23 +876,20 @@ skips all prompting."
         info
         (gnus-add-to-range
          (gnus-info-read info)
-         (remove nil  (mapcar (lambda (art)
-                                (let ((num (cdr art)))
-                                  (when (gnus-member-of-range num read)
-                                    (car art)))) articleids))))
-       (mapc (lambda (mark)
-               (let ((type (car mark))
-                     (range (cdr mark)))
+         (delq nil
+                 (mapcar
+                  #'(lambda (art)
+                    (when (gnus-member-of-range (cdr art) read) (car art)))
+                  articleids))))
+       (dolist (mark marks)
+         (destructuring-bind (type . range) mark
                  (gnus-add-marked-articles
-                  group
-                  type
-                  (remove nil
+            group type
+            (delq nil
                           (mapcar
-                           (lambda (art)
-                             (let ((num (cdr art)))
-                               (when (gnus-member-of-range num range)
-                                 (car art))))
-                           articleids))))) marks)))))
+                     #'(lambda (art)
+                       (when (gnus-member-of-range (cdr art) range) (car art)))
+                     articleids)))))))))
 
 
 (deffoo nnir-close-group (group &optional server)
@@ -1901,22 +1910,11 @@ article came from is also searched."
   t)
 
 (deffoo nnir-request-scan (group method)
-  (if group
-      (let ((pgroup (if (gnus-group-prefixed-p group)
-                       group
-                     (gnus-group-prefixed-name  group '(nnir "nnir")))))
-       (gnus-group-set-parameter
-        pgroup 'nnir-artlist
-        (setq nnir-artlist
-              (nnir-run-query
-               (gnus-group-get-parameter pgroup 'nnir-specs t))))
-       (nnir-request-update-info pgroup (gnus-get-info pgroup)))
-    t))
+  t)
 
 (deffoo nnir-request-close ()
   t)
 
-
 (nnoo-define-skeleton nnir)
 
 ;; The end.