1 files changed, 135 insertions, 0 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