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.

533 rivejä
20 KiB

4 vuotta sitten
  1. ;;; cider-doc.el --- CIDER documentation functionality -*- lexical-binding: t -*-
  2. ;; Copyright © 2014-2019 Bozhidar Batsov, Jeff Valk and CIDER contributors
  3. ;; Author: Jeff Valk <jv@jeffvalk.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. ;; Mode for formatting and presenting documentation
  17. ;;; Code:
  18. (require 'cider-common)
  19. (require 'subr-x)
  20. (require 'cider-compat)
  21. (require 'cider-util)
  22. (require 'cider-popup)
  23. (require 'cider-client)
  24. (require 'cider-grimoire)
  25. (require 'nrepl-dict)
  26. (require 'org-table)
  27. (require 'button)
  28. (require 'easymenu)
  29. (require 'cider-browse-spec)
  30. ;;; Variables
  31. (defgroup cider-doc nil
  32. "Documentation for CIDER."
  33. :prefix "cider-doc-"
  34. :group 'cider)
  35. (defcustom cider-doc-auto-select-buffer t
  36. "Controls whether to auto-select the doc popup buffer."
  37. :type 'boolean
  38. :group 'cider-doc
  39. :package-version '(cider . "0.15.0"))
  40. (declare-function cider-apropos "cider-apropos")
  41. (declare-function cider-apropos-select "cider-apropos")
  42. (declare-function cider-apropos-documentation "cider-apropos")
  43. (declare-function cider-apropos-documentation-select "cider-apropos")
  44. (defvar cider-doc-map
  45. (let (cider-doc-map)
  46. (define-prefix-command 'cider-doc-map)
  47. (define-key cider-doc-map (kbd "a") #'cider-apropos)
  48. (define-key cider-doc-map (kbd "C-a") #'cider-apropos)
  49. (define-key cider-doc-map (kbd "s") #'cider-apropos-select)
  50. (define-key cider-doc-map (kbd "C-s") #'cider-apropos-select)
  51. (define-key cider-doc-map (kbd "f") #'cider-apropos-documentation)
  52. (define-key cider-doc-map (kbd "C-f") #'cider-apropos-documentation)
  53. (define-key cider-doc-map (kbd "e") #'cider-apropos-documentation-select)
  54. (define-key cider-doc-map (kbd "C-e") #'cider-apropos-documentation-select)
  55. (define-key cider-doc-map (kbd "d") #'cider-doc)
  56. (define-key cider-doc-map (kbd "C-d") #'cider-doc)
  57. (define-key cider-doc-map (kbd "r") #'cider-grimoire)
  58. (define-key cider-doc-map (kbd "C-r") #'cider-grimoire)
  59. (define-key cider-doc-map (kbd "w") #'cider-grimoire-web)
  60. (define-key cider-doc-map (kbd "C-w") #'cider-grimoire-web)
  61. (define-key cider-doc-map (kbd "j") #'cider-javadoc)
  62. (define-key cider-doc-map (kbd "C-j") #'cider-javadoc)
  63. cider-doc-map)
  64. "CIDER documentation keymap.")
  65. (defconst cider-doc-menu
  66. '("Documentation"
  67. ["CiderDoc" cider-doc]
  68. ["JavaDoc in browser" cider-javadoc]
  69. ["Grimoire" cider-grimoire]
  70. ["Grimoire in browser" cider-grimoire-web]
  71. ["Search symbols" cider-apropos]
  72. ["Search symbols & select" cider-apropos-select]
  73. ["Search documentation" cider-apropos-documentation]
  74. ["Search documentation & select" cider-apropos-documentation-select]
  75. "--"
  76. ["Configure Doc buffer" (customize-group 'cider-docview-mode)])
  77. "CIDER documentation submenu.")
  78. ;;; cider-docview-mode
  79. (defgroup cider-docview-mode nil
  80. "Formatting/fontifying documentation viewer."
  81. :prefix "cider-docview-"
  82. :group 'cider)
  83. (defcustom cider-docview-fill-column fill-column
  84. "Fill column for docstrings in doc buffer."
  85. :type 'list
  86. :group 'cider-docview-mode
  87. :package-version '(cider . "0.7.0"))
  88. ;; Faces
  89. (defface cider-docview-emphasis-face
  90. '((t (:inherit default :underline t)))
  91. "Face for emphasized text"
  92. :group 'cider-docview-mode
  93. :package-version '(cider . "0.7.0"))
  94. (defface cider-docview-strong-face
  95. '((t (:inherit default :underline t :weight bold)))
  96. "Face for strongly emphasized text"
  97. :group 'cider-docview-mode
  98. :package-version '(cider . "0.7.0"))
  99. (defface cider-docview-literal-face
  100. '((t (:inherit font-lock-string-face)))
  101. "Face for literal text"
  102. :group 'cider-docview-mode
  103. :package-version '(cider . "0.7.0"))
  104. (defface cider-docview-table-border-face
  105. '((t (:inherit shadow)))
  106. "Face for table borders"
  107. :group 'cider-docview-mode
  108. :package-version '(cider . "0.7.0"))
  109. ;; Colors & Theme Support
  110. (defvar cider-docview-code-background-color
  111. (cider-scale-background-color)
  112. "Background color for code blocks.")
  113. (defadvice enable-theme (after cider-docview-adapt-to-theme activate)
  114. "When theme is changed, update `cider-docview-code-background-color'."
  115. (setq cider-docview-code-background-color (cider-scale-background-color)))
  116. (defadvice disable-theme (after cider-docview-adapt-to-theme activate)
  117. "When theme is disabled, update `cider-docview-code-background-color'."
  118. (setq cider-docview-code-background-color (cider-scale-background-color)))
  119. ;; Mode & key bindings
  120. (defvar cider-docview-mode-map
  121. (let ((map (make-sparse-keymap)))
  122. (define-key map "q" #'cider-popup-buffer-quit-function)
  123. (define-key map "g" #'cider-docview-grimoire)
  124. (define-key map "G" #'cider-docview-grimoire-web)
  125. (define-key map "j" #'cider-docview-javadoc)
  126. (define-key map "s" #'cider-docview-source)
  127. (define-key map (kbd "<backtab>") #'backward-button)
  128. (define-key map (kbd "TAB") #'forward-button)
  129. (easy-menu-define cider-docview-mode-menu map
  130. "Menu for CIDER's doc mode"
  131. `("CiderDoc"
  132. ["Look up in Grimoire" cider-docview-grimoire]
  133. ["Look up in Grimoire (browser)" cider-docview-grimoire-web]
  134. ["JavaDoc in browser" cider-docview-javadoc]
  135. ["Jump to source" cider-docview-source]
  136. "--"
  137. ["Quit" cider-popup-buffer-quit-function]
  138. ))
  139. map))
  140. (defvar cider-docview-symbol)
  141. (defvar cider-docview-javadoc-url)
  142. (defvar cider-docview-file)
  143. (defvar cider-docview-line)
  144. (define-derived-mode cider-docview-mode help-mode "Doc"
  145. "Major mode for displaying CIDER documentation
  146. \\{cider-docview-mode-map}"
  147. (setq buffer-read-only t)
  148. (setq-local sesman-system 'CIDER)
  149. (when cider-special-mode-truncate-lines
  150. (setq-local truncate-lines t))
  151. (setq-local electric-indent-chars nil)
  152. (setq-local cider-docview-symbol nil)
  153. (setq-local cider-docview-javadoc-url nil)
  154. (setq-local cider-docview-file nil)
  155. (setq-local cider-docview-line nil))
  156. ;;; Interactive functions
  157. (defun cider-docview-javadoc ()
  158. "Open the Javadoc for the current class, if available."
  159. (interactive)
  160. (if cider-docview-javadoc-url
  161. (browse-url cider-docview-javadoc-url)
  162. (error "No Javadoc available for %s" cider-docview-symbol)))
  163. (defun cider-javadoc-handler (symbol-name)
  164. "Invoke the nREPL \"info\" op on SYMBOL-NAME if available."
  165. (when symbol-name
  166. (let* ((info (cider-var-info symbol-name))
  167. (url (nrepl-dict-get info "javadoc")))
  168. (if url
  169. (browse-url url)
  170. (user-error "No Javadoc available for %s" symbol-name)))))
  171. (defun cider-javadoc (arg)
  172. "Open Javadoc documentation in a popup buffer.
  173. Prompts for the symbol to use, or uses the symbol at point, depending on
  174. the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the
  175. opposite of what that option dictates."
  176. (interactive "P")
  177. (cider-ensure-connected)
  178. (cider-ensure-op-supported "info")
  179. (funcall (cider-prompt-for-symbol-function arg)
  180. "Javadoc for"
  181. #'cider-javadoc-handler))
  182. (defun cider-docview-source ()
  183. "Open the source for the current symbol, if available."
  184. (interactive)
  185. (if cider-docview-file
  186. (if-let* ((buffer (and (not (cider--tooling-file-p cider-docview-file))
  187. (cider-find-file cider-docview-file))))
  188. (cider-jump-to buffer (if cider-docview-line
  189. (cons cider-docview-line nil)
  190. cider-docview-symbol)
  191. nil)
  192. (user-error
  193. (substitute-command-keys
  194. "Can't find the source because it wasn't defined with `cider-eval-buffer'")))
  195. (error "No source location for %s" cider-docview-symbol)))
  196. (defvar cider-buffer-ns)
  197. (declare-function cider-grimoire-lookup "cider-grimoire")
  198. (defun cider-docview-grimoire ()
  199. "Return the grimoire documentation for `cider-docview-symbol'."
  200. (interactive)
  201. (if cider-buffer-ns
  202. (cider-grimoire-lookup cider-docview-symbol)
  203. (error "%s cannot be looked up on Grimoire" cider-docview-symbol)))
  204. (declare-function cider-grimoire-web-lookup "cider-grimoire")
  205. (defun cider-docview-grimoire-web ()
  206. "Open the grimoire documentation for `cider-docview-symbol' in a web browser."
  207. (interactive)
  208. (if cider-buffer-ns
  209. (cider-grimoire-web-lookup cider-docview-symbol)
  210. (error "%s cannot be looked up on Grimoire" cider-docview-symbol)))
  211. (defconst cider-doc-buffer "*cider-doc*")
  212. (defun cider-create-doc-buffer (symbol)
  213. "Populates *cider-doc* with the documentation for SYMBOL."
  214. (when-let* ((info (cider-var-info symbol)))
  215. (cider-docview-render (cider-make-popup-buffer cider-doc-buffer nil 'ancillary) symbol info)))
  216. (defun cider-doc-lookup (symbol)
  217. "Look up documentation for SYMBOL."
  218. (if-let* ((buffer (cider-create-doc-buffer symbol)))
  219. (cider-popup-buffer-display buffer cider-doc-auto-select-buffer)
  220. (user-error "Symbol %s not resolved" symbol)))
  221. (defun cider-doc (&optional arg)
  222. "Open Clojure documentation in a popup buffer.
  223. Prompts for the symbol to use, or uses the symbol at point, depending on
  224. the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the
  225. opposite of what that option dictates."
  226. (interactive "P")
  227. (cider-ensure-connected)
  228. (funcall (cider-prompt-for-symbol-function arg)
  229. "Doc for"
  230. #'cider-doc-lookup))
  231. ;;; Font Lock and Formatting
  232. (defun cider-docview-fontify-code-blocks (buffer mode)
  233. "Font lock BUFFER code blocks using MODE and remove markdown characters.
  234. This processes the triple backtick GFM markdown extension. An overlay is used
  235. to shade the background. Blocks are marked to be ignored by other fonification
  236. and line wrap."
  237. (with-current-buffer buffer
  238. (save-excursion
  239. (while (search-forward-regexp "```\n" nil t)
  240. (replace-match "")
  241. (let ((beg (point))
  242. (bg `(:background ,cider-docview-code-background-color)))
  243. (when (search-forward-regexp "```\n" nil t)
  244. (replace-match "")
  245. (cider-font-lock-region-as mode beg (point))
  246. (overlay-put (make-overlay beg (point)) 'font-lock-face bg)
  247. (put-text-property beg (point) 'block 'code)))))))
  248. (defun cider-docview-fontify-literals (buffer)
  249. "Font lock BUFFER literal text and remove backtick markdown characters.
  250. Preformatted code text blocks are ignored."
  251. (with-current-buffer buffer
  252. (save-excursion
  253. (while (search-forward "`" nil t)
  254. (if (eq (get-text-property (point) 'block) 'code)
  255. (forward-char)
  256. (progn
  257. (replace-match "")
  258. (let ((beg (point)))
  259. (when (search-forward "`" (line-end-position) t)
  260. (replace-match "")
  261. (put-text-property beg (point) 'font-lock-face 'cider-docview-literal-face)))))))))
  262. (defun cider-docview-fontify-emphasis (buffer)
  263. "Font lock BUFFER emphasized text and remove markdown characters.
  264. One '*' represents emphasis, multiple '**'s represent strong emphasis.
  265. Preformatted code text blocks are ignored."
  266. (with-current-buffer buffer
  267. (save-excursion
  268. (while (search-forward-regexp "\\(*+\\)\\(\\w\\)" nil t)
  269. (if (eq (get-text-property (point) 'block) 'code)
  270. (forward-char)
  271. (progn
  272. (replace-match "\\2")
  273. (let ((beg (1- (point)))
  274. (face (if (> (length (match-string 1)) 1)
  275. 'cider-docview-strong-face
  276. 'cider-docview-emphasis-face)))
  277. (when (search-forward-regexp "\\(\\w\\)\\*+" (line-end-position) t)
  278. (replace-match "\\1")
  279. (put-text-property beg (point) 'font-lock-face face)))))))))
  280. (defun cider-docview-format-tables (buffer)
  281. "Align BUFFER tables and dim borders.
  282. This processes the GFM table markdown extension using `org-table'.
  283. Tables are marked to be ignored by line wrap."
  284. (with-current-buffer buffer
  285. (save-excursion
  286. (let ((border 'cider-docview-table-border-face))
  287. (org-table-map-tables
  288. (lambda ()
  289. (org-table-align)
  290. (goto-char (org-table-begin))
  291. (while (search-forward-regexp "[+|-]" (org-table-end) t)
  292. (put-text-property (match-beginning 0) (match-end 0) 'font-lock-face border))
  293. (put-text-property (org-table-begin) (org-table-end) 'block 'table)))))))
  294. (defun cider-docview-wrap-text (buffer)
  295. "For text in BUFFER not propertized as 'block', apply line wrap."
  296. (with-current-buffer buffer
  297. (save-excursion
  298. (while (not (eobp))
  299. (unless (get-text-property (point) 'block)
  300. (fill-region (point) (line-end-position)))
  301. (forward-line)))))
  302. ;;; Rendering
  303. (defun cider-docview-render-java-doc (buffer text)
  304. "Emit into BUFFER formatted doc TEXT for a Java class or member."
  305. (with-current-buffer buffer
  306. (let ((beg (point)))
  307. (insert text)
  308. (save-excursion
  309. (goto-char beg)
  310. (cider-docview-fontify-code-blocks buffer 'java-mode) ; left alone hereafter
  311. (cider-docview-fontify-literals buffer)
  312. (cider-docview-fontify-emphasis buffer)
  313. (cider-docview-format-tables buffer) ; may contain literals, emphasis
  314. (cider-docview-wrap-text buffer))))) ; ignores code, table blocks
  315. (defun cider--abbreviate-file-protocol (file-with-protocol)
  316. "Abbreviate the file-path in `file:/path/to/file' of FILE-WITH-PROTOCOL."
  317. (if (string-match "\\`file:\\(.*\\)" file-with-protocol)
  318. (let ((file (match-string 1 file-with-protocol))
  319. (proj-dir (clojure-project-dir)))
  320. (if (and proj-dir
  321. (file-in-directory-p file proj-dir))
  322. (file-relative-name file proj-dir)
  323. file))
  324. file-with-protocol))
  325. (defun cider-docview-render-info (buffer info)
  326. "Emit into BUFFER formatted INFO for the Clojure or Java symbol."
  327. (let* ((ns (nrepl-dict-get info "ns"))
  328. (name (nrepl-dict-get info "name"))
  329. (added (nrepl-dict-get info "added"))
  330. (depr (nrepl-dict-get info "deprecated"))
  331. (macro (nrepl-dict-get info "macro"))
  332. (special (nrepl-dict-get info "special-form"))
  333. (forms (when-let* ((str (nrepl-dict-get info "forms-str")))
  334. (split-string str "\n")))
  335. (args (when-let* ((str (nrepl-dict-get info "arglists-str")))
  336. (split-string str "\n")))
  337. (doc (or (nrepl-dict-get info "doc")
  338. "Not documented."))
  339. (url (nrepl-dict-get info "url"))
  340. (class (nrepl-dict-get info "class"))
  341. (member (nrepl-dict-get info "member"))
  342. (javadoc (nrepl-dict-get info "javadoc"))
  343. (super (nrepl-dict-get info "super"))
  344. (ifaces (nrepl-dict-get info "interfaces"))
  345. (spec (nrepl-dict-get info "spec"))
  346. (clj-name (if ns (concat ns "/" name) name))
  347. (java-name (if member (concat class "/" member) class))
  348. (see-also (nrepl-dict-get info "see-also")))
  349. (cider--help-setup-xref (list #'cider-doc-lookup (format "%s/%s" ns name)) nil buffer)
  350. (with-current-buffer buffer
  351. (cl-flet ((emit (text &optional face)
  352. (insert (if face
  353. (propertize text 'font-lock-face face)
  354. text)
  355. "\n")))
  356. (emit (if class java-name clj-name) 'font-lock-function-name-face)
  357. (when super
  358. (emit (concat " Extends: " (cider-font-lock-as 'java-mode super))))
  359. (when ifaces
  360. (emit (concat "Implements: " (cider-font-lock-as 'java-mode (car ifaces))))
  361. (dolist (iface (cdr ifaces))
  362. (emit (concat " "(cider-font-lock-as 'java-mode iface)))))
  363. (when (or super ifaces)
  364. (insert "\n"))
  365. (when-let* ((forms (or forms args)))
  366. (dolist (form forms)
  367. (insert " ")
  368. (emit (cider-font-lock-as-clojure form))))
  369. (when special
  370. (emit "Special Form" 'font-lock-keyword-face))
  371. (when macro
  372. (emit "Macro" 'font-lock-variable-name-face))
  373. (when added
  374. (emit (concat "Added in " added) 'font-lock-comment-face))
  375. (when depr
  376. (emit (concat "Deprecated in " depr) 'font-lock-keyword-face))
  377. (if class
  378. (cider-docview-render-java-doc (current-buffer) doc)
  379. (emit (concat " " doc)))
  380. (when url
  381. (insert "\n Please see ")
  382. (insert-text-button url
  383. 'url url
  384. 'follow-link t
  385. 'action (lambda (x)
  386. (browse-url (button-get x 'url))))
  387. (insert "\n"))
  388. (when javadoc
  389. (insert "\n\nFor additional documentation, see the ")
  390. (insert-text-button "Javadoc"
  391. 'url javadoc
  392. 'follow-link t
  393. 'action (lambda (x)
  394. (browse-url (button-get x 'url))))
  395. (insert ".\n"))
  396. (insert "\n")
  397. (when spec
  398. (emit "Spec:" 'font-lock-function-name-face)
  399. (insert (cider-browse-spec--pprint-indented spec))
  400. (insert "\n\n")
  401. (insert-text-button "Browse spec"
  402. 'follow-link t
  403. 'action (lambda (_)
  404. (cider-browse-spec (format "%s/%s" ns name))))
  405. (insert "\n\n"))
  406. (if cider-docview-file
  407. (progn
  408. (insert (propertize (if class java-name clj-name)
  409. 'font-lock-face 'font-lock-function-name-face)
  410. " is defined in ")
  411. (insert-text-button (cider--abbreviate-file-protocol cider-docview-file)
  412. 'follow-link t
  413. 'action (lambda (_x)
  414. (cider-docview-source)))
  415. (insert "."))
  416. (insert "Definition location unavailable."))
  417. (when see-also
  418. (insert "\n\n Also see: ")
  419. (mapc (lambda (ns-sym)
  420. (let* ((ns-sym-split (split-string ns-sym "/"))
  421. (see-also-ns (car ns-sym-split))
  422. (see-also-sym (cadr ns-sym-split))
  423. ;; if the var belongs to the same namespace,
  424. ;; we omit the namespace to save some screen space
  425. (symbol (if (equal ns see-also-ns) see-also-sym ns-sym)))
  426. (insert-text-button symbol
  427. 'type 'help-xref
  428. 'help-function (apply-partially #'cider-doc-lookup symbol)))
  429. (insert " "))
  430. see-also))
  431. (cider--doc-make-xrefs)
  432. (let ((beg (point-min))
  433. (end (point-max)))
  434. (nrepl-dict-map (lambda (k v)
  435. (put-text-property beg end k v))
  436. info)))
  437. (current-buffer))))
  438. (declare-function cider-set-buffer-ns "cider-mode")
  439. (defun cider-docview-render (buffer symbol info)
  440. "Emit into BUFFER formatted documentation for SYMBOL's INFO."
  441. (with-current-buffer buffer
  442. (let ((javadoc (nrepl-dict-get info "javadoc"))
  443. (file (nrepl-dict-get info "file"))
  444. (line (nrepl-dict-get info "line"))
  445. (ns (nrepl-dict-get info "ns"))
  446. (inhibit-read-only t))
  447. (cider-docview-mode)
  448. (cider-set-buffer-ns ns)
  449. (setq-local cider-docview-symbol symbol)
  450. (setq-local cider-docview-javadoc-url javadoc)
  451. (setq-local cider-docview-file file)
  452. (setq-local cider-docview-line line)
  453. (remove-overlays)
  454. (cider-docview-render-info buffer info)
  455. (goto-char (point-min))
  456. (current-buffer))))
  457. (provide 'cider-doc)
  458. ;;; cider-doc.el ends here