[elpa] master 4dfaa46 3/3: Fix creation of nngnorb/nnir groups

[Eric Abrahamsen]

branch: master
commit 4dfaa46497aac97abfbdefcc3429c7951afbc917
Author: Eric Abrahamsen <address@hidden>
Commit: Eric Abrahamsen <address@hidden>

    Fix creation of nngnorb/nnir groups
    
    * packages/gnorb/gnorb-gnus.el (gnorb-gnus-search-messages): We were
      locating the nngnorb server incorrectly, and also feeding it to nnir
      incorrectly. This was preventing persistent groups from working
      correctly.
    * packages/gnorb/nngnorb.el (nnir-run-gnorb): Streamline the searching
      process. This should eliminate some redundancy, hopefully going a
      bit faster.
    * packages/gnorb/gnorb-utils.el (gnorb-msg-id-to-group): Do not cache
      article numbers in the registry -- numbers are not consistent across
      Gnus installations. This may slow down searches somewhat,
      unfortunately, but nnir's own caching mechanisms should help.
---
 packages/gnorb/gnorb-gnus.el  | 48 ++++++++++---------------
 packages/gnorb/gnorb-utils.el | 15 ++++----
 packages/gnorb/nngnorb.el     | 82 ++++++++++++++++++++-----------------------
 3 files changed, 65 insertions(+), 80 deletions(-)

