[elpa] externals/gnorb 5261d2f7 407/449: New gnorb-helm file

[Stefan Monnier]

branch: externals/gnorb
commit 5261d2f71fe50f9cb331d090095d80c9d33be7a7
Author: Eric Abrahamsen <eric@ericabrahamsen.net>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    New gnorb-helm file
    
    * packages/gnorb/gnorb-helm.el: New library, so far only one command.
      (gnorb-helm-search-registry): Command for searching the Gnus
      registry.
      (gnorb-helm-gnus-registry-candidates): Extract values from the
      registry.
    * packages/gnorb/gnorb.org: Document.
---
 gnorb-helm.el | 91 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 gnorb.info    | 13 ++++++---
 gnorb.org     |  8 ++++--
 gnorb.texi    |  9 ++++--
 4 files changed, 113 insertions(+), 8 deletions(-)

diff --git a/gnorb-helm.el b/gnorb-helm.el
new file mode 100644
index 0000000..bdf490d
--- /dev/null
+++ b/gnorb-helm.el
@@ -0,0 +1,91 @@
+;;; gnorb-helm.el --- Interface between Helm and Gnorb  -*- lexical-binding: 
t; -*-
+
+;; Copyright (C) 2018  Free Software Foundation, Inc.
+
+;; Author: Eric Abrahamsen <eric@ericabrahamsen.net>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Convenience functions relying on the helm package.
+
+;;; Code:
+
+(require 'gnorb-gnus)
+(require 'nngnorb)
+(require 'gnorb-utils)
+
+(declare-function 'helm-make-source "ext:helm-source")
+(declare-function 'helm "ext:helm")
+(declare-function 'helm-marked-candidates "ext:helm")
+
+(defun gnorb-helm-gnus-registry-candidates ()
+  "Return a list of candidates from the Gnus registry."
+  (let (ret from recipient subject group)
+    (maphash
+     (lambda (msg-id data)
+       (when (setq group (car-safe (cdr (assoc 'group data)))
+                  from (car-safe (cdr (assoc 'sender data)))
+                  subject (car-safe (cdr (assoc 'subject data)))
+                  recipient (car-safe (cdr (assoc 'recipient data))))
+        (push (cons (format "%s: %s"
+                            (if (string-match-p from 
gnus-ignored-from-addresses)
+                                recipient
+                              from)
+                            subject)     ; display
+                    (cons msg-id group)) ; real
+              ret)))
+     (slot-value gnus-registry-db 'data))
+    ret))
+
+;;;###autoload
+(defun gnorb-helm-search-registry ()
+  "Use helm and the Gnus registry to search messages."
+  (interactive)
+  (require 'helm)
+  (unless (gnus-alive-p)
+    (error "Gnus is not running"))
+  (unless gnus-registry-enabled
+    (error "The Gnus registry is not enabled"))
+  (let* ((msgs (helm :sources
+                    (helm-make-source "Gnus Registry" 'helm-source-sync
+                      :candidates #'gnorb-helm-gnus-registry-candidates
+                      :action (lambda (&rest _ignored) 
(helm-marked-candidates)))
+                    :buffer "*helm Gnus Registry*"))
+        (server (gnorb-gnus-find-gnorb-server))
+        (artlist
+         (mapcar
+          (lambda (msg)
+            (pcase-let ((`(,group . ,artno) (gnorb-msg-id-request-head
+                                             (car msg) (cdr msg))))
+              (when (and artno (integerp artno) (> artno 0))
+                (vector group artno 100))))
+          msgs))
+        (name (make-temp-name "registry messages"))
+        (spec (list
+               (cons 'nnir-specs (list (cons 'nnir-query-spec
+                                             `((query . "dummy")
+                                               (articles . ,artlist)))
+                                       (cons 'nnir-group-spec
+                                             `((,server ,(list name))))))
+               (cons 'nnir-artlist nil))))
+    (when msgs
+      (switch-to-buffer gnus-group-buffer)
+      (gnus-group-read-ephemeral-group
+       name `(nnir ,server) nil `(switch-to-buffer ,gnus-group-buffer)
+       nil nil spec))))
+
+(provide 'gnorb-helm)
+;;; gnorb-helm.el ends here
diff --git a/gnorb.info b/gnorb.info
index 0bb27fa..ee9a0df 100644
--- a/gnorb.info
+++ b/gnorb.info
@@ -695,11 +695,16 @@ set of groups beforehand.
      tracked in the registry.  Search strings are given as a series of
      “key:value” terms, with double quotes around multi-word values.
      See docstring for available keys.
+‘gnorb-helm-search-registry’
+     Helm users can use this function to conduct a more visual search of
+     the registry.  Only sender/recipient and subject lines are matched
+     against.
 
-   This function is not bound by default; you might consider:
+   These functions are not bound by default; you might consider:
 
      (with-eval-after-load "gnus-group"
-       (define-key gnus-group-group-map (kbd "/") 
#'gnorb-gnus-search-registry))
+       (define-key gnus-group-group-map (kbd "/") #'gnorb-gnus-search-registry)
+       (define-key gnus-group-group-map (kbd "?") 
#'gnorb-helm-search-registry))
 
 
 File: gnorb.info,  Node: User Options 2,  Prev: Searching With the Registry,  
Up: Misc Gnus
@@ -836,8 +841,8 @@ Node: Inserting BBDB links25199
 Node: User Options 125455
 Node: Misc Gnus28353
 Node: Searching With the Registry28547
-Node: User Options 229574
-Node: Default Keybindings32752
+Node: User Options 229849
+Node: Default Keybindings33027
 
 End Tag Table
 
diff --git a/gnorb.org b/gnorb.org
index dfc2d92..951c014 100644
--- a/gnorb.org
+++ b/gnorb.org
@@ -495,12 +495,16 @@ a particular set of groups beforehand.
      strings are given as a series of "key:value" terms, with double
      quotes around multi-word values. See docstring for available
      keys.
+- `gnorb-helm-search-registry' :: Helm users can use this function to
+     conduct a more visual search of the registry. Only
+     sender/recipient and subject lines are matched against.
 
-This function is not bound by default; you might consider:
+These functions are not bound by default; you might consider:
 
 #+BEGIN_SRC elisp
   (with-eval-after-load "gnus-group"
-    (define-key gnus-group-group-map (kbd "/") #'gnorb-gnus-search-registry))
+    (define-key gnus-group-group-map (kbd "/") #'gnorb-gnus-search-registry)
+    (define-key gnus-group-group-map (kbd "?") #'gnorb-helm-search-registry))
 #+END_SRC
 ** User Options
 - `gnorb-gnus-mail-search-backend' :: Specifies the search backend
diff --git a/gnorb.texi b/gnorb.texi
index 6c3a2fc..5eed70d 100644
--- a/gnorb.texi
+++ b/gnorb.texi
@@ -685,13 +685,18 @@ and match it against messages tracked in the registry. 
Search
 strings are given as a series of ``key:value'' terms, with double
 quotes around multi-word values. See docstring for available
 keys.
+@item `gnorb-helm-search-registry'
+Helm users can use this function to
+conduct a more visual search of the registry. Only
+sender/recipient and subject lines are matched against.
 @end table
 
-This function is not bound by default; you might consider:
+These functions are not bound by default; you might consider:
 
 @lisp
 (with-eval-after-load "gnus-group"
-  (define-key gnus-group-group-map (kbd "/") #'gnorb-gnus-search-registry))
+  (define-key gnus-group-group-map (kbd "/") #'gnorb-gnus-search-registry)
+  (define-key gnus-group-group-map (kbd "?") #'gnorb-helm-search-registry))
 @end lisp
 
 @node User Options 2