branch: master
commit 4dfaa46497aac97abfbdefcc3429c7951afbc917
Author: Eric Abrahamsen <e...@ericabrahamsen.net>
Commit: Eric Abrahamsen <e...@ericabrahamsen.net>
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.")
