Klimi's new dotfiles with stow.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

232 line
8.7 KiB

4 年之前
  1. ;;; cider-browse-ns.el --- CIDER namespace browser
  2. ;; Copyright © 2014-2019 John Andrews, Bozhidar Batsov and CIDER contributors
  3. ;; Author: John Andrews <john.m.andrews@gmail.com>
  4. ;; This program is free software: you can redistribute it and/or modify
  5. ;; it under the terms of the GNU General Public License as published by
  6. ;; the Free Software Foundation, either version 3 of the License, or
  7. ;; (at your option) any later version.
  8. ;; This program is distributed in the hope that it will be useful,
  9. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. ;; GNU General Public License for more details.
  12. ;; You should have received a copy of the GNU General Public License
  13. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  14. ;; This file is not part of GNU Emacs.
  15. ;;; Commentary:
  16. ;; M-x cider-browse-ns
  17. ;;
  18. ;; Display a list of all vars in a namespace.
  19. ;; Pressing <enter> will take you to the cider-doc buffer for that var.
  20. ;; Pressing ^ will take you to a list of all namespaces (akin to `dired-mode').
  21. ;; M-x cider-browse-ns-all
  22. ;;
  23. ;; Explore Clojure namespaces by browsing a list of all namespaces.
  24. ;; Pressing <enter> expands into a list of that namespace's vars as if by
  25. ;; executing the command (cider-browse-ns "my.ns").
  26. ;;; Code:
  27. (require 'cider-client)
  28. (require 'cider-popup)
  29. (require 'cider-compat)
  30. (require 'cider-util)
  31. (require 'nrepl-dict)
  32. (require 'subr-x)
  33. (require 'easymenu)
  34. (require 'thingatpt)
  35. (defconst cider-browse-ns-buffer "*cider-ns-browser*")
  36. (defvar-local cider-browse-ns-current-ns nil)
  37. ;; Mode Definition
  38. (defvar cider-browse-ns-mode-map
  39. (let ((map (make-sparse-keymap)))
  40. (set-keymap-parent map cider-popup-buffer-mode-map)
  41. (define-key map "d" #'cider-browse-ns-doc-at-point)
  42. (define-key map "s" #'cider-browse-ns-find-at-point)
  43. (define-key map (kbd "RET") #'cider-browse-ns-operate-at-point)
  44. (define-key map "^" #'cider-browse-ns-all)
  45. (define-key map "n" #'next-line)
  46. (define-key map "p" #'previous-line)
  47. (easy-menu-define cider-browse-ns-mode-menu map
  48. "Menu for CIDER's namespace browser"
  49. '("Namespace Browser"
  50. ["Show doc" cider-browse-ns-doc-at-point]
  51. ["Go to definition" cider-browse-ns-find-at-point]
  52. "--"
  53. ["Browse all namespaces" cider-browse-ns-all]))
  54. map))
  55. (defvar cider-browse-ns-mouse-map
  56. (let ((map (make-sparse-keymap)))
  57. (define-key map [mouse-1] #'cider-browse-ns-handle-mouse)
  58. map))
  59. (define-derived-mode cider-browse-ns-mode special-mode "browse-ns"
  60. "Major mode for browsing Clojure namespaces.
  61. \\{cider-browse-ns-mode-map}"
  62. (setq-local electric-indent-chars nil)
  63. (setq-local sesman-system 'CIDER)
  64. (when cider-special-mode-truncate-lines
  65. (setq-local truncate-lines t))
  66. (setq-local cider-browse-ns-current-ns nil))
  67. (defun cider-browse-ns--text-face (var-meta)
  68. "Return font-lock-face for a var.
  69. VAR-META contains the metadata information used to decide a face.
  70. Presence of \"arglists-str\" and \"macro\" indicates a macro form.
  71. Only \"arglists-str\" indicates a function. Otherwise, its a variable.
  72. If the NAMESPACE is not loaded in the REPL, assume TEXT is a fn."
  73. (cond
  74. ((not var-meta) 'font-lock-function-name-face)
  75. ((and (nrepl-dict-contains var-meta "arglists")
  76. (string= (nrepl-dict-get var-meta "macro") "true"))
  77. 'font-lock-keyword-face)
  78. ((nrepl-dict-contains var-meta "arglists") 'font-lock-function-name-face)
  79. (t 'font-lock-variable-name-face)))
  80. (defun cider-browse-ns--properties (var var-meta)
  81. "Decorate VAR with a clickable keymap and a face.
  82. VAR-META is used to decide a font-lock face."
  83. (let ((face (cider-browse-ns--text-face var-meta)))
  84. (propertize var
  85. 'font-lock-face face
  86. 'mouse-face 'highlight
  87. 'keymap cider-browse-ns-mouse-map)))
  88. (defun cider-browse-ns--list (buffer title items &optional ns noerase)
  89. "Reset contents of BUFFER.
  90. Display TITLE at the top and ITEMS are indented underneath.
  91. If NS is non-nil, it is added to each item as the
  92. `cider-browse-ns-current-ns' text property. If NOERASE is non-nil, the
  93. contents of the buffer are not reset before inserting TITLE and ITEMS."
  94. (with-current-buffer buffer
  95. (cider-browse-ns-mode)
  96. (let ((inhibit-read-only t))
  97. (unless noerase (erase-buffer))
  98. (goto-char (point-max))
  99. (insert (cider-propertize title 'ns) "\n")
  100. (dolist (item items)
  101. (insert (propertize (concat " " item "\n")
  102. 'cider-browse-ns-current-ns ns)))
  103. (goto-char (point-min)))))
  104. (defun cider-browse-ns--first-doc-line (doc)
  105. "Return the first line of the given DOC string.
  106. If the first line of the DOC string contains multiple sentences, only
  107. the first sentence is returned. If the DOC string is nil, a Not documented
  108. string is returned."
  109. (if doc
  110. (let* ((split-newline (split-string doc "\n"))
  111. (first-line (car split-newline)))
  112. (cond
  113. ((string-match "\\. " first-line) (substring first-line 0 (match-end 0)))
  114. ((= 1 (length split-newline)) first-line)
  115. (t (concat first-line "..."))))
  116. "Not documented."))
  117. (defun cider-browse-ns--items (namespace)
  118. "Return the items to show in the namespace browser of the given NAMESPACE.
  119. Each item consists of a ns-var and the first line of its docstring."
  120. (let* ((ns-vars-with-meta (cider-sync-request:ns-vars-with-meta namespace))
  121. (propertized-ns-vars (nrepl-dict-map #'cider-browse-ns--properties ns-vars-with-meta)))
  122. (mapcar (lambda (ns-var)
  123. (let* ((doc (nrepl-dict-get-in ns-vars-with-meta (list ns-var "doc")))
  124. ;; to avoid (read nil)
  125. ;; it prompts the user for a Lisp expression
  126. (doc (when doc (read doc)))
  127. (first-doc-line (cider-browse-ns--first-doc-line doc)))
  128. (concat ns-var " " (propertize first-doc-line 'font-lock-face 'font-lock-doc-face))))
  129. propertized-ns-vars)))
  130. ;; Interactive Functions
  131. ;;;###autoload
  132. (defun cider-browse-ns (namespace)
  133. "List all NAMESPACE's vars in BUFFER."
  134. (interactive (list (completing-read "Browse namespace: " (cider-sync-request:ns-list))))
  135. (with-current-buffer (cider-popup-buffer cider-browse-ns-buffer 'select nil 'ancillary)
  136. (cider-browse-ns--list (current-buffer)
  137. namespace
  138. (cider-browse-ns--items namespace))
  139. (setq-local cider-browse-ns-current-ns namespace)))
  140. ;;;###autoload
  141. (defun cider-browse-ns-all ()
  142. "List all loaded namespaces in BUFFER."
  143. (interactive)
  144. (with-current-buffer (cider-popup-buffer cider-browse-ns-buffer 'select nil 'ancillary)
  145. (let ((names (cider-sync-request:ns-list)))
  146. (cider-browse-ns--list (current-buffer)
  147. "All loaded namespaces"
  148. (mapcar (lambda (name)
  149. (cider-browse-ns--properties name nil))
  150. names))
  151. (setq-local cider-browse-ns-current-ns nil))))
  152. (defun cider-browse-ns--thing-at-point ()
  153. "Get the thing at point.
  154. Return a list of the type ('ns or 'var) and the value."
  155. (let ((line (car (split-string (string-trim (thing-at-point 'line)) " "))))
  156. (if (string-match "\\." line)
  157. `(ns ,line)
  158. `(var ,(format "%s/%s"
  159. (or (get-text-property (point) 'cider-browse-ns-current-ns)
  160. cider-browse-ns-current-ns)
  161. line)))))
  162. (defun cider-browse-ns-doc-at-point ()
  163. "Show the documentation for the thing at current point."
  164. (interactive)
  165. (let* ((thing (cider-browse-ns--thing-at-point))
  166. (value (cadr thing)))
  167. ;; value is either some ns or a var
  168. (cider-doc-lookup value)))
  169. (defun cider-browse-ns-operate-at-point ()
  170. "Expand browser according to thing at current point.
  171. If the thing at point is a ns it will be browsed,
  172. and if the thing at point is some var - its documentation will
  173. be displayed."
  174. (interactive)
  175. (let* ((thing (cider-browse-ns--thing-at-point))
  176. (type (car thing))
  177. (value (cadr thing)))
  178. (if (eq type 'ns)
  179. (cider-browse-ns value)
  180. (cider-doc-lookup value))))
  181. (declare-function cider-find-ns "cider-find")
  182. (declare-function cider-find-var "cider-find")
  183. (defun cider-browse-ns-find-at-point ()
  184. "Find the definition of the thing at point."
  185. (interactive)
  186. (let* ((thing (cider-browse-ns--thing-at-point))
  187. (type (car thing))
  188. (value (cadr thing)))
  189. (if (eq type 'ns)
  190. (cider-find-ns nil value)
  191. (cider-find-var current-prefix-arg value))))
  192. (defun cider-browse-ns-handle-mouse (event)
  193. "Handle mouse click EVENT."
  194. (interactive "e")
  195. (cider-browse-ns-operate-at-point))
  196. (provide 'cider-browse-ns)
  197. ;;; cider-browse-ns.el ends here