1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
|
;;; cider-browse-ns.el --- CIDER namespace browser
;; Copyright © 2014-2019 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
|
