Implementation of dash-at-point with consult

6 files changed, 154 insertions, 89 deletions

diff --git a/lisp/consult-dash.el b/lisp/consult-dash.el
new file mode 100644
index 0000000..7f1e8d5
--- /dev/null
+++ b/lisp/consult-dash.el
@@ -0,0 +1,135 @@
+;;; consult-dash.el --- Consult front-end for dash-docs  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2022  Ravi R Kiran
+
+;; Author: Ravi R Kiran <aine.marina@gmail.com>
+;; Keywords: consult, dash
+
+;; 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:
+
+;; consult-dash is the only interface function
+
+;; To do
+
+;; - Segment matches per docset
+;; - Avoid concatenating commands through the shell
+
+;;; Code:
+
+(require 'dash-docs)
+(require 'subr-x)
+(require 'thingatpt)
+
+(defvar-local consult-dash-docsets nil
+  "Docsets to use for this buffer")
+(defvar consult-dash-sqlite-args "sqlite3 -list"
+  "Sqlite command-line arguments")
+
+(advice-add #'dash-docs-buffer-local-docsets :around
+              (lambda (old-fun &rest args)
+                (let ((old (apply old-fun args)))
+                  (delq nil (delete-dups (append old consult-dash-docsets))))))
+
+(defvar consult-dash--history nil
+  "Previous queries for dash docs via consult")
+(defvar consult-dash--docset-prefix "DOCSET:"
+  "Prefix to identify docset boundaries")
+
+(defun consult-dash--builder-one-docset (docset pattern)
+  (let* ((query (dash-docs-sql-query (caddr docset)
+                                     (dash-docs-sub-docset-name-in-pattern pattern
+                                                                           (car docset))))
+         (cmd (concat "echo " consult-dash--docset-prefix
+                      (shell-quote-argument (car docset))
+                      "; "
+                      consult-dash-sqlite-args
+                      " "
+                      (shell-quote-argument (cadr docset))
+                      " "
+                      (shell-quote-argument query)
+                      "; ")))
+    cmd))
+
+;; Is there a better way to run multiple commands when using consult--async-command?
+(defun consult-dash--builder (input)
+  (pcase-let ((`(,arg . ,opts) (consult--command-split input)))
+    (unless (string-blank-p arg)
+      (when-let* ((docsets (dash-docs-maybe-narrow-docsets arg))
+                  (cmds (mapcar (lambda (ds) (consult-dash--builder-one-docset ds arg)) docsets)))
+        (list :command (list "sh" "-c" (apply #'concat cmds))
+              :highlight (cdr (consult--default-regexp-compiler arg 'basic)))))))
+
+(defun consult-dash--with-buffer-context (func)
+  "Ensure that FUNC is called with the correct buffer context"
+  (let ((buf (current-buffer)))
+    (lambda (&rest args)
+      (with-current-buffer buf
+        (apply func args)))))
+
+(defvar consult-dash--current-docset nil
+  "Stored current docset output for chunked calls to consult-dash--format")
+
+(defun consult-dash--format (lines)
+  (let ((candidates)
+        (current-candidate))
+    (save-match-data
+      (dolist (str lines)
+        (setq current-candidate (split-string str "|" t))
+        (if (= 1 (length current-candidate))
+            ;; FIXME: If we do not find the right prefix, we should raise an error
+            (when (string-prefix-p consult-dash--docset-prefix str)
+              (setq consult-dash--current-docset (substring str (length consult-dash--docset-prefix))))
+          (let ((name (cadr current-candidate))
+                (type (car current-candidate)))
+            (add-face-text-property 0 (length name) 'consult-key nil name)
+            (put-text-property 0 (length name) 'consult-dash-docset consult-dash--current-docset name)
+            (push (list
+                   (format "%s (%s)" name type)
+                   consult-dash--current-docset
+                   current-candidate)
+                  candidates)))))
+    (nreverse candidates)))
+
+(defun consult-dash--group (candidate transform)
+  (if transform
+      candidate
+    (get-text-property 0 'consult-dash-docset candidate)))
+
+(defun consult-dash (&optional initial)
+  (interactive)
+  (dash-docs-create-common-connections)
+  (dash-docs-create-buffer-connections)
+  (setq consult-dash--current-docset nil)
+  (when-let* ((builder (consult-dash--with-buffer-context #'consult-dash--builder))
+              (search-result (consult--read
+                              (consult--async-command builder
+                                (consult--async-transform consult-dash--format)
+                                (consult--async-highlight builder))
+                              :prompt "Dash: "
+                              :require-match t
+                              :group #'consult-dash--group
+                              :lookup #'consult--lookup-cdr
+                              :initial (consult--async-split-initial initial)
+                              :add-history (consult--async-split-thingatpt 'symbol)
+                              :history '(:input consult-dash--history))))
+    (dash-docs-browse-url search-result)))
+
+(defun consult-dash-at-point ()
+  (interactive)
+  (consult-dash (thing-at-point 'symbol)))
+
+(provide 'consult-dash)
+;;; consult-dash.el ends here
diff --git a/lisp/ravi-init-completion.el b/lisp/ravi-init-completion.el
index 9cc9ef5..1c973d8 100644
--- a/lisp/ravi-init-completion.el
+++ b/lisp/ravi-init-completion.el
@@ -335,89 +335,19 @@
 (use-package dash-docs
   :if (member ravi/use-selection-system '(selectrum vertico))
   :after (avy)
-  :bind (("M-s d" . 'ravi/dash)
-         ("M-s D" . 'ravi/dash-at-point))
+  :commands (consult-dash)
+  :bind (("M-s d" . consult-dash-at-point))
   :config
-  (require 'cl-lib)                   ; for cl-remove-duplicates, cl-find-if
-  (require 'subr-x)                   ; for when-let
-
-  (defvar ravi/dash-history-input nil)
-  (defvar ravi/dash--results nil
-    "Stores the previously retrieved docset results")
-  (defvar-local ravi/dash-docsets nil
-    "Docsets to use for this buffer")
-
-  (advice-add #'dash-docs-buffer-local-docsets :around
-              (lambda (old-fun &rest args)
-                (let ((old (apply old-fun args)))
-                  (cl-remove-duplicates (append old ravi/dash-docsets)))))
-
-  (defun ravi/dash--collection (s &rest _)
-    "Given a string S, query docsets and retrieve result."
-    (message "Trying to search for: %s" (prin1-to-string s))
-    (setq ravi/dash--results (dash-docs-search s))
-    (mapcar 'car ravi/dash--results))
-
-  (defun ravi/dash--browse-matching-result (match)
-    "Given a MATCH, find matching result and browse it's url."
-    (when-let ((result
-                (cdr (cl-find-if (lambda (e)
-                                   (string= match (car e))) ravi/dash--results))))
-      (dash-docs-browse-url result)))
-
-  ;; The following does not work, because vertico and selectrum don't support dynamic completions
-  (defun ravi/dash (&optional initial)
-    "Query dash docsets.
-INITIAL will be used as the initial input, if given."
-    (interactive)
-    (dash-docs-initialize-debugging-buffer)
-    (dash-docs-create-buffer-connections)
-    (dash-docs-create-common-connections)
-    (if t
-        (ravi/dash--browse-matching-result
-         (let ((cb (current-buffer)))
-           (completing-read
-            "Documentation for: "
-            ;; (completion-table-dynamic (lambda (s) (with-current-buffer cb (ravi/dash--collection s))))
-            (completion-table-dynamic #'ravi/dash--collection t)
-            nil                         ; predicate
-            t                           ; require-match
-            nil                         ; initial-input
-            'ravi/dash-history-input    ; history
-            (when-let ((sym (thing-at-point 'symbol))) (substring-no-properties sym))))) ; default, a.k.a future history
-      (message "%s" (prin1-to-string (ravi/dash--collection "C++ throw")))))
-
-  (defun ravi/dash-at-point-what-it-should-be ()
-    "Bring up a `ravi/dash' search interface with symbol at point."
-    (interactive)
-    (ravi/dash
-     (substring-no-properties (or (thing-at-point 'symbol) ""))))
-
-  (defun ravi/dash-at-point ()
-    "Bring up a `ravi/dash' search interface with symbol at point."
-    (interactive)
-    (dash-docs-initialize-debugging-buffer)
-    (dash-docs-create-buffer-connections)
-    (dash-docs-create-common-connections)
-    (if-let* ((sym (thing-at-point 'symbol))
-              (sym-only (substring-no-properties sym))
-              (cb (current-buffer))
-              (table (with-current-buffer cb (ravi/dash--collection sym-only)))
-              (result (completing-read (format "Documentation for '%s':" sym-only)
-                                       table nil t nil 'ravi/dash-history-input)))
-        (progn
-          (ravi/dash--browse-matching-result result)
-          (add-to-list 'ravi/dash-history-input sym-only))
-      (user-error "No symbol at point or documentation not found")))
-
-  (defun avy-action-dash-at-point (pt)
-    (save-excursion
-      (goto-char pt)
-      (ravi/dash-at-point))
-    (select-window (cdr (ring-ref avy-ring 0)))
-    t)
-  (setf (alist-get ?D avy-dispatch-alist) 'avy-action-dash-at-point)
-  )
+  (use-package consult-dash
+    :config
+    (defun avy-action-dash-at-point (pt)
+      (save-excursion
+        (goto-char pt)
+        (consult-dash-at-point))
+      (select-window (cdr (ring-ref avy-ring 0)))
+      t)
+    (setf (alist-get ?D avy-dispatch-alist) 'avy-action-dash-at-point)
+    :ensure nil))
 
 (use-package consult-dir
   :commands (consult-dir)
diff --git a/lisp/ravi-init-cpp.el b/lisp/ravi-init-cpp.el
index 488e1ab..ea3b109 100644
--- a/lisp/ravi-init-cpp.el
+++ b/lisp/ravi-init-cpp.el
@@ -152,7 +152,7 @@
       (unbind-key "M-j" c-mode-base-map)
       (bind-key "C-c C-i" 'c-includes-current-file c-mode-base-map)
       (when (functionp 'helm-dash) (setq-local dash-docs-docsets '("C")))
-      (when (functionp 'ravi/dash) (setq-local ravi/dash-docsets '("C")))
+      (when (functionp 'consult-dash) (setq-local consult-dash-docsets '("C")))
 
       (set (make-local-variable 'parens-require-spaces) t)
       (setq fill-column 88)
@@ -200,7 +200,7 @@
       (setq c-macro-cppflags "-x c++")
       (setq c-macro-prompt-flag t)
       (when (functionp 'helm-dash) (setq-local dash-docs-docsets '("C" "C++" "Boost" "Qt")))
-      (when (functionp 'ravi/dash) (setq-local ravi/dash-docsets '("C" "C++" "Boost" "Qt")))
+      (when (functionp 'consult-dash) (setq-local consult-dash-docsets '("C" "C++" "Boost" "Qt")))
       )
     (defun ravi/c++-hook-adder ()
       (add-hook 'c++-mode-hook 'my-c++-mode-hook))
diff --git a/lisp/ravi-init-python.el b/lisp/ravi-init-python.el
index 03c5167..4de804d 100644
--- a/lisp/ravi-init-python.el
+++ b/lisp/ravi-init-python.el
@@ -51,7 +51,7 @@
     (setq python-shell-interpreter-args "--pylab --simple-prompt"))
   (defun ravi/python-mode-hook()
     (when (functionp 'helm-dash) (setq-local dash-docs-docsets '("Python 2" "Python 3" "NumPy")))
-    (when (functionp 'ravi/dash) (setq-local ravi/dash-docsets '("Python 2" "Python 3" "NumPy")))
+    (when (functionp 'consult-dash) (setq-local consult-dash-docsets '("Python 2" "Python 3" "NumPy")))
 
     ;; I'd really prefer indentation by 2 spaces, but have too much existing
     ;; python code with indentation at 4 spaces.
diff --git a/lisp/ravi-init-tex.el b/lisp/ravi-init-tex.el
index b17248f..e6e215d 100644
--- a/lisp/ravi-init-tex.el
+++ b/lisp/ravi-init-tex.el
@@ -71,7 +71,7 @@
   (defun ravi/latex-init ()
     (setq fill-column 88)
     (when (functionp 'helm-dash) (setq-local dash-docs-docsets '("LaTeX")))
-    (when (functionp 'ravi/dash) (setq-local ravi/dash-docsets '("LaTeX"))))
+    (when (functionp 'consult-dash) (setq-local consult-dash-docsets '("LaTeX"))))
   )
 
 (use-package preview
diff --git a/lisp/ravi-init-web.el b/lisp/ravi-init-web.el
index 56bf7cd..508f089 100644
--- a/lisp/ravi-init-web.el
+++ b/lisp/ravi-init-web.el
@@ -54,7 +54,7 @@
       (emmet-mode)
       (setq js2-basic-offset 2)
       (when (functionp 'helm-dash) (setq-local dash-docs-docsets '("JavaScript" "jQuery" "jQuery UI")))
-      (when (functionp 'ravi/dash) (setq-local ravi/dash-docsets '("JavaScript" "jQuery" "jQuery UI"))))
+      (when (functionp 'consult-dash) (setq-local consult-dash-docsets '("JavaScript" "jQuery" "jQuery UI"))))
     (add-hook 'js2-mode-hook 'ravi/js2-mode-hook)))
 
 ;; Interact with the browser
@@ -85,7 +85,7 @@
 
     (defun ravi/web-mode-extra-hook ()
       (when (functionp 'helm-dash) (setq-local dash-docs-docsets '("HTML")))
-      (when (functionp 'ravi/dash) (setq-local ravi/dash-docsets '("HTML"))))
+      (when (functionp 'consult-dash) (setq-local consult-dash-docsets '("HTML"))))
     (add-hook 'web-mode-hook 'ravi/web-mode-extra-hook)
 
     ;; Customization
@@ -97,7 +97,7 @@
 
 (defun ravi/css-mode-extra-hook ()
   (when (functionp 'helm-dash) (setq-local dash-docs-docsets '("CSS")))
-  (when (functionp 'ravi/dash) (setq-local ravi/dash-docsets '("CSS"))))
+  (when (functionp 'consult-dash) (setq-local consult-dash-docsets '("CSS"))))
 (add-hook 'css-mode-hook 'ravi/css-mode-extra-hook)
 
 (provide 'ravi-init-web)