cider-find.el (12516B)
1 ;;; cider-find.el --- Functionality for finding things -*- lexical-binding: t -*- 2 3 ;; Copyright © 2013-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors 4 ;; 5 ;; Author: Bozhidar Batsov <bozhidar@batsov.dev> 6 ;; Artur Malabarba <bruce.connor.am@gmail.com> 7 8 ;; This program is free software: you can redistribute it and/or modify 9 ;; it under the terms of the GNU General Public License as published by 10 ;; the Free Software Foundation, either version 3 of the License, or 11 ;; (at your option) any later version. 12 13 ;; This program is distributed in the hope that it will be useful, 14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 ;; GNU General Public License for more details. 17 18 ;; You should have received a copy of the GNU General Public License 19 ;; along with this program. If not, see <http://www.gnu.org/licenses/>. 20 21 ;; This file is not part of GNU Emacs. 22 23 ;;; Commentary: 24 25 ;; A bunch of commands for finding resources and definitions. 26 27 ;;; Code: 28 29 (require 'cider-client) 30 (require 'cider-common) 31 (require 'cider-resolve) 32 33 (require 'thingatpt) 34 35 (defun cider--find-var-other-window (var &optional line) 36 "Find the definition of VAR, optionally at a specific LINE. 37 38 Display the results in a different window." 39 (if-let* ((info (cider-var-info var))) 40 (progn 41 (if line (setq info (nrepl-dict-put info "line" line))) 42 (cider--jump-to-loc-from-info info t)) 43 (user-error "Symbol `%s' not resolved" var))) 44 45 (defun cider--find-var (var &optional line) 46 "Find the definition of VAR, optionally at a specific LINE." 47 (if-let* ((info (cider-var-info var))) 48 (progn 49 (if line (setq info (nrepl-dict-put info "line" line))) 50 (cider--jump-to-loc-from-info info)) 51 (user-error "Symbol `%s' not resolved" var))) 52 53 ;;;###autoload 54 (defun cider-find-var (&optional arg var line) 55 "Find definition for VAR at LINE. 56 Prompt according to prefix ARG and `cider-prompt-for-symbol'. 57 A single or double prefix argument inverts the meaning of 58 `cider-prompt-for-symbol'. A prefix of `-` or a double prefix argument causes 59 the results to be displayed in a different window. The default value is 60 thing at point." 61 (interactive "P") 62 (if var 63 (cider--find-var var line) 64 (funcall (cider-prompt-for-symbol-function arg) 65 "Symbol" 66 (if (cider--open-other-window-p arg) 67 #'cider--find-var-other-window 68 #'cider--find-var)))) 69 70 ;;;###autoload 71 (defun cider-find-dwim-at-mouse (event) 72 "Find and display variable or resource at mouse EVENT." 73 (interactive "e") 74 (if-let* ((symbol-file (save-excursion 75 (mouse-set-point event) 76 (cider-symbol-at-point 'look-back)))) 77 (cider-find-dwim symbol-file) 78 (user-error "No variable or resource here"))) 79 80 (defun cider--find-dwim (symbol-file callback &optional other-window) 81 "Find the SYMBOL-FILE at point. 82 CALLBACK upon failure to invoke prompt if not prompted previously. 83 Show results in a different window if OTHER-WINDOW is true." 84 (if-let* ((info (cider-var-info symbol-file))) 85 (cider--jump-to-loc-from-info info other-window) 86 (progn 87 (cider-ensure-op-supported "resource") 88 (if-let* ((resource (cider-sync-request:resource symbol-file)) 89 (buffer (cider-find-file resource))) 90 (cider-jump-to buffer 0 other-window) 91 (if (cider--prompt-for-symbol-p current-prefix-arg) 92 (error "Resource or var %s not resolved" symbol-file) 93 (let ((current-prefix-arg (if current-prefix-arg nil '(4)))) 94 (call-interactively callback))))))) 95 96 (defun cider--find-dwim-interactive (prompt) 97 "Get interactive arguments for jump-to functions using PROMPT as needed." 98 (if (cider--prompt-for-symbol-p current-prefix-arg) 99 (list 100 (cider-read-from-minibuffer prompt (thing-at-point 'filename))) 101 (list (or (thing-at-point 'filename) "")))) ; No prompt. 102 103 (defun cider-find-dwim-other-window (symbol-file) 104 "Jump to SYMBOL-FILE at point, place results in other window." 105 (interactive (cider--find-dwim-interactive "Jump to: ")) 106 (cider--find-dwim symbol-file 'cider-find-dwim-other-window t)) 107 108 ;;;###autoload 109 (defun cider-find-dwim (symbol-file) 110 "Find and display the SYMBOL-FILE at point. 111 SYMBOL-FILE could be a var or a resource. If thing at point is empty then 112 show Dired on project. If var is not found, try to jump to resource of the 113 same name. When called interactively, a prompt is given according to the 114 variable `cider-prompt-for-symbol'. A single or double prefix argument 115 inverts the meaning. A prefix of `-' or a double prefix argument causes 116 the results to be displayed in a different window. A default value of thing 117 at point is given when prompted." 118 (interactive (cider--find-dwim-interactive "Jump to: ")) 119 (cider--find-dwim symbol-file `cider-find-dwim 120 (cider--open-other-window-p current-prefix-arg))) 121 122 ;;;###autoload 123 (defun cider-find-resource (path) 124 "Find the resource at PATH. 125 Prompt for input as indicated by the variable `cider-prompt-for-symbol'. 126 A single or double prefix argument inverts the meaning of 127 `cider-prompt-for-symbol'. A prefix argument of `-` or a double prefix 128 argument causes the results to be displayed in other window. The default 129 value is thing at point." 130 (interactive 131 (list 132 (if (cider--prompt-for-symbol-p current-prefix-arg) 133 (completing-read "Resource: " 134 (cider-sync-request:resources-list) 135 nil nil 136 (thing-at-point 'filename)) 137 (or (thing-at-point 'filename) "")))) 138 (cider-ensure-op-supported "resource") 139 (when (= (length path) 0) 140 (error "Cannot find resource for empty path")) 141 (if-let* ((resource (cider-sync-request:resource path)) 142 (buffer (cider-find-file resource))) 143 (cider-jump-to buffer nil (cider--open-other-window-p current-prefix-arg)) 144 (if (cider--prompt-for-symbol-p current-prefix-arg) 145 (error "Cannot find resource %s" path) 146 (let ((current-prefix-arg (cider--invert-prefix-arg current-prefix-arg))) 147 (call-interactively 'cider-find-resource))))) 148 149 (defun cider--invert-prefix-arg (arg) 150 "Invert the effect of prefix value ARG on `cider-prompt-for-symbol'. 151 This function preserves the `other-window' meaning of ARG." 152 (let ((narg (prefix-numeric-value arg))) 153 (pcase narg 154 (16 -1) ; empty empty -> - 155 (-1 16) ; - -> empty empty 156 (4 nil) ; empty -> no-prefix 157 (_ 4)))) ; no-prefix -> empty 158 159 (defun cider--prefix-invert-prompt-p (arg) 160 "Test prefix value ARG for its effect on `cider-prompt-for-symbol`." 161 (let ((narg (prefix-numeric-value arg))) 162 (pcase narg 163 (16 t) ; empty empty 164 (4 t) ; empty 165 (_ nil)))) 166 167 (defun cider--prompt-for-symbol-p (&optional prefix) 168 "Check if cider should prompt for symbol. 169 Tests againsts PREFIX and the value of `cider-prompt-for-symbol'. 170 Invert meaning of `cider-prompt-for-symbol' if PREFIX indicates it should be." 171 (if (cider--prefix-invert-prompt-p prefix) 172 (not cider-prompt-for-symbol) cider-prompt-for-symbol)) 173 174 (defun cider--find-ns (ns &optional other-window) 175 "Find the file containing NS's definition. 176 Optionally open it in a different window if OTHER-WINDOW is truthy." 177 (if-let* ((path (cider-sync-request:ns-path ns))) 178 (cider-jump-to (cider-find-file path) nil other-window) 179 (user-error "Can't find namespace `%s'" ns))) 180 181 ;;;###autoload 182 (defun cider-find-ns (&optional arg ns) 183 "Find the file containing NS. 184 A prefix ARG of `-` or a double prefix argument causes 185 the results to be displayed in a different window." 186 (interactive "P") 187 (cider-ensure-connected) 188 (cider-ensure-op-supported "ns-path") 189 (if ns 190 (cider--find-ns ns) 191 (let* ((namespaces (cider-sync-request:ns-list)) 192 (ns (completing-read "Find namespace: " namespaces))) 193 (cider--find-ns ns (cider--open-other-window-p arg))))) 194 195 ;;;###autoload 196 (defun cider-find-keyword (&optional arg) 197 "Find the namespace of the keyword at point and its first occurrence there. 198 199 For instance - if the keyword at point is \":cider.demo/keyword\", this command 200 would find the namespace \"cider.demo\" and afterwards find the first mention 201 of \"::keyword\" there. 202 203 Prompt according to prefix ARG and `cider-prompt-for-symbol'. 204 A single or double prefix argument inverts the meaning of 205 `cider-prompt-for-symbol'. A prefix of `-` or a double prefix argument causes 206 the results to be displayed in a different window. The default value is 207 thing at point." 208 (interactive "P") 209 (cider-ensure-connected) 210 (let* ((kw (let ((kw-at-point (cider-symbol-at-point 'look-back))) 211 (if (or cider-prompt-for-symbol arg) 212 (read-string 213 (format "Keyword (default %s): " kw-at-point) 214 nil nil kw-at-point) 215 kw-at-point))) 216 (ns-qualifier (and 217 (string-match "^:+\\(.+\\)/.+$" kw) 218 (match-string 1 kw))) 219 (kw-ns (if ns-qualifier 220 (cider-resolve-alias (cider-current-ns) ns-qualifier) 221 (cider-current-ns))) 222 (kw-to-find (concat "::" (replace-regexp-in-string "^:+\\(.+/\\)?" "" kw)))) 223 224 (when (and ns-qualifier (string= kw-ns (cider-current-ns))) 225 (error "Could not resolve alias `%s' in `%s'" ns-qualifier (cider-current-ns))) 226 (cider--find-ns kw-ns arg) 227 (search-forward-regexp kw-to-find nil 'noerror))) 228 229 ;;; xref integration 230 ;; 231 ;; xref.el was introduced in Emacs 25.1. 232 ;; CIDER's xref backend was added in CIDER 1.2. 233 (defun cider--xref-backend () 234 "Used for xref integration." 235 ;; Check if `cider-nrepl` middleware is loaded. Allows fallback to other xref 236 ;; backends, if cider-nrepl is not loaded. 237 (when (cider-nrepl-op-supported-p "ns-path" nil 'skip-ensure) 238 'cider)) 239 240 (cl-defmethod xref-backend-identifier-at-point ((_backend (eql cider))) 241 "Return the relevant identifier at point." 242 (cider-symbol-at-point 'look-back)) 243 244 (defun cider--var-to-xref-location (var) 245 "Get location of definition of VAR." 246 (when-let* ((info (cider-var-info var)) 247 (line (nrepl-dict-get info "line")) 248 (file (nrepl-dict-get info "file")) 249 (buf (cider--find-buffer-for-file file))) 250 (xref-make-buffer-location 251 buf 252 (with-current-buffer buf 253 (save-excursion 254 (goto-char 0) 255 (forward-line (1- line)) 256 (back-to-indentation) 257 (point)))))) 258 259 (cl-defmethod xref-backend-definitions ((_backend (eql cider)) var) 260 "Find definitions of VAR." 261 (cider-ensure-connected) 262 (cider-ensure-op-supported "ns-path") 263 (when-let* ((loc (cider--var-to-xref-location var))) 264 (list (xref-make var loc)))) 265 266 (cl-defmethod xref-backend-identifier-completion-table ((_backend (eql cider))) 267 "Return the completion table for identifiers." 268 (cider-ensure-connected) 269 (when-let* ((ns (cider-current-ns)) 270 (results (cider-sync-request:ns-vars ns))) 271 results)) 272 273 (cl-defmethod xref-backend-references ((_backend (eql cider)) var) 274 "Find references of VAR." 275 (cider-ensure-connected) 276 (cider-ensure-op-supported "fn-refs") 277 (when-let* ((ns (cider-current-ns)) 278 (results (cider-sync-request:fn-refs ns var))) 279 (mapcar (lambda (info) 280 (let* ((filename (nrepl-dict-get info "file")) 281 (column (nrepl-dict-get info "column")) 282 (line (nrepl-dict-get info "line")) 283 (loc (xref-make-file-location filename line column))) 284 (xref-make filename loc))) 285 results))) 286 287 (cl-defmethod xref-backend-apropos ((_backend (eql cider)) pattern) 288 "Find all symbols that match regexp PATTERN." 289 (cider-ensure-connected) 290 (cider-ensure-op-supported "apropos") 291 (when-let* ((ns (cider-current-ns)) 292 (results (cider-sync-request:apropos pattern ns t t completion-ignore-case))) 293 (mapcar (lambda (info) 294 (let* ((symbol (nrepl-dict-get info "name")) 295 (loc (cider--var-to-xref-location symbol)) 296 (type (nrepl-dict-get info "type")) 297 (doc (nrepl-dict-get info "doc"))) 298 (xref-make (format "[%s] %s\n %s" (propertize symbol 'face 'bold) (capitalize type) doc) 299 loc))) 300 results))) 301 302 (provide 'cider-find) 303 ;;; cider-find.el ends here