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