[elpa] externals/gnorb c2f837c 341/449: Improve efficiency of retrieving tracked messages

[Stefan Monnier]

branch: externals/gnorb
commit c2f837c3a99f7d75fa59dc9424d98195597dbb21
Author: Eric Abrahamsen <eric@ericabrahamsen.net>
Commit: Eric Abrahamsen <eric@ericabrahamsen.net>

    Improve efficiency of retrieving tracked messages
    
    * gnorb-utils.el (gnorb-tracking-initialize): Add a 'artno (article
      number) key to information tracked in the registry.
      (gnorb-msg-id-to-group): When determining a message's group, save the
      verified group and article number information in the registry.
      This caches the data for future use. (This whole process was
      previously causing a grand total of three server hits per message,
      every time, sheesh.)
      (gnorb-open-gnus-link): Do the same get-or-get-and-set routine for
      article numbers here.
    * nngnorb.el (nnir-run-gnorb): Ditto here.
    
    I'm embarrassed to say this only became a priority after I switched to a
    remote imap server, and network lags started killing me.
---
 gnorb-utils.el | 43 +++++++++++++++++++++++++------------------
 nngnorb.el     | 31 +++++++++++++++++++------------
 2 files changed, 44 insertions(+), 30 deletions(-)

diff --git a/gnorb-utils.el b/gnorb-utils.el
index 723f27b..ec2642e 100644
--- a/gnorb-utils.el
+++ b/gnorb-utils.el
@@ -189,13 +189,16 @@ window."
   ;; We've probably already bracketed the id, but just in case this is
   ;; called from elsewhere...
   (let* ((id (gnorb-bracket-message-id id))
-        (art-no (cdr (gnus-request-head id group)))
         (arts (gnus-group-unread group))
-        success)
+        artno success)
+    (or (setq artno (car (gnus-registry-get-id-key id 'artno)))
+       (progn
+         (setq artno (cdr (gnus-request-head id group)))
+         (gnus-registry-set-id-key id 'artno (list artno))))
     (gnus-activate-group group)
     (setq success (gnus-group-read-group arts t group))
     (if success
-       (gnus-summary-goto-article (or art-no id) nil t)
+       (gnus-summary-goto-article arto nil t)
       (signal 'error "Group could not be opened."))))
 
 (defun gnorb-trigger-todo-action (arg &optional id)
@@ -386,24 +389,27 @@ message."
 So far we're checking the registry, then the groups in
 `gnorb-gnus-sent-groups'. Use search engines? Other clever
 methods?"
-  (let (candidates server-group)
+  (let (candidates server-group check)
     (setq msg-id (gnorb-bracket-message-id msg-id))
     (catch 'found
       (when gnorb-tracking-enabled
-       ;; Make a big list of all the groups where this message might
-       ;; conceivably be.
-       (setq candidates
-             (append (gnus-registry-get-id-key msg-id 'group)
-                     gnorb-gnus-sent-groups))
-       (while (setq server-group (pop candidates))
-         (when (and (stringp server-group)
-                    (not
-                     (string-match-p
-                      "\\(nnir\\|nnvirtual\\|UNKNOWN\\)"
-                      server-group))
-                    (ignore-errors
-                      (gnus-request-head msg-id server-group)))
-               (throw 'found server-group))))
+       (setq candidates (gnus-registry-get-id-key msg-id 'group))
+       (if (= 1 (length candidates))
+           (throw 'found (car candidates))
+         (setq candidates (append candidates gnorb-gnus-sent-groups))
+         (while (setq server-group (pop candidates))
+           (when (and (stringp server-group)
+                      (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 (car check)))
+               (gnus-registry-set-id-key msg-id 'artno (list (cdr check)))
+               (throw 'found (car check)))))))
       nil)))
 
 (defun gnorb-collect-ids (&optional id)
@@ -484,6 +490,7 @@ registry be in use, and should be called after the call to
   (require 'gnorb-registry)
   (with-eval-after-load 'gnus-registry
     (add-to-list 'gnus-registry-extra-entries-precious 'gnorb-ids)
+    (add-to-list 'gnus-registry-extra-entries-precious 'artno)
     (add-to-list 'gnus-registry-track-extra 'gnorb-ids))
   (add-hook
    'gnus-started-hook
diff --git a/nngnorb.el b/nngnorb.el
index bb0ddfd..0c1ca35 100644
--- a/nngnorb.el
+++ b/nngnorb.el
@@ -144,26 +144,33 @@ be scanned for gnus messages, and those messages 
displayed."
          (when rel-msg-id
            (setq msg-ids (append (delq nil rel-msg-id) msg-ids)))))
       (when msg-ids
-         (dolist (id msg-ids)
-           (let ((link (gnorb-msg-id-to-link id)))
-             (when link
-               (push link links)))))
-      (setq links (delete-dups links))
+       (dolist (id msg-ids)
+         (let ((link (gnorb-msg-id-to-link id)))
+           (when link
+             (push link links)))))
+      (setq links (sort (delete-dups links) 'string<))
       (unless (gnus-alive-p)
        (gnus))
       (dolist (m links (when vectors
-                        (nreverse vectors)))
-       (let (server-group msg-id result artno)
+                        (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))
-                 result (ignore-errors (gnus-request-head msg-id 
server-group)))
-           (when result
-            (setq artno (cdr result))
-            (when (and (integerp artno) (> artno 0))
-              (push (vector server-group artno 100) vectors)))))))))
+                 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)))))))))
 
 (defvar gnorb-summary-minor-mode-map (make-sparse-keymap)
   "Keymap for use in Gnorb's *Summary* minor mode.")