Klimi's new dotfiles with stow.
選択できるのは25トピックまでです。 トピックは、先頭が英数字で、英数字とダッシュ('-')を使用した35文字以内のものにしてください。

183 行
7.5 KiB

  1. ;;; cider-xref.el --- Xref functionality for Clojure -*- lexical-binding: t -*-
  2. ;; Copyright © 2019 Bozhidar Batsov and CIDER contributors
  3. ;;
  4. ;; Author: Bozhidar Batsov <bozhidar@batsov.com>
  5. ;; This program is free software: you can redistribute it and/or modify
  6. ;; it under the terms of the GNU General Public License as published by
  7. ;; the Free Software Foundation, either version 3 of the License, or
  8. ;; (at your option) any later version.
  9. ;; This program is distributed in the hope that it will be useful,
  10. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. ;; GNU General Public License for more details.
  13. ;; You should have received a copy of the GNU General Public License
  14. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  15. ;; This file is not part of GNU Emacs.
  16. ;;; Commentary:
  17. ;; Xref (find usages) functionality for Clojure. The implementation is based on
  18. ;; ideas from this article https://metaredux.com/posts/2019/05/04/discovering-runtime-function-references-in-clojure.html.
  19. ;;
  20. ;; Keep in mind that you won't get references in namespaces that haven't been loaded yet.
  21. ;;; Code:
  22. (require 'cider-doc)
  23. (require 'cider-util)
  24. (require 'subr-x)
  25. (require 'cider-compat)
  26. (require 'cider-client)
  27. (require 'cider-popup)
  28. (require 'nrepl-dict)
  29. (require 'clojure-mode)
  30. (require 'apropos)
  31. (require 'button)
  32. (defconst cider-xref-buffer "*cider-xref*")
  33. (defcustom cider-xref-actions '(("display-doc" . cider-doc-lookup)
  34. ("find-def" . cider--find-var)
  35. ("lookup-on-grimoire" . cider-grimoire-lookup))
  36. "Controls the actions to be applied on the symbol found by an xref search.
  37. The first action key in the list will be selected as default. If the list
  38. contains only one action key, the associated action function will be
  39. applied automatically. An action function can be any function that receives
  40. the symbol found by the xref search as argument."
  41. :type '(alist :key-type string :value-type function)
  42. :group 'cider
  43. :package-version '(cider . "0.22.0"))
  44. (defun cider-xref-doc (button)
  45. "Display documentation for the symbol represented at BUTTON."
  46. (cider-doc-lookup (button-get button 'apropos-symbol)))
  47. (defun cider-xref-result (result)
  48. "Emit a RESULT into current buffer."
  49. (let ((var-name (nrepl-dict-get result "name")))
  50. (cider-propertize-region (list 'apropos-symbol var-name
  51. 'action 'cider-xref-doc
  52. 'help-echo "Display doc")
  53. (insert-text-button var-name 'type 'apropos-symbol)
  54. (insert "\n ")
  55. (insert-text-button "Function" 'type 'apropos-function)
  56. (insert ": ")
  57. (let ((beg (point)))
  58. (insert (nrepl-dict-get result "doc"))
  59. (fill-region beg (point)))
  60. (insert "\n")
  61. (if-let* ((file (nrepl-dict-get result "file"))
  62. (line (nrepl-dict-get result "line")))
  63. (progn
  64. (insert (propertize var-name
  65. 'font-lock-face 'font-lock-function-name-face)
  66. " is defined in ")
  67. (insert-text-button (cider--abbreviate-file-protocol file)
  68. 'follow-link t
  69. 'action (lambda (_x)
  70. (cider-xref-source file line var-name)))
  71. (insert "."))
  72. (insert "Definition location unavailable."))
  73. (insert "\n"))))
  74. (defun cider-xref-source (file line name)
  75. "Find source for FILE, LINE and NAME."
  76. (interactive)
  77. (if file
  78. (if-let* ((buffer (and (not (cider--tooling-file-p file))
  79. (cider-find-file file))))
  80. (cider-jump-to buffer (if line
  81. (cons line nil)
  82. name)
  83. nil)
  84. (user-error
  85. (substitute-command-keys
  86. "Can't find the source because it wasn't defined with `cider-eval-buffer'")))
  87. (error "No source location for %s" name)))
  88. (declare-function cider-mode "cider-mode")
  89. (defun cider-show-xref (summary results)
  90. "Show SUMMARY and RESULTS in a pop-up buffer."
  91. (with-current-buffer (cider-popup-buffer cider-xref-buffer 'select 'apropos-mode 'ancillary)
  92. (let ((inhibit-read-only t))
  93. (if (boundp 'header-line-format)
  94. (setq-local header-line-format summary)
  95. (insert summary "\n\n"))
  96. (dolist (result results)
  97. (cider-xref-result result))
  98. (goto-char (point-min)))))
  99. ;;;###autoload
  100. (defun cider-xref-fn-refs (&optional ns symbol)
  101. "Show all functions that reference the var matching NS and SYMBOL."
  102. (interactive)
  103. (cider-ensure-connected)
  104. (cider-ensure-op-supported "fn-refs")
  105. (if-let* ((ns (or ns (cider-current-ns)))
  106. (symbol (or symbol (cider-symbol-at-point)))
  107. (results (cider-sync-request:fn-refs ns symbol)))
  108. (cider-show-xref (format "Showing %d functions that reference %s in currently loaded namespaces" (length results) symbol) results)
  109. (message "No references found for %S in currently loaded namespaces" symbol)))
  110. ;;;###autoload
  111. (defun cider-xref-fn-deps (&optional ns symbol)
  112. "Show all functions referenced by the var matching NS and SYMBOL."
  113. (interactive)
  114. (cider-ensure-connected)
  115. (cider-ensure-op-supported "fn-deps")
  116. (if-let* ((ns (or ns (cider-current-ns)))
  117. (symbol (or symbol (cider-symbol-at-point)))
  118. (results (cider-sync-request:fn-deps ns symbol)))
  119. (cider-show-xref (format "Showing %d function dependencies for %s" (length results) symbol) results)
  120. (message "No dependencies found for %S" symbol)))
  121. (defun cider-xref-act-on-symbol (symbol)
  122. "Apply selected action on SYMBOL."
  123. (let* ((first-action-key (car (car cider-xref-actions)))
  124. (action-key (if (= 1 (length cider-xref-actions))
  125. first-action-key
  126. (completing-read (format "Choose action to apply to `%s` (default %s): "
  127. symbol first-action-key)
  128. cider-xref-actions nil nil nil nil first-action-key)))
  129. (action-fn (cdr (assoc action-key cider-xref-actions))))
  130. (if action-fn
  131. (funcall action-fn symbol)
  132. (user-error "Unknown action `%s`" action-key))))
  133. ;;;###autoload
  134. (defun cider-xref-fn-refs-select (&optional ns symbol)
  135. "Displays the references for NS and SYMBOL using completing read."
  136. (interactive)
  137. (cider-ensure-connected)
  138. (cider-ensure-op-supported "fn-refs")
  139. (if-let* ((ns (or ns (cider-current-ns)))
  140. (symbol (or symbol (cider-symbol-at-point)))
  141. (results (mapcar (lambda (d) (nrepl-dict-get d "name")) (cider-sync-request:fn-refs ns symbol)))
  142. (summary (format "References for %s" symbol)))
  143. (cider-xref-act-on-symbol (completing-read (concat summary ": ") results))
  144. (message "No references for %S found" symbol)))
  145. ;;;###autoload
  146. (defun cider-xref-fn-deps-select (&optional ns symbol)
  147. "Displays the function dependencies for NS and SYMBOL using completing read."
  148. (interactive)
  149. (cider-ensure-connected)
  150. (cider-ensure-op-supported "fn-deps")
  151. (if-let* ((ns (or ns (cider-current-ns)))
  152. (symbol (or symbol (cider-symbol-at-point)))
  153. (results (mapcar (lambda (d) (nrepl-dict-get d "name")) (cider-sync-request:fn-deps ns symbol)))
  154. (summary (format "Dependencies for %s" symbol)))
  155. (cider-xref-act-on-symbol (completing-read (concat summary ": ") results))
  156. (message "No dependencies for %S found" symbol)))
  157. (provide 'cider-xref)
  158. ;;; cider-xref.el ends here