cider-apropos.el (9391B)
1 ;;; cider-apropos.el --- Apropos functionality for Clojure -*- lexical-binding: t -*- 2 3 ;; Copyright © 2014-2023 Jeff Valk, Bozhidar Batsov and CIDER contributors 4 ;; 5 ;; Author: Jeff Valk <jv@jeffvalk.com> 6 7 ;; This program is free software: you can redistribute it and/or modify 8 ;; it under the terms of the GNU General Public License as published by 9 ;; the Free Software Foundation, either version 3 of the License, or 10 ;; (at your option) any later version. 11 12 ;; This program is distributed in the hope that it will be useful, 13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ;; GNU General Public License for more details. 16 17 ;; You should have received a copy of the GNU General Public License 18 ;; along with this program. If not, see <http://www.gnu.org/licenses/>. 19 20 ;; This file is not part of GNU Emacs. 21 22 ;;; Commentary: 23 24 ;; Apropos functionality for Clojure. 25 26 ;;; Code: 27 28 (require 'cider-doc) ; for cider-doc-lookup 29 (require 'cider-find) ; for cider--find-var 30 (require 'cider-util) 31 (require 'subr-x) 32 (require 'cider-connection) ; for cider-ensure-connected 33 34 (require 'cider-client) 35 (require 'cider-popup) 36 (require 'nrepl-dict) 37 38 (require 'apropos) 39 (require 'button) 40 41 (defconst cider-apropos-buffer "*cider-apropos*") 42 43 (defcustom cider-apropos-actions '(("display-doc" . cider-doc-lookup) 44 ("find-def" . cider--find-var) 45 ("lookup-on-clojuredocs" . cider-clojuredocs-lookup)) 46 "Controls the actions to be applied on the symbol found by an apropos search. 47 The first action key in the list will be selected as default. If the list 48 contains only one action key, the associated action function will be 49 applied automatically. An action function can be any function that receives 50 the symbol found by the apropos search as argument." 51 :type '(alist :key-type string :value-type function) 52 :group 'cider 53 :package-version '(cider . "0.13.0")) 54 55 (define-button-type 'apropos-special-form 56 'apropos-label "Special form" 57 'apropos-short-label "s" 58 'face 'font-lock-keyword-face 59 'help-echo "mouse-2, RET: Display more help on this special form" 60 'follow-link t 61 'action (lambda (button) 62 (describe-function (button-get button 'apropos-symbol)))) 63 64 (defun cider-apropos-doc (button) 65 "Display documentation for the symbol represented at BUTTON." 66 (cider-doc-lookup (button-get button 'apropos-symbol))) 67 68 (defun cider-apropos-summary (query ns docs-p include-private-p case-sensitive-p) 69 "Return a short description for the performed apropos search. 70 71 QUERY can be a regular expression list of space-separated words 72 \(e.g take while) which will be converted to a regular expression 73 \(like take.+while) automatically behind the scenes. The search may be 74 limited to the namespace NS, and may optionally search doc strings 75 \(based on DOCS-P), include private vars (based on INCLUDE-PRIVATE-P), 76 and be case-sensitive (based on CASE-SENSITIVE-P)." 77 (concat (if case-sensitive-p "Case-sensitive " "") 78 (if docs-p "Documentation " "") 79 (format "Apropos for %S" query) 80 (if ns (format " in namespace %S" ns) "") 81 (if include-private-p 82 " (public and private symbols)" 83 " (public symbols only)"))) 84 85 (defun cider-apropos-highlight (doc query) 86 "Return the DOC string propertized to highlight QUERY matches." 87 (let ((pos 0)) 88 (while (string-match query doc pos) 89 (setq pos (match-end 0)) 90 (put-text-property (match-beginning 0) 91 (match-end 0) 92 'font-lock-face apropos-match-face doc))) 93 doc) 94 95 (defvar cider-use-tooltips) 96 (defun cider-apropos-result (result query docs-p) 97 "Emit a RESULT matching QUERY into current buffer, formatted for DOCS-P." 98 (nrepl-dbind-response result (name type doc) 99 (let* ((label (capitalize (if (string= type "variable") "var" type))) 100 (help (concat "Display doc for this " (downcase label))) 101 (props (list 'apropos-symbol name 102 'action #'cider-apropos-doc)) 103 (props (if cider-use-tooltips 104 (append props (list 'help-echo help)) 105 props))) 106 (cider-propertize-region props 107 (insert-text-button name 'type 'apropos-symbol) 108 (insert "\n ") 109 (insert-text-button label 'type (intern (concat "apropos-" type))) 110 (insert ": ") 111 (let ((beg (point))) 112 (if docs-p 113 (insert (cider-apropos-highlight doc query) "\n") 114 (insert doc) 115 (fill-region beg (point)))) 116 (insert "\n"))))) 117 118 (defun cider-show-apropos (summary results query docs-p) 119 "Show SUMMARY and RESULTS for QUERY in a pop-up buffer, formatted for DOCS-P." 120 (with-current-buffer (cider-popup-buffer cider-apropos-buffer 'select 'apropos-mode 'ancillary) 121 (let ((inhibit-read-only t)) 122 (if (boundp 'header-line-format) 123 (setq-local header-line-format summary) 124 (insert summary "\n\n")) 125 (dolist (result results) 126 (cider-apropos-result result query docs-p)) 127 (goto-char (point-min))))) 128 129 ;;;###autoload 130 (defun cider-apropos (query &optional ns docs-p privates-p case-sensitive-p) 131 "Show all symbols whose names match QUERY, a regular expression. 132 QUERY can also be a list of space-separated words (e.g. take while) which 133 will be converted to a regular expression (like take.+while) automatically 134 behind the scenes. The search may be limited to the namespace NS, and may 135 optionally search doc strings (based on DOCS-P), include private vars 136 \(based on PRIVATES-P), and be case-sensitive (based on CASE-SENSITIVE-P)." 137 (interactive 138 (cons (read-string "Search for Clojure symbol (a regular expression): ") 139 (when current-prefix-arg 140 (list (let ((ns (completing-read "Namespace (default is all): " (cider-sync-request:ns-list)))) 141 (if (string= ns "") nil ns)) 142 (y-or-n-p "Search doc strings? ") 143 (y-or-n-p "Include private symbols? ") 144 (y-or-n-p "Case-sensitive? "))))) 145 (cider-ensure-connected) 146 (cider-ensure-op-supported "apropos") 147 (if-let* ((summary (cider-apropos-summary 148 query ns docs-p privates-p case-sensitive-p)) 149 (results (cider-sync-request:apropos query ns docs-p privates-p case-sensitive-p))) 150 (cider-show-apropos summary results query docs-p) 151 (message "No apropos matches for %S" query))) 152 153 ;;;###autoload 154 (defun cider-apropos-documentation () 155 "Shortcut for (cider-apropos <query> nil t)." 156 (interactive) 157 (cider-ensure-connected) 158 (cider-ensure-op-supported "apropos") 159 (cider-apropos (read-string "Search for Clojure documentation (a regular expression): ") nil t)) 160 161 (defun cider-apropos-act-on-symbol (symbol) 162 "Apply selected action on SYMBOL." 163 (let* ((first-action-key (car (car cider-apropos-actions))) 164 (action-key (if (= 1 (length cider-apropos-actions)) 165 first-action-key 166 (completing-read (format "Choose action to apply to `%s` (default %s): " 167 symbol first-action-key) 168 cider-apropos-actions nil nil nil nil first-action-key))) 169 (action-fn (cdr (assoc action-key cider-apropos-actions)))) 170 (if action-fn 171 (funcall action-fn symbol) 172 (user-error "Unknown action `%s`" action-key)))) 173 174 ;;;###autoload 175 (defun cider-apropos-select (query &optional ns docs-p privates-p case-sensitive-p) 176 "Similar to `cider-apropos', but presents the results in a completing read. 177 Show all symbols whose names match QUERY, a regular expression. 178 QUERY can also be a list of space-separated words (e.g. take while) which 179 will be converted to a regular expression (like take.+while) automatically 180 behind the scenes. The search may be limited to the namespace NS, and may 181 optionally search doc strings (based on DOCS-P), include private vars 182 \(based on PRIVATES-P), and be case-sensitive (based on CASE-SENSITIVE-P)." 183 (interactive 184 (cons (read-string "Search for Clojure symbol (a regular expression): ") 185 (when current-prefix-arg 186 (list (let ((ns (completing-read "Namespace (default is all): " (cider-sync-request:ns-list)))) 187 (if (string= ns "") nil ns)) 188 (y-or-n-p "Search doc strings? ") 189 (y-or-n-p "Include private symbols? ") 190 (y-or-n-p "Case-sensitive? "))))) 191 (cider-ensure-connected) 192 (cider-ensure-op-supported "apropos") 193 (if-let* ((summary (cider-apropos-summary 194 query ns docs-p privates-p case-sensitive-p)) 195 (results (mapcar (lambda (r) (nrepl-dict-get r "name")) 196 (cider-sync-request:apropos query ns docs-p privates-p case-sensitive-p)))) 197 (cider-apropos-act-on-symbol (completing-read (concat summary ": ") results)) 198 (message "No apropos matches for %S" query))) 199 200 ;;;###autoload 201 (defun cider-apropos-documentation-select () 202 "Shortcut for (cider-apropos-select <query> nil t)." 203 (interactive) 204 (cider-ensure-connected) 205 (cider-ensure-op-supported "apropos") 206 (cider-apropos-select (read-string "Search for Clojure documentation (a regular expression): ") nil t)) 207 208 (provide 'cider-apropos) 209 210 ;;; cider-apropos.el ends here