cider-browse-ns.el (21600B)
1 ;;; cider-browse-ns.el --- CIDER namespace browser -*- lexical-binding: t; -*- 2 3 ;; Copyright © 2014-2023 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-util) 41 (require 'nrepl-dict) 42 43 (require 'subr-x) 44 (require 'easymenu) 45 (require 'button) 46 (require 'cl-lib) 47 (require 'thingatpt) 48 49 50 (defgroup cider-browse-ns nil 51 "Display contents of namespaces for CIDER." 52 :prefix "cider-browse-ns-" 53 :group 'cider) 54 55 (defface cider-browse-ns-extra-info-face 56 '((t (:inherit shadow))) 57 "Face for displaying extra info of namespace vars." 58 :package-version '(cider . "1.4.0")) 59 60 (defcustom cider-browse-ns-default-filters nil 61 "List of default hide filters to apply to browse-ns buffer. 62 63 Available options include `private', `test', `macro', `function', and 64 `var'." 65 :type 'list 66 :package-version '(cider . "1.4.0")) 67 68 (defconst cider-browse-ns-buffer "*cider-ns-browser*") 69 70 (defvar-local cider-browse-ns-current-ns nil) 71 72 (defvar-local cider-browse-ns-filters nil) 73 (defvar-local cider-browse-ns-show-all nil) 74 (defvar-local cider-browse-ns-group-by nil) 75 (defvar-local cider-browse-ns-items nil) 76 (defvar-local cider-browse-ns-title nil) 77 (defvar-local cider-browse-ns-group-by nil) 78 79 80 ;; Mode Definition 81 82 (defvar cider-browse-ns-mode-map 83 (let ((map (make-sparse-keymap))) 84 (set-keymap-parent map cider-popup-buffer-mode-map) 85 (define-key map "d" #'cider-browse-ns-doc-at-point) 86 (define-key map "s" #'cider-browse-ns-find-at-point) 87 (define-key map (kbd "RET") #'cider-browse-ns-operate-at-point) 88 (define-key map "^" #'cider-browse-ns-all) 89 (define-key map "n" #'next-line) 90 (define-key map "p" #'previous-line) 91 92 (define-key map "a" #'cider-browse-ns-toggle-all) 93 94 (define-key map (kbd "h p") #'cider-browse-ns-toggle-hide-private) 95 (define-key map (kbd "h t") #'cider-browse-ns-toggle-hide-test) 96 (define-key map (kbd "h m") #'cider-browse-ns-toggle-hide-macro) 97 (define-key map (kbd "h f") #'cider-browse-ns-toggle-hide-function) 98 (define-key map (kbd "h v") #'cider-browse-ns-toggle-hide-var) 99 100 (define-key map (kbd "g t") #'cider-browse-ns-group-by-type) 101 (define-key map (kbd "g v") #'cider-browse-ns-group-by-visibility) 102 103 (easy-menu-define cider-browse-ns-mode-menu map 104 "Menu for CIDER's namespace browser" 105 '("Namespace Browser" 106 ["Show doc" cider-browse-ns-doc-at-point] 107 ["Go to definition" cider-browse-ns-find-at-point] 108 "--" 109 ["Browse all namespaces" cider-browse-ns-all])) 110 map)) 111 112 (defvar cider-browse-ns-mouse-map 113 (let ((map (make-sparse-keymap))) 114 (define-key map [mouse-1] #'cider-browse-ns-handle-mouse) 115 map)) 116 117 (define-derived-mode cider-browse-ns-mode special-mode "browse-ns" 118 "Major mode for browsing Clojure namespaces. 119 120 \\{cider-browse-ns-mode-map}" 121 (setq-local electric-indent-chars nil) 122 (setq-local sesman-system 'CIDER) 123 (when cider-special-mode-truncate-lines 124 (setq-local truncate-lines t)) 125 (setq-local cider-browse-ns-current-ns nil)) 126 127 (defun cider-browse-ns--text-face (var-meta) 128 "Return font-lock-face for a var. 129 VAR-META contains the metadata information used to decide a face. 130 Presence of \"arglists\" and \"macro\" indicates a macro form. 131 Only \"arglists\" indicates a function. Otherwise, its a variable. 132 If the NAMESPACE is not loaded in the REPL, assume TEXT is a fn." 133 (cond 134 ((not var-meta) 'font-lock-function-name-face) 135 ((and (nrepl-dict-contains var-meta "arglists") 136 (string= (nrepl-dict-get var-meta "macro") "true")) 137 'font-lock-keyword-face) 138 ((nrepl-dict-contains var-meta "arglists") 'font-lock-function-name-face) 139 (t 'font-lock-variable-name-face))) 140 141 (defun cider-browse-ns--properties (var var-meta) 142 "Decorate VAR with a clickable keymap and a face. 143 VAR-META is used to decide a font-lock face." 144 (let ((face (cider-browse-ns--text-face var-meta))) 145 (propertize var 146 'font-lock-face face 147 'mouse-face 'highlight 148 'keymap cider-browse-ns-mouse-map))) 149 150 (defun cider-browse-ns--ns-list (buffer title nss) 151 "List the namespaces NSS in BUFFER. 152 153 Buffer is rendered with TITLE at the top and lists ITEMS filtered according 154 to user settings." 155 (let ((dict (nrepl-dict))) 156 (dolist (ns nss) 157 (nrepl-dict-put dict ns (nrepl-dict "ns" "true"))) 158 (cider-browse-ns--list buffer title dict nil))) 159 160 (defun cider-browse-ns--list (buffer title items ns) 161 "Initialize rendering of browse-ns BUFFER. 162 163 Initialize the buffer's TITLE, namespace NS, and the nrepl-dict ITEMS to be 164 displayed." 165 (with-current-buffer buffer 166 (cider-browse-ns-mode) 167 (setq-local cider-browse-ns-items items) 168 (setq-local cider-browse-ns-title title) 169 (setq-local cider-browse-ns-filters cider-browse-ns-default-filters) 170 (setq-local cider-browse-ns-current-ns ns)) 171 (cider-browse-ns--render-buffer)) 172 173 (defun cider-browse-ns--meta-macro-p (var-meta) 174 "Return non-nil if VAR-META is the metadata of a macro." 175 (and (nrepl-dict-contains var-meta "arglists") 176 (string= (nrepl-dict-get var-meta "macro") "true"))) 177 178 (defun cider-browse-ns--meta-test-p (var-meta) 179 "Return non-nil if VAR-META is the metadata of a test." 180 (nrepl-dict-contains var-meta "test")) 181 182 (defun cider-browse-ns--meta-function-p (var-meta) 183 "Return non-nil if VAR-META is the metadata of a function." 184 (and (nrepl-dict-contains var-meta "arglists") 185 (not (cider-browse-ns--meta-macro-p var-meta)))) 186 187 (defun cider-browse-ns--meta-private-p (var-meta) 188 "Return non-nil if VAR-META indicates a private element." 189 (string= (nrepl-dict-get var-meta "private") "true")) 190 191 (defun cider-browse-ns--meta-var-p (var-meta) 192 "Return non-nil if VAR-META indicates a var." 193 (not (or (cider-browse-ns--meta-test-p var-meta) 194 (cider-browse-ns--meta-macro-p var-meta) 195 (cider-browse-ns--meta-function-p var-meta)))) 196 197 (defun cider-browse-ns--item-filter (_ var-meta) 198 "Return non-nil if item containing VAR-META should be listed in buffer." 199 (let ((function-filter-p (memq 'function cider-browse-ns-filters)) 200 (var-filter-p (memq 'var cider-browse-ns-filters)) 201 (private-filter-p (memq 'private cider-browse-ns-filters)) 202 (test-filter-p (memq 'test cider-browse-ns-filters)) 203 (macro-filter-p (memq 'macro cider-browse-ns-filters))) 204 ;; check if item should be displayed 205 (let* ((macro-p (cider-browse-ns--meta-macro-p var-meta)) 206 (function-p (cider-browse-ns--meta-function-p var-meta)) 207 (private-p (cider-browse-ns--meta-private-p var-meta)) 208 (test-p (cider-browse-ns--meta-test-p var-meta)) 209 (var-p (cider-browse-ns--meta-var-p var-meta))) 210 (or cider-browse-ns-show-all 211 (not (or (and macro-p macro-filter-p) 212 (and function-p function-filter-p) 213 (and test-p test-filter-p) 214 (and var-p var-filter-p) 215 (and private-p private-filter-p))))))) 216 217 (defun cider-browse-ns--propertized-item (key items) 218 "Return propertized line of item KEY in nrepl-dict ITEMS." 219 (let* ((var-meta (nrepl-dict-get items key)) 220 (face (cider-browse-ns--text-face (nrepl-dict-get items key))) 221 (private-p (string= (nrepl-dict-get var-meta "private") "true")) 222 (test-p (nrepl-dict-contains var-meta "test")) 223 (ns-p (nrepl-dict-contains var-meta "ns"))) 224 (concat 225 (propertize key 226 'font-lock-face face 227 'ns ns-p) 228 " " 229 (cond 230 (test-p (propertize "(test) " 'face 'cider-browse-ns-extra-info-face)) 231 (private-p (propertize "(-) " 'face 'cider-browse-ns-extra-info-face)) 232 (t ""))))) 233 234 (defun cider-browse-ns--display-list (keys items max-length &optional label) 235 "Render the items of KEYS as condained in the nrepl-dict ITEMS. 236 237 Pad the row to be MAX-LENGTH+1. If LABEL is non-nil, add a header to the 238 list of items." 239 (when keys 240 (when label 241 (insert " " label ":\n")) 242 (dolist (key keys) 243 (let* ((doc (nrepl-dict-get-in items (list key "doc"))) 244 (doc (when doc (read doc))) 245 (first-doc-line (cider-browse-ns--first-doc-line doc)) 246 (item-line (cider-browse-ns--propertized-item key items))) 247 (insert " ") 248 (insert item-line) 249 (when cider-browse-ns-current-ns 250 (insert (make-string (+ (- max-length (string-width item-line)) 1) ?·)) 251 (insert " " (propertize first-doc-line 'font-lock-face 'font-lock-doc-face))) 252 (insert "\n"))) 253 (insert "\n"))) 254 255 (defun cider-browse-ns--column-width (items) 256 "Determine the display width of displayed ITEMS." 257 (let* ((propertized-lines 258 (seq-map (lambda (key) 259 (cider-browse-ns--propertized-item key items)) 260 (nrepl-dict-keys items)))) 261 (if propertized-lines 262 (apply #'max (seq-map (lambda (entry) (string-width entry)) 263 propertized-lines)) 264 0))) 265 266 (defun cider-browse-ns--render-items (items) 267 "Render the nrepl-dict ITEMS to the browse-ns buffer." 268 (let* ((max-length (cider-browse-ns--column-width items))) 269 (cl-labels 270 ((keys-from-pred 271 (pred items) 272 (nrepl-dict-keys (nrepl-dict-filter (lambda (_ var-meta) 273 (funcall pred var-meta)) 274 items)))) 275 (cond 276 ((eql cider-browse-ns-group-by 'type) 277 (let* ((func-keys (keys-from-pred #'cider-browse-ns--meta-function-p items)) 278 (macro-keys (keys-from-pred #'cider-browse-ns--meta-macro-p items)) 279 (var-keys (keys-from-pred #'cider-browse-ns--meta-var-p items)) 280 (test-keys (keys-from-pred #'cider-browse-ns--meta-test-p items))) 281 (cider-browse-ns--display-list func-keys items max-length "Functions") 282 (cider-browse-ns--display-list macro-keys items max-length "Macros") 283 (cider-browse-ns--display-list var-keys items max-length "Vars") 284 (cider-browse-ns--display-list test-keys items max-length "Tests"))) 285 ((eql cider-browse-ns-group-by 'visibility) 286 (let* ((public-keys 287 (keys-from-pred 288 (lambda (var-meta) 289 (not (cider-browse-ns--meta-private-p var-meta))) 290 items)) 291 (private-keys (keys-from-pred #'cider-browse-ns--meta-private-p items))) 292 (cider-browse-ns--display-list public-keys items max-length "Public") 293 (cider-browse-ns--display-list private-keys items max-length "Private"))) 294 (t 295 (cider-browse-ns--display-list 296 (nrepl-dict-keys items) items max-length)))))) 297 298 (defun cider-browse-ns--filter (flag) 299 "Toggle the filter indicated by FLAG and re-render the buffer." 300 (setq cider-browse-ns-filters 301 (if (memq flag cider-browse-ns-filters) 302 (remq flag cider-browse-ns-filters) 303 (cons flag cider-browse-ns-filters))) 304 (cider-browse-ns--render-buffer)) 305 306 (defun cider-browse-ns--button-filter (button) 307 "Handle filter action for BUTTON." 308 (let ((flag (button-get button 'filter))) 309 (cider-browse-ns--filter flag))) 310 311 (defun cider-browse-ns--group (flag) 312 "Set the group-by option to FLAG and re-renderthe buffer." 313 (setq cider-browse-ns-group-by 314 (if (eql flag cider-browse-ns-group-by) nil flag)) 315 (cider-browse-ns--render-buffer)) 316 317 (defun cider-browse-ns--button-group (button) 318 "Handle grouping action for BUTTON." 319 (let ((flag (button-get button 'group-by))) 320 (cider-browse-ns--group flag))) 321 322 (defun cider-browse-ns--toggle-all (_button) 323 "Toggle the display-all visibility setting." 324 (setq cider-browse-ns-show-all (not cider-browse-ns-show-all)) 325 (cider-browse-ns--render-buffer)) 326 327 (defun cider-browse-ns--render-header (&optional filtered-items-ct) 328 "Render the section at the top of the buffer displaying visibility controls. 329 330 If FILTERED-ITEMS-CT is non-nil, then display a message of how many items 331 are being filtered." 332 ;; Display Show line 333 (insert " Show: ") 334 (insert-text-button "All" 335 'follow-link t 336 'action #'cider-browse-ns--toggle-all 337 ;; 'help-echo (cider-stacktrace-tooltip) 338 'face (if cider-browse-ns-show-all 339 'cider-stacktrace-filter-active-face 340 nil)) 341 (insert "\n") 342 ;; Display Filters 343 (let ((filters '(("Private" private) 344 ("Test" test) 345 ("Macro" macro) 346 ("Function" function) 347 ("Var" var)))) 348 (insert " Hide: ") 349 (dolist (filter filters) 350 (seq-let (title key) filter 351 (let ((is-active (memq key cider-browse-ns-filters))) 352 (insert-text-button title 353 'filter key 354 'follow-link t 355 'action #'cider-browse-ns--button-filter 356 ;; 'help-echo (cider-stacktrace-tooltip) 357 'face (if (and is-active (not cider-browse-ns-show-all)) 358 'cider-stacktrace-filter-active-face 359 nil)) 360 (insert " ")))) 361 (when filtered-items-ct 362 (insert (format "(%d items filtered)" filtered-items-ct)))) 363 (insert "\n") 364 ;; Groupings 365 (insert " Group-by: ") 366 (let ((groupings '(("Type" type) 367 ("Visibility" visibility)))) 368 (dolist (grouping groupings) 369 (seq-let (title key) grouping 370 (let ((is-active (eql key cider-browse-ns-group-by))) 371 (insert-text-button title 372 'group-by key 373 'follow-link t 374 'action #'cider-browse-ns--button-group 375 ;; 'help-echo () 376 'face (if is-active 377 'cider-stacktrace-filter-active-face 378 nil))) 379 (insert " ")))) 380 (insert "\n\n")) 381 382 (defun cider-browse-ns--render-buffer (&optional buffer) 383 "Render the sections of the browse-ns buffer. 384 385 Render occurs in BUFFER if non-nil. This function is the main entrypoint 386 for redisplaying the buffer when filters change." 387 (with-current-buffer (or buffer (current-buffer)) 388 (let* ((inhibit-read-only t) 389 (point (point)) 390 (filtered-items (nrepl-dict-filter #'cider-browse-ns--item-filter 391 cider-browse-ns-items)) 392 (filtered-item-ct (- (length (nrepl-dict-keys cider-browse-ns-items)) 393 (length (nrepl-dict-keys filtered-items))))) 394 (erase-buffer) 395 (insert (propertize (cider-propertize cider-browse-ns-title 'ns) 'ns t) "\n") 396 (when cider-browse-ns-current-ns 397 (cider-browse-ns--render-header filtered-item-ct)) 398 (cider-browse-ns--render-items filtered-items) 399 (goto-char point)))) 400 401 (defun cider-browse-ns--first-doc-line (doc) 402 "Return the first line of the given DOC string. 403 If the first line of the DOC string contains multiple sentences, only 404 the first sentence is returned. If the DOC string is nil, a Not documented 405 string is returned." 406 (if doc 407 (let* ((split-newline (split-string doc "\n")) 408 (first-line (car split-newline))) 409 (cond 410 ((string-match "\\. " first-line) (substring first-line 0 (match-end 0))) 411 ((= 1 (length split-newline)) first-line) 412 (t (concat first-line "...")))) 413 "Not documented.")) 414 415 (defun cider-browse-ns--combined-vars-with-meta (namespace) 416 "Return the combined public and private vars in NAMESPACE. 417 418 Private vars have the additional metadata \"private\": \"true\" in their 419 var-meta map." 420 (let ((items (cider-sync-request:ns-vars-with-meta namespace)) 421 (private-items (cider-sync-request:private-ns-vars-with-meta namespace))) 422 (when private-items 423 (dolist (key (nrepl-dict-keys private-items)) 424 (let ((var-meta (nrepl-dict-put (nrepl-dict-get private-items key) 425 "private" "true"))) 426 (setq items (nrepl-dict-put items key var-meta))))) 427 items)) 428 429 ;; Interactive Functions 430 431 ;;;###autoload 432 (defun cider-browse-ns (namespace) 433 "List all NAMESPACE's vars in BUFFER." 434 (interactive (list (completing-read "Browse namespace: " (cider-sync-request:ns-list)))) 435 (with-current-buffer (cider-popup-buffer cider-browse-ns-buffer 'select nil 'ancillary) 436 (cider-browse-ns--list (current-buffer) 437 namespace 438 (cider-browse-ns--combined-vars-with-meta namespace) 439 namespace))) 440 441 ;;;###autoload 442 (defun cider-browse-ns-all () 443 "List all loaded namespaces in BUFFER." 444 (interactive) 445 (with-current-buffer (cider-popup-buffer cider-browse-ns-buffer 'select nil 'ancillary) 446 (let ((names (cider-sync-request:ns-list))) 447 (cider-browse-ns--ns-list 448 (current-buffer) 449 "All loaded namespaces" 450 (mapcar (lambda (name) 451 (cider-browse-ns--properties name nil)) 452 names))))) 453 454 (defun cider-browse-ns--thing-at-point () 455 "Get the thing at point. 456 Return a list of the type ('ns or 'var) and the value." 457 (let ((ns-p (get-text-property (point) 'ns)) 458 (line (car (split-string (string-trim (thing-at-point 'line)) " ")))) 459 (if (or ns-p (string-match "\\." line)) 460 `(ns ,line) 461 `(var ,(format "%s/%s" 462 (or (get-text-property (point) 'cider-browse-ns-current-ns) 463 cider-browse-ns-current-ns) 464 line))))) 465 466 (defun cider-browse-ns-toggle-all () 467 "Toggle showing all of the items in the browse-ns buffer." 468 (interactive) 469 (cider-browse-ns--toggle-all nil)) 470 471 (defun cider-browse-ns-toggle-hide-private () 472 "Toggle visibility of private items displayed in browse-ns buffer." 473 (interactive) 474 (cider-browse-ns--filter 'private)) 475 476 (defun cider-browse-ns-toggle-hide-test () 477 "Toggle visibility of test items displayed in browse-ns buffer." 478 (interactive) 479 (cider-browse-ns--filter 'test)) 480 481 (defun cider-browse-ns-toggle-hide-macro () 482 "Toggle visibility of macro items displayed in browse-ns buffer." 483 (interactive) 484 (cider-browse-ns--filter 'macro)) 485 486 (defun cider-browse-ns-toggle-hide-function () 487 "Toggle visibility of function items displayed in browse-ns buffer." 488 (interactive) 489 (cider-browse-ns--filter 'function)) 490 491 (defun cider-browse-ns-toggle-hide-var () 492 "Toggle visibility of var items displayed in browse-ns buffer." 493 (interactive) 494 (cider-browse-ns--filter 'var)) 495 496 (defun cider-browse-ns-group-by-type () 497 "Toggle visibility of var items displayed in browse-ns buffer." 498 (interactive) 499 (cider-browse-ns--group 'type)) 500 501 (defun cider-browse-ns-group-by-visibility () 502 "Toggle visibility of var items displayed in browse-ns buffer." 503 (interactive) 504 (cider-browse-ns--group 'visibility)) 505 506 507 (declare-function cider-doc-lookup "cider-doc") 508 509 (defun cider-browse-ns-doc-at-point () 510 "Show the documentation for the thing at current point." 511 (interactive) 512 (let* ((thing (cider-browse-ns--thing-at-point)) 513 (value (cadr thing))) 514 ;; value is either some ns or a var 515 (cider-doc-lookup value))) 516 517 (defun cider-browse-ns-operate-at-point () 518 "Expand browser according to thing at current point. 519 If the thing at point is a ns it will be browsed, 520 and if the thing at point is some var - its documentation will 521 be displayed." 522 (interactive) 523 (let* ((thing (cider-browse-ns--thing-at-point)) 524 (type (car thing)) 525 (value (cadr thing))) 526 (if (eq type 'ns) 527 (cider-browse-ns value) 528 (cider-doc-lookup value)))) 529 530 (declare-function cider-find-ns "cider-find") 531 (declare-function cider-find-var "cider-find") 532 533 (defun cider-browse-ns-find-at-point () 534 "Find the definition of the thing at point." 535 (interactive) 536 (let* ((thing (cider-browse-ns--thing-at-point)) 537 (type (car thing)) 538 (value (cadr thing))) 539 (if (eq type 'ns) 540 (cider-find-ns nil value) 541 (cider-find-var current-prefix-arg value)))) 542 543 (defun cider-browse-ns-handle-mouse (_event) 544 "Handle mouse click EVENT." 545 (interactive "e") 546 (cider-browse-ns-operate-at-point)) 547 548 (provide 'cider-browse-ns) 549 550 ;;; cider-browse-ns.el ends here