[elpa] externals/consult-recoll 2dd853c6c9 29/50: consult live previews showing recoll snippets

[ELPA Syncer]

branch: externals/consult-recoll
commit 2dd853c6c950b8f57dfea3308165f5bb46c9f47c
Author: jao <jao@gnu.org>
Commit: jao <jao@gnu.org>

    consult live previews showing recoll snippets
---
 consult-recoll.el | 64 +++++++++++++++++++++++++++++++++++++++++++++++++------
 readme.org        | 61 ++++++++++++++++++++++++++++------------------------
 2 files changed, 91 insertions(+), 34 deletions(-)

diff --git a/consult-recoll.el b/consult-recoll.el
index ae4b860751..5b685659ea 100644
--- a/consult-recoll.el
+++ b/consult-recoll.el
@@ -25,8 +25,9 @@
 
 ;;; Commentary:
 
-;; A `consult-recoll' command to perform interactive queries over your Recoll
-;; (https://www.lesbonscomptes.com/recoll/) index using consult. Use
+;; A `consult-recoll' command to perform interactive queries (including life
+;; previews of documment snippets) over your Recoll
+;; (https://www.lesbonscomptes.com/recoll/) index, using consult. Use
 ;;
 ;;     M-x consult-recoll
 ;;
@@ -68,16 +69,21 @@ See also `consult-recoll-open-fns'"
 Set to nil to use the default 'title (path)' format."
   :type '(choice (const nil) function))
 
-(defface consult-recoll-url-face '((t :inherit default))
+(defface consult-recoll-url-face '((t :inherit link))
   "Face used to display URLs of candidates.")
 
 (defface consult-recoll-title-face '((t :inherit italic))
   "Face used to display titles of candidates.")
 
+(defface consult-recoll-mime-face '((t :inherit font-lock-comment-face))
+  "Face used to display MIME type of candidates.")
+
 (defvar consult-recoll-history nil "History for `consult-recoll'.")
+(defvar consult-recoll--current "")
 
 (defun consult-recoll--command (text)
   "Command used to perform queries for TEXT."
+  (setq consult-recoll--current text)
   `("recollq" ,@consult-recoll-search-flags ,text))
 
 (defun consult-recoll--transformer (str)
@@ -92,18 +98,63 @@ Set to nil to use the default 'title (path)' format."
                    (format "%s (%s)"
                            (propertize title 'face 'consult-recoll-title-face)
                            (propertize urln 'face 'consult-recoll-url-face)))))
-      (propertize cand 'mime-type mime 'url urln))))
+      (propertize cand 'mime-type mime 'url urln 'title title))))
+
+(defsubst consult-recoll--candidate-title (candidate)
+  (get-text-property 0 'title candidate))
+
+(defsubst consult-recoll--candidate-mime (candidate)
+  (get-text-property 0 'mime-type candidate))
+
+(defun consult-recoll--candidate-url (candidate)
+  (get-text-property 0 'url candidate))
 
 (defun consult-recoll--open (candidate)
   "Open file of corresponding completion CANDIDATE."
   (when candidate
-    (let ((url (get-text-property 0 'url candidate))
-          (opener (alist-get (get-text-property 0 'mime-type candidate)
+    (let ((url (consult-recoll--candidate-url candidate))
+          (opener (alist-get (consult-recoll--candidate-mime candidate)
                              consult-recoll-open-fns
                              (or consult-recoll-open-fn #'find-file)
                              nil 'string=)))
       (funcall opener url))))
 
+(defvar consult-recoll--preview-buffer "*consult-recoll preview*")
+
+(defun consult-recoll--preview (action candidate)
+  "Preview search result CANDIDATE when ACTION is 'preview."
+  (cond ((or (eq action 'setup) (null candidate))
+         (with-current-buffer (get-buffer-create 
consult-recoll--preview-buffer)
+           (delete-region (point-min) (point-max))))
+        ((and (eq action 'preview) candidate)
+         (when-let* ((url (consult-recoll--candidate-url candidate))
+                     (q (format "recollq -A -p 5 filename:%s AND %s"
+                                (replace-regexp-in-string "^.+://" "" url)
+                                consult-recoll--current))
+                     (buff (get-buffer consult-recoll--preview-buffer)))
+           (with-current-buffer buff
+             (delete-region (point-min) (point-max))
+             (insert (shell-command-to-string q))
+             (goto-char (point-min))
+             (when (re-search-forward (regexp-quote (format "[%s]" url)) nil t)
+               (delete-region (point-min) (point)))
+             (unless (re-search-forward "^SNIPPETS$" nil t)
+               (goto-char (point-max)))
+             (delete-region (point-min) (point))
+             (when-let (title (consult-recoll--candidate-title candidate))
+               (insert (propertize title 'face 'consult-recoll-title-face) 
"\n"))
+             (insert (propertize url 'face 'consult-recoll-url-face) "\n")
+             (insert (propertize (consult-recoll--candidate-mime candidate)
+                                 'face 'consult-recoll-mime-face)
+                     "\n")
+             (when (re-search-forward "^/SNIPPETS$" nil t)
+               (replace-match ""))
+             (delete-region (point) (point-max)))
+           (pop-to-buffer buff)))
+        ((eq action 'exit)
+         (when (get-buffer consult-recoll--preview-buffer)
+           (kill-buffer consult-recoll--preview-buffer)))))
+
 (defun consult-recoll--search (&optional initial)
   "Perform an asynchronous recoll search via `consult--read'.
 If given, use INITIAL as the starting point of the query."
@@ -115,6 +166,7 @@ If given, use INITIAL as the starting point of the query."
                  :require-match t
                  :lookup #'consult--lookup-member
                  :sort nil
+                 :state #'consult-recoll--preview
                  :initial (consult--async-split-initial initial)
                  :history '(:input consult-recoll-history)
                  :category 'recoll-result))
diff --git a/readme.org b/readme.org
index 51c113808d..05fd48d67c 100644
--- a/readme.org
+++ b/readme.org
@@ -15,7 +15,8 @@
 
 [[https://www.lesbonscomptes.com/recoll/][Recoll]] is a local search engine 
that knows how to index a wide variety of file
 formats, including PDFs, org and other text files and emails.  It also offers
-a sophisticated query language.
+a sophisticated query language, and, for some document kinds, snippets of the
+text in the found document actually matching the query.
 
 This package provides an emacs interface to perform recoll queries, and
 display its results, via [[https://github.com/minad/consult][consult]].
@@ -37,16 +38,44 @@ display its results, via 
[[https://github.com/minad/consult][consult]].
     You can fine tune how queries are issued by customizing
     ~consult-recoll-search-flags~.
 
+***** Tip: Two-level filtering
+
+      ~consult-recoll~ builds on the asychronous logic inside =consult.el=,
+      so you can use consult's handy 
[[https://github.com/minad/consult#asynchronous-search][two-level filtering]], 
which allows
+      searching over the results of a query. For example, if you start
+      typing
+
+      #+begin_example
+       #goedel's theorem
+      #+end_example
+
+      see a bunch of results, and want to narrow them to those lines
+      matching, say, "hofstadter", you can type ~#~ (which stops further
+      recoll queries) followed by the term you're interested in:
+
+      #+begin_example
+        #goedel's theorem#hofstadter
+      #+end_example
+
+      at which point only matches containing "hofstadter" will be
+      offered.
+
+
 *** Displaying results
 
-    For each matching result, consult-recoll retrieves its title, full file
-    name and mime type, and shows, by default, a line with the first two,
-    using the customizable faces ~consult-recoll-title-face~ and
+    For each matching result, ~consult-recoll~ retrieves its title, full file
+    name and mime type, and shows, by default, a line with the first two in
+    the minibuffer, using the customizable faces ~consult-recoll-title-face~ 
and
     ~consult-recoll-url-face~.  You can provide your own formatting function
     (perhaps stripping common prefixes of the file name, or displaying also
     the MIME) as the value of the customizable variable
     ~consult-recoll-format-candidate~.
 
+    ~consult-recoll~ also uses consult's 
[[https://github.com/minad/consult#live-previews][live previews]] to show, for 
the each
+    selected candidate hit, a buffer with further information, including
+    snippets of the file (when provided by recoll).  The title, path and mime
+    type of the document are also shown in previews.
+
 *** Opening search results
     :PROPERTIES:
     :CUSTOM_ID: opening-results
@@ -56,27 +85,3 @@ display its results, via 
[[https://github.com/minad/consult][consult]].
     lookup a function to open its associated file in the customizable variable
     ~consult-recoll-open-fns~.  If no entry is found, consult-recoll uses the
     value of ~consult-open-fn~ as a default.
-
-* Tips
-
-*** Two-level filtering
-
-    ~consult-recoll~ builds on the asychronous logic inside =consult.el=,
-    so you can use consult's handy 
[[https://github.com/minad/consult#asynchronous-search][two-level filtering]], 
which allows
-    searching over the results of a query. For example, if you start
-    typing
-
-    #+begin_example
-     #goedel's theorem
-    #+end_example
-
-    see a bunch of results, and want to narrow them to those lines
-    matching, say, "hofstadter", you can type ~#~ (which stops further
-    recoll queries) followed by the term you're interested in:
-
-    #+begin_example
-      #goedel's theorem#hofstadter
-    #+end_example
-
-    at which point only matches containing "hofstadter" will be
-    offered.