diff --git a/packages/gnorb/gnorb-gnus.el b/packages/gnorb/gnorb-gnus.el
index dd46351..e500bd4 100644
--- a/packages/gnorb/gnorb-gnus.el
+++ b/packages/gnorb/gnorb-gnus.el
@@ -669,40 +669,30 @@ server. There must be an active \"nngnorb\" server for 
this to
 work."
   (interactive)
   (require 'nnir)
-  (let ((nnir-address
-        (or (gnus-method-to-server '(nngnorb))
-            (user-error
-             "Please add a \"nngnorb\" backend to your gnus installation.")))
-       name method spec)
-    (when (version= "5.13" gnus-version-number)
-      (with-no-warnings                  ; All these variables are available.
-       (setq nnir-current-query nil
-             nnir-current-server nil
-             nnir-current-group-marked nil
-             nnir-artlist nil)))
-    ;; In 24.4, the group name is mostly decorative, but in 24.3, the
-    ;; actual query is held there.
-    (setq name (if (version= "5.13" gnus-version-number)
-                  (concat "nnir:" (prin1-to-string `((query ,str))))
-                (if persist
-                    (read-string
-                     (format "Name for group (default %s): " head-text)
-                     nil head-text t)
-                  (concat "gnorb-" str))))
-    (setq method (if (version= "5.13" gnus-version-number)
-                    (list 'nnir nnir-address)
-                  (list 'nnir "Gnorb")))
-    (setq spec
-         (list
-          (cons 'nnir-specs (list (cons 'nnir-query-spec `((query . ,str)))
-                                  (cons 'nnir-group-spec `((,nnir-address 
nil)))))
-          (cons 'nnir-artlist nil)))
+  (let* ((nnir-address
+         (or (catch 'found
+               (dolist (s gnus-server-method-cache)
+                 (when (eq 'nngnorb (cadr s))
+                   (throw 'found (car s)))))
+             (user-error
+              "Please add a \"nngnorb\" backend to your gnus installation.")))
+        (name (if persist
+                  (read-string
+                   (format "Name for group (default %s): " head-text)
+                   nil nil head-text)
+                (concat "gnorb-" str)))
+        (method (list 'nnir nnir-address))
+        (spec (list
+               (cons 'nnir-specs (list (cons 'nnir-query-spec `((query . 
,str)))
+                                       (cons 'nnir-group-spec `((,nnir-address 
,(list name))))))
+               (cons 'nnir-artlist nil)))
+        nnir-current-query nnir-current-server nnir-current-group-marked 
nnir-artlist)
     (if persist
        (progn
          (switch-to-buffer gnus-group-buffer)
          (gnus-group-make-group name method nil spec)
          (gnus-group-select-group))
-     (gnus-group-read-ephemeral-group name method nil ret nil nil spec))))
+      (gnus-group-read-ephemeral-group name method nil ret nil nil spec))))
 
 (defun gnorb-gnus-summary-mode-hook ()
   "Check if we've entered a Gnorb-generated group, and activate
diff --git a/packages/gnorb/gnorb-utils.el b/packages/gnorb/gnorb-utils.el
index 14fb981..60e57b4 100644
--- a/packages/gnorb/gnorb-utils.el
+++ b/packages/gnorb/gnorb-utils.el
@@ -507,14 +507,13 @@ methods?"
                       (not
                        (string-match-p
                         "\\(nnir\\|nnvirtual\\|UNKNOWN\\)"
-                        server-group)))
-             (setq check
-                   (ignore-errors
-                     (gnus-request-head msg-id server-group)))
-             (when check
-               (gnus-registry-set-id-key msg-id 'group (list server-group))
-               (gnus-registry-set-id-key msg-id 'artno (list (cdr check)))
-               (throw 'found (car check)))))))
+                        server-group))
+                      (setq check
+                            (ignore-errors
+                              (gnus-request-head msg-id server-group))))
+
+             (gnus-registry-set-id-key msg-id 'group (list server-group))
+             (throw 'found (car check))))))
       nil)))
 
 (defun gnorb-collect-ids (&optional id)
diff --git a/packages/gnorb/nngnorb.el b/packages/gnorb/nngnorb.el
index 4d17c9b..172dbab 100644
--- a/packages/gnorb/nngnorb.el
+++ b/packages/gnorb/nngnorb.el
@@ -75,14 +75,10 @@ are displayed in an ephemeral group.
 Otherwise, the query string can be a tags match string, a la the
 Org agenda tags search. All headings matched by this string will
 be scanned for gnus messages, and those messages displayed."
-  ;; During the transition period between using message-ids stored in
-  ;; a property, and the new registry-based system, we're going to use
-  ;; both methods to collect relevant messages. This could be a little
-  ;; slower, but for the time being it will be safer.
   (save-window-excursion
     (let ((q (cdr (assq 'query query)))
          (buf (get-buffer-create nnir-tmp-buffer))
-         msg-ids org-ids links vectors)
+         msg-ids org-ids links messages vectors)
       (with-current-buffer buf
        (erase-buffer)
        (setq nngnorb-attachment-file-list nil))
@@ -130,47 +126,47 @@ be scanned for gnus messages, and those messages 
displayed."
                'agenda)))
       (with-current-buffer buf
        (goto-char (point-min))
-       (setq links (plist-get (gnorb-scan-links (point-max) 'gnus)
-                              :gnus))
-       (goto-char (point-min))
-       (while (re-search-forward
-               (concat ":" gnorb-org-msg-id-key ": \\([^\n]+\\)")
-               (point-max) t)
-         (setq msg-ids (append (split-string (match-string 1)) msg-ids))))
-      ;; Here's where we maybe do some duplicate work using the
-      ;; registry. Take our org ids and find all relevant message ids.
-      (dolist (i (delq nil org-ids))
-       (let ((rel-msg-id (gnorb-registry-org-id-search i)))
-         (when rel-msg-id
-           (setq msg-ids (append (delq nil rel-msg-id) msg-ids)))))
+       (setq links (append (plist-get (gnorb-scan-links (point-max) 'gnus)
+                                      :gnus)
+                           links))
+
+       (goto-char (point-min)))
+      ;; First add all links to messages (elements of messages should
+      ;; look like (group-name message-id)).
+      (dolist (l links)
+       (push (list (car (split-string link "#"))
+                   (org-link-unescape
+                    (nth 1 (split-string link "#"))))
+             messages))
+
+      ;; Then use the registry to turn list of org-ids into list of
+      ;; msg-ids.
+      (dolist (i (delq nil (delete-dups org-ids)))
+       (when-let ((rel-msg-id (gnorb-registry-org-id-search i)))
+         (setq msg-ids (append (delq nil rel-msg-id) msg-ids))))
+
+      ;; Then find the group for each msg-id, and add the results to
+      ;; messages.
       (when msg-ids
-       (dolist (id msg-ids)
-         (let ((link (gnorb-msg-id-to-link id)))
-           (when link
-             (push link links)))))
-      (setq links (sort (delete-dups links) 'string<))
+       (dolist (id (delete-dups msg-ids))
+         (when-let ((group (gnorb-msg-id-to-group id)))
+           (push (list group id) messages))))
+
+      (setq messages (sort messages (lambda (l r)
+                                     (string< (car l) (car r)))))
+
       (unless (gnus-alive-p)
        (gnus))
-      (dolist (m links (when vectors
-                        (reverse vectors)))
-       (let (server-group msg-id artno check)
-         (setq m (org-link-unescape m))
-         (when (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" m)
-           (setq server-group (match-string 1 m)
-                 msg-id (gnorb-bracket-message-id
-                         (match-string 3 m))
-                 artno (or (car (gnus-registry-get-id-key msg-id 'artno))
-                           (when (setq check
-                                       (cdr (ignore-errors
-                                              (gnus-request-head
-                                               msg-id server-group))))
-                             (gnus-registry-set-id-key
-                              msg-id 'artno
-                              (list check))
-                             check)))
-           (when artno
-             (when (and (integerp artno) (> artno 0))
-               (push (vector server-group artno 100) vectors)))))))))
+
+      (dolist (m messages (when vectors
+                           (reverse vectors)))
+       (let ((artno
+              (cdr-safe (ignore-errors
+                          (gnus-request-head
+                           (nth 1 m) (car m))))))
+
+         (when (and artno (integerp artno) (> artno 0))
+           (push (vector (car m) artno 100) vectors)))))))
 
 (defvar gnorb-summary-minor-mode-map (make-sparse-keymap)
   "Keymap for use in Gnorb's *Summary* minor mode.")