523 lines
20 KiB
EmacsLisp
523 lines
20 KiB
EmacsLisp
;;; cider-doc.el --- CIDER documentation functionality -*- lexical-binding: t -*-
|
||
|
||
;; Copyright © 2014-2016 Bozhidar Batsov, Jeff Valk and CIDER contributors
|
||
|
||
;; Author: Jeff Valk <jv@jeffvalk.com>
|
||
|
||
;; This program is free software: you can redistribute it and/or modify
|
||
;; it under the terms of the GNU General Public License as published by
|
||
;; the Free Software Foundation, either version 3 of the License, or
|
||
;; (at your option) any later version.
|
||
|
||
;; This program is distributed in the hope that it will be useful,
|
||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;; GNU General Public License for more details.
|
||
|
||
;; You should have received a copy of the GNU General Public License
|
||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||
|
||
;; This file is not part of GNU Emacs.
|
||
|
||
;;; Commentary:
|
||
|
||
;; Mode for formatting and presenting documentation
|
||
|
||
;;; Code:
|
||
|
||
(require 'cider-common)
|
||
(require 'cider-compat)
|
||
(require 'cider-util)
|
||
(require 'cider-popup)
|
||
(require 'cider-client)
|
||
(require 'cider-grimoire)
|
||
(require 'nrepl-dict)
|
||
(require 'org-table)
|
||
(require 'button)
|
||
(require 'easymenu)
|
||
|
||
|
||
;;; Variables
|
||
|
||
(defgroup cider-doc nil
|
||
"Documentation for CIDER."
|
||
:prefix "cider-doc-"
|
||
:group 'cider)
|
||
|
||
|
||
(defvar cider-doc-map
|
||
(let (cider-doc-map)
|
||
(define-prefix-command 'cider-doc-map)
|
||
(define-key cider-doc-map (kbd "a") #'cider-apropos)
|
||
(define-key cider-doc-map (kbd "C-a") #'cider-apropos)
|
||
(define-key cider-doc-map (kbd "s") #'cider-apropos-select)
|
||
(define-key cider-doc-map (kbd "C-s") #'cider-apropos-select)
|
||
(define-key cider-doc-map (kbd "f") #'cider-apropos-documentation)
|
||
(define-key cider-doc-map (kbd "C-f") #'cider-apropos-documentation)
|
||
(define-key cider-doc-map (kbd "e") #'cider-apropos-documentation-select)
|
||
(define-key cider-doc-map (kbd "C-e") #'cider-apropos-documentation-select)
|
||
(define-key cider-doc-map (kbd "d") #'cider-doc)
|
||
(define-key cider-doc-map (kbd "C-d") #'cider-doc)
|
||
(define-key cider-doc-map (kbd "r") #'cider-grimoire)
|
||
(define-key cider-doc-map (kbd "C-r") #'cider-grimoire)
|
||
(define-key cider-doc-map (kbd "w") #'cider-grimoire-web)
|
||
(define-key cider-doc-map (kbd "C-w") #'cider-grimoire-web)
|
||
(define-key cider-doc-map (kbd "j") #'cider-javadoc)
|
||
(define-key cider-doc-map (kbd "C-j") #'cider-javadoc)
|
||
cider-doc-map)
|
||
"CIDER documentation keymap.")
|
||
|
||
(defconst cider-doc-menu
|
||
'("Documentation"
|
||
["CiderDoc" cider-doc]
|
||
["JavaDoc in browser" cider-javadoc]
|
||
["Grimoire" cider-grimoire]
|
||
["Grimoire in browser" cider-grimoire-web]
|
||
["Search symbols" cider-apropos]
|
||
["Search symbols & select" cider-apropos-select]
|
||
["Search documentation" cider-apropos-documentation]
|
||
["Search documentation & select" cider-apropos-documentation-select]
|
||
"--"
|
||
["Configure Doc buffer" (customize-group 'cider-docview-mode)])
|
||
"CIDER documentation submenu.")
|
||
|
||
|
||
;;; cider-docview-mode
|
||
|
||
(defgroup cider-docview-mode nil
|
||
"Formatting/fontifying documentation viewer."
|
||
:prefix "cider-docview-"
|
||
:group 'cider)
|
||
|
||
(defcustom cider-docview-fill-column fill-column
|
||
"Fill column for docstrings in doc buffer."
|
||
:type 'list
|
||
:group 'cider-docview-mode
|
||
:package-version '(cider . "0.7.0"))
|
||
|
||
|
||
|
||
;; Faces
|
||
|
||
(defface cider-docview-emphasis-face
|
||
'((t (:inherit default :underline t)))
|
||
"Face for emphasized text"
|
||
:group 'cider-docview-mode
|
||
:package-version '(cider . "0.7.0"))
|
||
|
||
(defface cider-docview-strong-face
|
||
'((t (:inherit default :underline t :weight bold)))
|
||
"Face for strongly emphasized text"
|
||
:group 'cider-docview-mode
|
||
:package-version '(cider . "0.7.0"))
|
||
|
||
(defface cider-docview-literal-face
|
||
'((t (:inherit font-lock-string-face)))
|
||
"Face for literal text"
|
||
:group 'cider-docview-mode
|
||
:package-version '(cider . "0.7.0"))
|
||
|
||
(defface cider-docview-table-border-face
|
||
'((t (:inherit shadow)))
|
||
"Face for table borders"
|
||
:group 'cider-docview-mode
|
||
:package-version '(cider . "0.7.0"))
|
||
|
||
|
||
;; Colors & Theme Support
|
||
|
||
(defvar cider-docview-code-background-color
|
||
(cider-scale-background-color)
|
||
"Background color for code blocks.")
|
||
|
||
(defadvice enable-theme (after cider-docview-adapt-to-theme activate)
|
||
"When theme is changed, update `cider-docview-code-background-color'."
|
||
(setq cider-docview-code-background-color (cider-scale-background-color)))
|
||
|
||
|
||
;; Mode & key bindings
|
||
|
||
(defvar cider-docview-mode-map
|
||
(let ((map (make-sparse-keymap)))
|
||
(define-key map "q" #'cider-popup-buffer-quit-function)
|
||
(define-key map "g" #'cider-docview-grimoire)
|
||
(define-key map "G" #'cider-docview-grimoire-web)
|
||
(define-key map "j" #'cider-docview-javadoc)
|
||
(define-key map "s" #'cider-docview-source)
|
||
(define-key map (kbd "<backtab>") #'backward-button)
|
||
(define-key map (kbd "TAB") #'forward-button)
|
||
(easy-menu-define cider-docview-mode-menu map
|
||
"Menu for CIDER's doc mode"
|
||
`("CiderDoc"
|
||
["Look up in Grimoire" cider-docview-grimoire]
|
||
["Look up in Grimoire (browser)" cider-docview-grimoire-web]
|
||
["JavaDoc in browser" cider-docview-javadoc]
|
||
["Jump to source" cider-docview-source]
|
||
"--"
|
||
["Quit" cider-popup-buffer-quit-function]
|
||
))
|
||
map))
|
||
|
||
(defvar cider-docview-symbol)
|
||
(defvar cider-docview-javadoc-url)
|
||
(defvar cider-docview-file)
|
||
(defvar cider-docview-line)
|
||
|
||
(define-derived-mode cider-docview-mode help-mode "Doc"
|
||
"Major mode for displaying CIDER documentation
|
||
|
||
\\{cider-docview-mode-map}"
|
||
(setq buffer-read-only t)
|
||
(setq-local truncate-lines t)
|
||
(setq-local electric-indent-chars nil)
|
||
(setq-local cider-docview-symbol nil)
|
||
(setq-local cider-docview-javadoc-url nil)
|
||
(setq-local cider-docview-file nil)
|
||
(setq-local cider-docview-line nil))
|
||
|
||
|
||
;;; Interactive functions
|
||
|
||
(defun cider-docview-javadoc ()
|
||
"Open the Javadoc for the current class, if available."
|
||
(interactive)
|
||
(if cider-docview-javadoc-url
|
||
(browse-url cider-docview-javadoc-url)
|
||
(error "No Javadoc available for %s" cider-docview-symbol)))
|
||
|
||
(defun cider-javadoc-handler (symbol-name)
|
||
"Invoke the nREPL \"info\" op on SYMBOL-NAME if available."
|
||
(when symbol-name
|
||
(let* ((info (cider-var-info symbol-name))
|
||
(url (nrepl-dict-get info "javadoc")))
|
||
(if url
|
||
(browse-url url)
|
||
(user-error "No Javadoc available for %s" symbol-name)))))
|
||
|
||
(defun cider-javadoc (arg)
|
||
"Open Javadoc documentation in a popup buffer.
|
||
|
||
Prompts for the symbol to use, or uses the symbol at point, depending on
|
||
the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the
|
||
opposite of what that option dictates."
|
||
(interactive "P")
|
||
(cider-ensure-connected)
|
||
(cider-ensure-op-supported "info")
|
||
(funcall (cider-prompt-for-symbol-function arg)
|
||
"Javadoc for"
|
||
#'cider-javadoc-handler))
|
||
|
||
(declare-function cider-find-file "cider-common")
|
||
(declare-function cider-jump-to "cider-interaction")
|
||
|
||
(defun cider-docview-source ()
|
||
"Open the source for the current symbol, if available."
|
||
(interactive)
|
||
(if cider-docview-file
|
||
(if-let ((buffer (and (not (cider--tooling-file-p cider-docview-file))
|
||
(cider-find-file cider-docview-file))))
|
||
(cider-jump-to buffer (if cider-docview-line
|
||
(cons cider-docview-line nil)
|
||
cider-docview-symbol)
|
||
nil)
|
||
(user-error
|
||
(substitute-command-keys
|
||
"Can't find the source because it wasn't defined with `cider-eval-buffer'")))
|
||
(error "No source location for %s" cider-docview-symbol)))
|
||
|
||
(defvar cider-buffer-ns)
|
||
|
||
(declare-function cider-grimoire-lookup "cider-grimoire")
|
||
|
||
(defun cider-docview-grimoire ()
|
||
"Return the grimoire documentation for `cider-docview-symbol'."
|
||
(interactive)
|
||
(if cider-buffer-ns
|
||
(cider-grimoire-lookup cider-docview-symbol)
|
||
(error "%s cannot be looked up on Grimoire" cider-docview-symbol)))
|
||
|
||
(declare-function cider-grimoire-web-lookup "cider-grimoire")
|
||
|
||
(defun cider-docview-grimoire-web ()
|
||
"Open the grimoire documentation for `cider-docview-symbol' in a web browser."
|
||
(interactive)
|
||
(if cider-buffer-ns
|
||
(cider-grimoire-web-lookup cider-docview-symbol)
|
||
(error "%s cannot be looked up on Grimoire" cider-docview-symbol)))
|
||
|
||
(defconst cider-doc-buffer "*cider-doc*")
|
||
(add-to-list 'cider-ancillary-buffers cider-doc-buffer)
|
||
|
||
(defun cider-create-doc-buffer (symbol)
|
||
"Populates *cider-doc* with the documentation for SYMBOL."
|
||
(when-let ((info (cider-var-info symbol)))
|
||
(cider-docview-render (cider-make-popup-buffer cider-doc-buffer) symbol info)))
|
||
|
||
(defun cider-doc-lookup (symbol)
|
||
"Look up documentation for SYMBOL."
|
||
(if-let ((buffer (cider-create-doc-buffer symbol)))
|
||
(cider-popup-buffer-display buffer t)
|
||
(user-error "Symbol %s not resolved" symbol)))
|
||
|
||
(defun cider-doc (&optional arg)
|
||
"Open Clojure documentation in a popup buffer.
|
||
|
||
Prompts for the symbol to use, or uses the symbol at point, depending on
|
||
the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the
|
||
opposite of what that option dictates."
|
||
(interactive "P")
|
||
(cider-ensure-connected)
|
||
(funcall (cider-prompt-for-symbol-function arg)
|
||
"Doc for"
|
||
#'cider-doc-lookup))
|
||
|
||
|
||
;;; Font Lock and Formatting
|
||
|
||
(defun cider-docview-fontify-code-blocks (buffer mode)
|
||
"Font lock BUFFER code blocks using MODE and remove markdown characters.
|
||
This processes the triple backtick GFM markdown extension. An overlay is used
|
||
to shade the background. Blocks are marked to be ignored by other fonification
|
||
and line wrap."
|
||
(with-current-buffer buffer
|
||
(save-excursion
|
||
(while (search-forward-regexp "```\n" nil t)
|
||
(replace-match "")
|
||
(let ((beg (point))
|
||
(bg `(:background ,cider-docview-code-background-color)))
|
||
(when (search-forward-regexp "```\n" nil t)
|
||
(replace-match "")
|
||
(cider-font-lock-region-as mode beg (point))
|
||
(overlay-put (make-overlay beg (point)) 'font-lock-face bg)
|
||
(put-text-property beg (point) 'block 'code)))))))
|
||
|
||
(defun cider-docview-fontify-literals (buffer)
|
||
"Font lock BUFFER literal text and remove backtick markdown characters.
|
||
Preformatted code text blocks are ignored."
|
||
(with-current-buffer buffer
|
||
(save-excursion
|
||
(while (search-forward "`" nil t)
|
||
(if (eq (get-text-property (point) 'block) 'code)
|
||
(forward-char)
|
||
(progn
|
||
(replace-match "")
|
||
(let ((beg (point)))
|
||
(when (search-forward "`" (line-end-position) t)
|
||
(replace-match "")
|
||
(put-text-property beg (point) 'font-lock-face 'cider-docview-literal-face)))))))))
|
||
|
||
(defun cider-docview-fontify-emphasis (buffer)
|
||
"Font lock BUFFER emphasized text and remove markdown characters.
|
||
One '*' represents emphasis, multiple '**'s represent strong emphasis.
|
||
Preformatted code text blocks are ignored."
|
||
(with-current-buffer buffer
|
||
(save-excursion
|
||
(while (search-forward-regexp "\\(*+\\)\\(\\w\\)" nil t)
|
||
(if (eq (get-text-property (point) 'block) 'code)
|
||
(forward-char)
|
||
(progn
|
||
(replace-match "\\2")
|
||
(let ((beg (1- (point)))
|
||
(face (if (> (length (match-string 1)) 1)
|
||
'cider-docview-strong-face
|
||
'cider-docview-emphasis-face)))
|
||
(when (search-forward-regexp "\\(\\w\\)\\*+" (line-end-position) t)
|
||
(replace-match "\\1")
|
||
(put-text-property beg (point) 'font-lock-face face)))))))))
|
||
|
||
(defun cider-docview-format-tables (buffer)
|
||
"Align BUFFER tables and dim borders.
|
||
This processes the GFM table markdown extension using `org-table'.
|
||
Tables are marked to be ignored by line wrap."
|
||
(with-current-buffer buffer
|
||
(save-excursion
|
||
(let ((border 'cider-docview-table-border-face))
|
||
(org-table-map-tables
|
||
(lambda ()
|
||
(org-table-align)
|
||
(goto-char (org-table-begin))
|
||
(while (search-forward-regexp "[+|-]" (org-table-end) t)
|
||
(put-text-property (match-beginning 0) (match-end 0) 'font-lock-face border))
|
||
(put-text-property (org-table-begin) (org-table-end) 'block 'table)))))))
|
||
|
||
(defun cider-docview-wrap-text (buffer)
|
||
"For text in BUFFER not propertized as 'block', apply line wrap."
|
||
(with-current-buffer buffer
|
||
(save-excursion
|
||
(while (not (eobp))
|
||
(unless (get-text-property (point) 'block)
|
||
(fill-region (point) (line-end-position)))
|
||
(forward-line)))))
|
||
|
||
|
||
;;; Rendering
|
||
|
||
(defun cider-docview-render-java-doc (buffer text)
|
||
"Emit into BUFFER formatted doc TEXT for a Java class or member."
|
||
(with-current-buffer buffer
|
||
(let ((beg (point)))
|
||
(insert text)
|
||
(save-excursion
|
||
(goto-char beg)
|
||
(cider-docview-fontify-code-blocks buffer 'java-mode) ; left alone hereafter
|
||
(cider-docview-fontify-literals buffer)
|
||
(cider-docview-fontify-emphasis buffer)
|
||
(cider-docview-format-tables buffer) ; may contain literals, emphasis
|
||
(cider-docview-wrap-text buffer))))) ; ignores code, table blocks
|
||
|
||
(defun cider--abbreviate-file-protocol (file-with-protocol)
|
||
"Abbreviate the file-path in `file:/path/to/file'."
|
||
(if (string-match "\\`file:\\(.*\\)" file-with-protocol)
|
||
(let ((file (match-string 1 file-with-protocol))
|
||
(proj-dir (clojure-project-dir)))
|
||
(if (and proj-dir
|
||
(file-in-directory-p file proj-dir))
|
||
(file-relative-name file proj-dir)
|
||
file))
|
||
file-with-protocol))
|
||
|
||
(defun cider-docview-render-info (buffer info)
|
||
"Emit into BUFFER formatted INFO for the Clojure or Java symbol."
|
||
(let* ((ns (nrepl-dict-get info "ns"))
|
||
(name (nrepl-dict-get info "name"))
|
||
(added (nrepl-dict-get info "added"))
|
||
(depr (nrepl-dict-get info "deprecated"))
|
||
(macro (nrepl-dict-get info "macro"))
|
||
(special (nrepl-dict-get info "special-form"))
|
||
(forms (nrepl-dict-get info "forms-str"))
|
||
(args (nrepl-dict-get info "arglists-str"))
|
||
(doc (or (nrepl-dict-get info "doc")
|
||
"Not documented."))
|
||
(url (nrepl-dict-get info "url"))
|
||
(class (nrepl-dict-get info "class"))
|
||
(member (nrepl-dict-get info "member"))
|
||
(javadoc (nrepl-dict-get info "javadoc"))
|
||
(super (nrepl-dict-get info "super"))
|
||
(ifaces (nrepl-dict-get info "interfaces"))
|
||
(spec (nrepl-dict-get info "spec"))
|
||
(clj-name (if ns (concat ns "/" name) name))
|
||
(java-name (if member (concat class "/" member) class))
|
||
(see-also (nrepl-dict-get info "see-also")))
|
||
(cider--help-setup-xref (list #'cider-doc-lookup (format "%s/%s" ns name)) nil buffer)
|
||
(with-current-buffer buffer
|
||
(cl-flet ((emit (text &optional face)
|
||
(insert (if face
|
||
(propertize text 'font-lock-face face)
|
||
text)
|
||
"\n")))
|
||
(emit (if class java-name clj-name) 'font-lock-function-name-face)
|
||
(when super
|
||
(emit (concat " Extends: " (cider-font-lock-as 'java-mode super))))
|
||
(when ifaces
|
||
(emit (concat "Implements: " (cider-font-lock-as 'java-mode (car ifaces))))
|
||
(dolist (iface (cdr ifaces))
|
||
(emit (concat " "(cider-font-lock-as 'java-mode iface)))))
|
||
(when (or super ifaces)
|
||
(insert "\n"))
|
||
(when (or forms args)
|
||
(insert " ")
|
||
(save-excursion
|
||
(emit (cider-font-lock-as-clojure
|
||
;; All `defn's use ([...] [...]), but some special forms use
|
||
;; (...). We only remove the parentheses on the former.
|
||
(replace-regexp-in-string "\\`(\\(\\[.*\\]\\))\\'" "\\1"
|
||
(or forms args)))))
|
||
;; It normally doesn't happen, but it's technically conceivable for
|
||
;; the args string to contain unbalanced sexps, so `ignore-errors'.
|
||
(ignore-errors
|
||
(forward-sexp 1)
|
||
(while (not (looking-at "$"))
|
||
(insert "\n")
|
||
(forward-sexp 1)))
|
||
(forward-line 1))
|
||
(when (or special macro)
|
||
(emit (if special "Special Form" "Macro") 'font-lock-variable-name-face))
|
||
(when added
|
||
(emit (concat "Added in " added) 'font-lock-comment-face))
|
||
(when depr
|
||
(emit (concat "Deprecated in " depr) 'font-lock-keyword-face))
|
||
(if class
|
||
(cider-docview-render-java-doc (current-buffer) doc)
|
||
(emit (concat " " doc)))
|
||
(when url
|
||
(insert "\n Please see ")
|
||
(insert-text-button url
|
||
'url url
|
||
'follow-link t
|
||
'action (lambda (x)
|
||
(browse-url (button-get x 'url))))
|
||
(insert "\n"))
|
||
(when javadoc
|
||
(insert "\n\nFor additional documentation, see the ")
|
||
(insert-text-button "Javadoc"
|
||
'url javadoc
|
||
'follow-link t
|
||
'action (lambda (x)
|
||
(browse-url (button-get x 'url))))
|
||
(insert ".\n"))
|
||
(insert "\n")
|
||
(when spec
|
||
(emit "Spec: " 'font-lock-function-name-face)
|
||
(mapc (lambda (s) (insert s "\n")) spec)
|
||
(insert "\n"))
|
||
(if cider-docview-file
|
||
(progn
|
||
(insert (propertize (if class java-name clj-name)
|
||
'font-lock-face 'font-lock-function-name-face)
|
||
" is defined in ")
|
||
(insert-text-button (cider--abbreviate-file-protocol cider-docview-file)
|
||
'follow-link t
|
||
'action (lambda (_x)
|
||
(cider-docview-source)))
|
||
(insert "."))
|
||
(insert "Definition location unavailable."))
|
||
(when see-also
|
||
(insert "\n\n Also see: ")
|
||
(mapc (lambda (ns-sym)
|
||
(let* ((ns-sym-split (split-string ns-sym "/"))
|
||
(see-also-ns (car ns-sym-split))
|
||
(see-also-sym (cadr ns-sym-split))
|
||
;; if the var belongs to the same namespace,
|
||
;; we omit the namespace to save some screen space
|
||
(symbol (if (equal ns see-also-ns) see-also-sym ns-sym)))
|
||
(insert-button symbol
|
||
'type 'help-xref
|
||
'help-function (apply-partially #'cider-doc-lookup symbol)))
|
||
(insert " "))
|
||
see-also))
|
||
(cider--doc-make-xrefs)
|
||
(let ((beg (point-min))
|
||
(end (point-max)))
|
||
(nrepl-dict-map (lambda (k v)
|
||
(put-text-property beg end k v))
|
||
info)))
|
||
(current-buffer))))
|
||
|
||
(declare-function cider-set-buffer-ns "cider-mode")
|
||
(defun cider-docview-render (buffer symbol info)
|
||
"Emit into BUFFER formatted documentation for SYMBOL's INFO."
|
||
(with-current-buffer buffer
|
||
(let ((javadoc (nrepl-dict-get info "javadoc"))
|
||
(file (nrepl-dict-get info "file"))
|
||
(line (nrepl-dict-get info "line"))
|
||
(ns (nrepl-dict-get info "ns"))
|
||
(inhibit-read-only t))
|
||
(cider-docview-mode)
|
||
|
||
(cider-set-buffer-ns ns)
|
||
(setq-local cider-docview-symbol symbol)
|
||
(setq-local cider-docview-javadoc-url javadoc)
|
||
(setq-local cider-docview-file file)
|
||
(setq-local cider-docview-line line)
|
||
|
||
(remove-overlays)
|
||
(cider-docview-render-info buffer info)
|
||
|
||
(goto-char (point-min))
|
||
(current-buffer))))
|
||
|
||
|
||
(provide 'cider-doc)
|
||
|
||
;;; cider-doc.el ends here
|