diff options
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/cider-20180719.542/cider-browse-ns.el')
| -rw-r--r-- | configs/shared/emacs/.emacs.d/elpa/cider-20180719.542/cider-browse-ns.el | 232 |
1 files changed, 232 insertions, 0 deletions
diff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180719.542/cider-browse-ns.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180719.542/cider-browse-ns.el new file mode 100644 index 0000000000..6f7353532b --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180719.542/cider-browse-ns.el @@ -0,0 +1,232 @@ +;;; cider-browse-ns.el --- CIDER namespace browser + +;; Copyright © 2014-2018 John Andrews, Bozhidar Batsov and CIDER contributors + +;; Author: John Andrews <john.m.andrews@gmail.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: + +;; M-x cider-browse-ns +;; +;; Display a list of all vars in a namespace. +;; Pressing <enter> will take you to the cider-doc buffer for that var. +;; Pressing ^ will take you to a list of all namespaces (akin to `dired-mode'). + +;; M-x cider-browse-ns-all +;; +;; Explore Clojure namespaces by browsing a list of all namespaces. +;; Pressing <enter> expands into a list of that namespace's vars as if by +;; executing the command (cider-browse-ns "my.ns"). + +;;; Code: + +(require 'cider-client) +(require 'cider-popup) +(require 'cider-compat) +(require 'cider-util) +(require 'nrepl-dict) + +(require 'subr-x) +(require 'easymenu) +(require 'thingatpt) + +(defconst cider-browse-ns-buffer "*cider-ns-browser*") + +(defvar-local cider-browse-ns-current-ns nil) + +;; Mode Definition + +(defvar cider-browse-ns-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map cider-popup-buffer-mode-map) + (define-key map "d" #'cider-browse-ns-doc-at-point) + (define-key map "s" #'cider-browse-ns-find-at-point) + (define-key map (kbd "RET") #'cider-browse-ns-operate-at-point) + (define-key map "^" #'cider-browse-ns-all) + (define-key map "n" #'next-line) + (define-key map "p" #'previous-line) + (easy-menu-define cider-browse-ns-mode-menu map + "Menu for CIDER's namespace browser" + '("Namespace Browser" + ["Show doc" cider-browse-ns-doc-at-point] + ["Go to definition" cider-browse-ns-find-at-point] + "--" + ["Browse all namespaces" cider-browse-ns-all])) + map)) + +(defvar cider-browse-ns-mouse-map + (let ((map (make-sparse-keymap))) + (define-key map [mouse-1] #'cider-browse-ns-handle-mouse) + map)) + +(define-derived-mode cider-browse-ns-mode special-mode "browse-ns" + "Major mode for browsing Clojure namespaces. + +\\{cider-browse-ns-mode-map}" + (setq-local electric-indent-chars nil) + (setq-local sesman-system 'CIDER) + (when cider-special-mode-truncate-lines + (setq-local truncate-lines t)) + (setq-local cider-browse-ns-current-ns nil)) + +(defun cider-browse-ns--text-face (var-meta) + "Return font-lock-face for a var. +VAR-META contains the metadata information used to decide a face. +Presence of \"arglists-str\" and \"macro\" indicates a macro form. +Only \"arglists-str\" indicates a function. Otherwise, its a variable. +If the NAMESPACE is not loaded in the REPL, assume TEXT is a fn." + (cond + ((not var-meta) 'font-lock-function-name-face) + ((and (nrepl-dict-contains var-meta "arglists") + (string= (nrepl-dict-get var-meta "macro") "true")) + 'font-lock-keyword-face) + ((nrepl-dict-contains var-meta "arglists") 'font-lock-function-name-face) + (t 'font-lock-variable-name-face))) + +(defun cider-browse-ns--properties (var var-meta) + "Decorate VAR with a clickable keymap and a face. +VAR-META is used to decide a font-lock face." + (let ((face (cider-browse-ns--text-face var-meta))) + (propertize var + 'font-lock-face face + 'mouse-face 'highlight + 'keymap cider-browse-ns-mouse-map))) + +(defun cider-browse-ns--list (buffer title items &optional ns noerase) + "Reset contents of BUFFER. +Display TITLE at the top and ITEMS are indented underneath. +If NS is non-nil, it is added to each item as the +`cider-browse-ns-current-ns' text property. If NOERASE is non-nil, the +contents of the buffer are not reset before inserting TITLE and ITEMS." + (with-current-buffer buffer + (cider-browse-ns-mode) + (let ((inhibit-read-only t)) + (unless noerase (erase-buffer)) + (goto-char (point-max)) + (insert (cider-propertize title 'ns) "\n") + (dolist (item items) + (insert (propertize (concat " " item "\n") + 'cider-browse-ns-current-ns ns))) + (goto-char (point-min))))) + +(defun cider-browse-ns--first-doc-line (doc) + "Return the first line of the given DOC string. +If the first line of the DOC string contains multiple sentences, only +the first sentence is returned. If the DOC string is nil, a Not documented +string is returned." + (if doc + (let* ((split-newline (split-string doc "\n")) + (first-line (car split-newline))) + (cond + ((string-match "\\. " first-line) (substring first-line 0 (match-end 0))) + ((= 1 (length split-newline)) first-line) + (t (concat first-line "...")))) + "Not documented.")) + +(defun cider-browse-ns--items (namespace) + "Return the items to show in the namespace browser of the given NAMESPACE. +Each item consists of a ns-var and the first line of its docstring." + (let* ((ns-vars-with-meta (cider-sync-request:ns-vars-with-meta namespace)) + (propertized-ns-vars (nrepl-dict-map #'cider-browse-ns--properties ns-vars-with-meta))) + (mapcar (lambda (ns-var) + (let* ((doc (nrepl-dict-get-in ns-vars-with-meta (list ns-var "doc"))) + ;; to avoid (read nil) + ;; it prompts the user for a Lisp expression + (doc (when doc (read doc))) + (first-doc-line (cider-browse-ns--first-doc-line doc))) + (concat ns-var " " (propertize first-doc-line 'font-lock-face 'font-lock-doc-face)))) + propertized-ns-vars))) + +;; Interactive Functions + +;;;###autoload +(defun cider-browse-ns (namespace) + "List all NAMESPACE's vars in BUFFER." + (interactive (list (completing-read "Browse namespace: " (cider-sync-request:ns-list)))) + (with-current-buffer (cider-popup-buffer cider-browse-ns-buffer 'select nil 'ancillary) + (cider-browse-ns--list (current-buffer) + namespace + (cider-browse-ns--items namespace)) + (setq-local cider-browse-ns-current-ns namespace))) + +;;;###autoload +(defun cider-browse-ns-all () + "List all loaded namespaces in BUFFER." + (interactive) + (with-current-buffer (cider-popup-buffer cider-browse-ns-buffer 'select nil 'ancillary) + (let ((names (cider-sync-request:ns-list))) + (cider-browse-ns--list (current-buffer) + "All loaded namespaces" + (mapcar (lambda (name) + (cider-browse-ns--properties name nil)) + names)) + (setq-local cider-browse-ns-current-ns nil)))) + +(defun cider-browse-ns--thing-at-point () + "Get the thing at point. +Return a list of the type ('ns or 'var) and the value." + (let ((line (car (split-string (string-trim (thing-at-point 'line)) " ")))) + (if (string-match "\\." line) + `(ns ,line) + `(var ,(format "%s/%s" + (or (get-text-property (point) 'cider-browse-ns-current-ns) + cider-browse-ns-current-ns) + line))))) + +(defun cider-browse-ns-doc-at-point () + "Show the documentation for the thing at current point." + (interactive) + (let* ((thing (cider-browse-ns--thing-at-point)) + (value (cadr thing))) + ;; value is either some ns or a var + (cider-doc-lookup value))) + +(defun cider-browse-ns-operate-at-point () + "Expand browser according to thing at current point. +If the thing at point is a ns it will be browsed, +and if the thing at point is some var - its documentation will +be displayed." + (interactive) + (let* ((thing (cider-browse-ns--thing-at-point)) + (type (car thing)) + (value (cadr thing))) + (if (eq type 'ns) + (cider-browse-ns value) + (cider-doc-lookup value)))) + +(declare-function cider-find-ns "cider-find") +(declare-function cider-find-var "cider-find") + +(defun cider-browse-ns-find-at-point () + "Find the definition of the thing at point." + (interactive) + (let* ((thing (cider-browse-ns--thing-at-point)) + (type (car thing)) + (value (cadr thing))) + (if (eq type 'ns) + (cider-find-ns nil value) + (cider-find-var current-prefix-arg value)))) + +(defun cider-browse-ns-handle-mouse (event) + "Handle mouse click EVENT." + (interactive "e") + (cider-browse-ns-operate-at-point)) + +(provide 'cider-browse-ns) + +;;; cider-browse-ns.el ends here |