|
| 1 | +;;; cider-xref.el --- Xref functionality for Clojure -*- lexical-binding: t -*- |
| 2 | + |
| 3 | +;; Copyright © 2014-2019 Jeff Valk, Bozhidar Batsov and CIDER contributors |
| 4 | +;; |
| 5 | +;; Author: Jeff Valk <[email protected]> |
| 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 | +;; Xref functionality for Clojure. |
| 25 | + |
| 26 | +;;; Code: |
| 27 | + |
| 28 | +(require 'cider-doc) |
| 29 | +(require 'cider-util) |
| 30 | +(require 'subr-x) |
| 31 | +(require 'cider-compat) |
| 32 | + |
| 33 | +(require 'cider-client) |
| 34 | +(require 'cider-popup) |
| 35 | +(require 'nrepl-dict) |
| 36 | + |
| 37 | +(require 'clojure-mode) |
| 38 | +(require 'apropos) |
| 39 | +(require 'button) |
| 40 | + |
| 41 | +(defconst cider-xref-buffer "*cider-xref*") |
| 42 | + |
| 43 | +(defcustom cider-xref-actions '(("display-doc" . cider-doc-lookup) |
| 44 | + ("find-def" . cider--find-var) |
| 45 | + ("lookup-on-grimoire" . cider-grimoire-lookup)) |
| 46 | + "Controls the actions to be applied on the symbol found by an xref 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 xref search as argument." |
| 51 | + :type '(alist :key-type string :value-type function) |
| 52 | + :group 'cider |
| 53 | + :package-version '(cider . "0.22.0")) |
| 54 | + |
| 55 | +(defun cider-xref-doc (button) |
| 56 | + "Display documentation for the symbol represented at BUTTON." |
| 57 | + (cider-doc-lookup (button-get button 'apropos-symbol))) |
| 58 | + |
| 59 | +(defun cider-xref-result (result) |
| 60 | + "Emit a RESULT into current buffer." |
| 61 | + (let ((var-name (nrepl-dict-get result "name"))) |
| 62 | + (cider-propertize-region (list 'apropos-symbol var-name |
| 63 | + 'action 'cider-xref-doc |
| 64 | + 'help-echo "Display doc") |
| 65 | + (insert-text-button var-name 'type 'apropos-symbol) |
| 66 | + (insert "\n ") |
| 67 | + (insert-text-button "Function" 'type 'apropos-function) |
| 68 | + (insert ": ") |
| 69 | + (let ((beg (point))) |
| 70 | + (insert (nrepl-dict-get result "doc")) |
| 71 | + (fill-region beg (point))) |
| 72 | + (insert "\n") |
| 73 | + (if-let* ((file (nrepl-dict-get result "file")) |
| 74 | + (line (nrepl-dict-get result "line"))) |
| 75 | + (progn |
| 76 | + (insert (propertize var-name |
| 77 | + 'font-lock-face 'font-lock-function-name-face) |
| 78 | + " is defined in ") |
| 79 | + (insert-text-button (cider--abbreviate-file-protocol file) |
| 80 | + 'follow-link t |
| 81 | + 'action (lambda (_x) |
| 82 | + (cider-xref-source file line var-name))) |
| 83 | + (insert ".")) |
| 84 | + (insert "Definition location unavailable.")) |
| 85 | + (insert "\n")))) |
| 86 | + |
| 87 | +(defun cider-xref-source (file line name) |
| 88 | + "Find source for FILE, LINE and NAME." |
| 89 | + (interactive) |
| 90 | + (if file |
| 91 | + (if-let* ((buffer (and (not (cider--tooling-file-p file)) |
| 92 | + (cider-find-file file)))) |
| 93 | + (cider-jump-to buffer (if line |
| 94 | + (cons cider nil) |
| 95 | + name) |
| 96 | + nil) |
| 97 | + (user-error |
| 98 | + (substitute-command-keys |
| 99 | + "Can't find the source because it wasn't defined with `cider-eval-buffer'"))) |
| 100 | + (error "No source location for %s" namel))) |
| 101 | + |
| 102 | +(declare-function cider-mode "cider-mode") |
| 103 | + |
| 104 | +(defun cider-show-xref (summary results) |
| 105 | + "Show SUMMARY and RESULTS in a pop-up buffer." |
| 106 | + (with-current-buffer (cider-popup-buffer cider-xref-buffer 'select 'apropos-mode 'ancillary) |
| 107 | + (let ((inhibit-read-only t)) |
| 108 | + (if (boundp 'header-line-format) |
| 109 | + (setq-local header-line-format summary) |
| 110 | + (insert summary "\n\n")) |
| 111 | + (dolist (result results) |
| 112 | + (cider-xref-result result)) |
| 113 | + (goto-char (point-min))))) |
| 114 | + |
| 115 | +;;;###autoload |
| 116 | +(defun cider-xref-fn-refs (&optional ns symbol) |
| 117 | + "Show all functions that reference the var matching NS and SYMBOL." |
| 118 | + (interactive) |
| 119 | + (cider-ensure-connected) |
| 120 | + (cider-ensure-op-supported "fn-refs") |
| 121 | + (if-let* ((ns (or ns (cider-current-ns))) |
| 122 | + (symbol (or symbol (cider-symbol-at-point))) |
| 123 | + (results (cider-sync-request:fn-refs ns symbol))) |
| 124 | + (cider-show-xref (format "Showing %d functions that reference %s in currently loaded namespaces" (length results) symbol) results) |
| 125 | + (message "No references found for %S in currently loaded namespaces" symbol))) |
| 126 | + |
| 127 | +;;;###autoload |
| 128 | +(defun cider-xref-fn-deps (&optional ns symbol) |
| 129 | + "Show all functions referenced by the var matching NS and SYMBOL." |
| 130 | + (interactive) |
| 131 | + (cider-ensure-connected) |
| 132 | + (cider-ensure-op-supported "fn-deps") |
| 133 | + (if-let* ((ns (or ns (cider-current-ns))) |
| 134 | + (symbol (or symbol (cider-symbol-at-point))) |
| 135 | + (results (cider-sync-request:fn-deps ns symbol))) |
| 136 | + (cider-show-xref (format "Showing %d function dependencies for %s" (length results) symbol) results) |
| 137 | + (message "No dependencies found for %S" symbol))) |
| 138 | + |
| 139 | +(defun cider-xref-act-on-symbol (symbol) |
| 140 | + "Apply selected action on SYMBOL." |
| 141 | + (let* ((first-action-key (car (car cider-xref-actions))) |
| 142 | + (action-key (if (= 1 (length cider-xref-actions)) |
| 143 | + first-action-key |
| 144 | + (completing-read (format "Choose action to apply to `%s` (default %s): " |
| 145 | + symbol first-action-key) |
| 146 | + cider-xref-actions nil nil nil nil first-action-key))) |
| 147 | + (action-fn (cdr (assoc action-key cider-xref-actions)))) |
| 148 | + (if action-fn |
| 149 | + (funcall action-fn symbol) |
| 150 | + (user-error "Unknown action `%s`" action-key)))) |
| 151 | + |
| 152 | +;;;###autoload |
| 153 | +(defun cider-xref-fn-refs-select (&optional ns symbol) |
| 154 | + "Displays the references for NS and SYMBOL using completing read." |
| 155 | + (interactive) |
| 156 | + (cider-ensure-connected) |
| 157 | + (cider-ensure-op-supported "fn-refs") |
| 158 | + (if-let* ((ns (or ns (cider-current-ns))) |
| 159 | + (symbol (or symbol (cider-symbol-at-point))) |
| 160 | + (results (mapcar (lambda (d) (nrepl-dict-get d "name")) (cider-sync-request:fn-refs ns symbol))) |
| 161 | + (summary (format "References for %s" symbol))) |
| 162 | + (cider-xref-act-on-symbol (completing-read (concat summary ": ") results)) |
| 163 | + (message "No references for %S found" symbol))) |
| 164 | + |
| 165 | +;;;###autoload |
| 166 | +(defun cider-xref-fn-deps-select (&optional ns symbol) |
| 167 | + "Displays the function dependencies for NS and SYMBOL using completing read." |
| 168 | + (interactive) |
| 169 | + (cider-ensure-connected) |
| 170 | + (cider-ensure-op-supported "fn-deps") |
| 171 | + (if-let* ((ns (or ns (cider-current-ns))) |
| 172 | + (symbol (or symbol (cider-symbol-at-point))) |
| 173 | + (results (mapcar (lambda (d) (nrepl-dict-get d "name")) (cider-sync-request:fn-deps ns symbol))) |
| 174 | + (summary (format "Dependencies for %s" symbol))) |
| 175 | + (cider-xref-act-on-symbol (completing-read (concat summary ": ") results)) |
| 176 | + (message "No dependencies for %S found" symbol))) |
| 177 | + |
| 178 | +(provide 'cider-xref) |
| 179 | + |
| 180 | +;;; cider-xref.el ends here |
0 commit comments