diff options
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/cider-20180719.542/cider-doc.el')
| -rw-r--r-- | configs/shared/emacs/.emacs.d/elpa/cider-20180719.542/cider-doc.el | 533 |
1 files changed, 533 insertions, 0 deletions
diff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180719.542/cider-doc.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180719.542/cider-doc.el new file mode 100644 index 0000000000..5cca050563 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180719.542/cider-doc.el @@ -0,0 +1,533 @@ +;;; cider-doc.el --- CIDER documentation functionality -*- lexical-binding: t -*- + +;; Copyright © 2014-2018 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 'subr-x) +(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) +(require 'cider-browse-spec) + + +;;; Variables + +(defgroup cider-doc nil + "Documentation for CIDER." + :prefix "cider-doc-" + :group 'cider) + +(defcustom cider-doc-auto-select-buffer t + "Controls whether to auto-select the doc popup buffer." + :type 'boolean + :group 'cider-doc + :package-version '(cider . "0.15.0")) + +(declare-function cider-apropos "cider-apropos") +(declare-function cider-apropos-select "cider-apropos") +(declare-function cider-apropos-documentation "cider-apropos") +(declare-function cider-apropos-documentation-select "cider-apropos") + +(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))) + + +(defadvice disable-theme (after cider-docview-adapt-to-theme activate) + "When theme is disabled, 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 sesman-system 'CIDER) + (when cider-special-mode-truncate-lines + (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)) + +(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*") + +(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 nil 'ancillary) 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 cider-doc-auto-select-buffer) + (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' of FILE-WITH-PROTOCOL." + (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 (when-let* ((str (nrepl-dict-get info "forms-str"))) + (split-string str "\n"))) + (args (when-let* ((str (nrepl-dict-get info "arglists-str"))) + (split-string str "\n"))) + (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-let* ((forms (or forms args))) + (dolist (form forms) + (insert " ") + (emit (cider-font-lock-as-clojure form)))) + (when special + (emit "Special Form" 'font-lock-keyword-face)) + (when macro + (emit "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) + (insert (cider-browse-spec--pprint-indented spec)) + (insert "\n\n") + (insert-text-button "Browse spec" + 'follow-link t + 'action (lambda (_) + (cider-browse-spec (format "%s/%s" ns name)))) + (insert "\n\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-text-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 |