-
Notifications
You must be signed in to change notification settings - Fork 1
/
scrim-db.el
311 lines (272 loc) · 12.6 KB
/
scrim-db.el
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
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
;;; scrim-db.el --- Cache info about namespaces and symbols -*- lexical-binding: t; -*-
;; Copyright © 2023 Austin Haas
;;
;; Author: Austin Haas <austin@pettomato.com>
;; URL: http://github.com/austinhaas/scrim
;; This file is not part of GNU Emacs.
;;; Commentary:
;; The idea is to create an offline database of Clojure symbol
;; metadata that can be used to support features like find-definition
;; and eldoc.
;;; License:
;; 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 GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Code:
;; Dependencies that are included with Emacs
(require 'cl-lib)
(require 'subr-x)
(require 'xref)
;; Additional dependencies
(require 'clojure-mode)
(require 'scrim)
(defvar scrim--db nil)
(defvar scrim--db-filename ".scrim-db")
(defun scrim--db-file-path ()
(concat (scrim-project-root) scrim--db-filename))
;; TODO: Get path to namespace. See `scrim--repl-get-path-to-namespace-source-file'.
;; Doesn't work in cljs, because cljs doesn't have `all-ns`.
(defvar scrim--db-build-clj
;; This produces a clojure value that can be read by emacs lisp.
"(letfn [(alist [xs] (for [[k v] xs] (list k '. v)))
#_(alist [xs] (into {} xs))]
(alist
(concat
[[\"#special-forms#\"
(alist
(for [[k v] (deref #'clojure.repl/special-doc-map)]
(if-let [forms (get v :forms)]
(if (every? (fn [form] (= k (first form))) forms)
(let [arglists (map (comp vec rest) forms)]
[(str k) (alist {\"forms\" (str forms)
\"arglists\" (pr-str arglists)})])
[(str k) (alist {\"forms\" (str forms)})])
[(str k) nil])))]]
(for [ns (all-ns)]
[(str (ns-name ns))
(alist
{\"aliases\"
(alist
(for [[k v] (ns-aliases ns)]
[(name k) (name (ns-name v))]))
\"refers\"
(alist
(for [[k v] (ns-refers ns)
:let [ns-name (ns-name (:ns (meta v)))]
;; To save space.
:when (not= 'clojure.core ns-name)]
[(name k) (name ns-name)]))
\"interns\"
(alist
(for [[k v] (ns-interns ns)]
[(name k) (alist
(let [m (meta v)]
{\"arglists\" (some-> (get m :arglists) str )
\"file\" (when-let [x (get m :file)]
(case x
\"NO_SOURCE_PATH\" x
(str (.getResource
(clojure.lang.RT/baseLoader)
x))))
\"column\" (get m :column)
\"line\" (get m :line)
\"name\" (name (get m :name))
\"ns\" (name (ns-name (get m :ns)))}))]))})]))))")
(defun scrim-db-build ()
"Send a clojure expression to the REPL to create the database
based on the namespaces that are currently loaded."
(interactive nil scrim-mode scrim-minor-mode)
(if (get-buffer scrim--buffer-name)
(let ((pr (make-progress-reporter "Building database"))
(db (scrim--redirect-result-from-process (scrim-proc)
scrim--db-build-clj)))
(setq scrim--db (read db))
(progress-reporter-done pr))
(user-error "Not connected.")))
(defun scrim-db-save ()
(interactive nil scrim-mode scrim-minor-mode)
(message "Saving scrim db...")
(with-temp-buffer
(print scrim--db (current-buffer))
(write-file (scrim--db-file-path)))
(message "Saving scrim db...done"))
(defun scrim-db-load ()
(interactive nil scrim-mode scrim-minor-mode)
(message "Loading scrim db...")
(let ((f (scrim--db-file-path)))
(if (file-exists-p f)
(with-temp-buffer
(insert-file-contents f)
(setq scrim--db (read (current-buffer)))
(message "Loading scrim db...done"))
(message "Could not find scrim db file."))))
(defun scrim--db-get (alist key &optional default)
"Finds a value in an alist, where the keys are strings. Optional
default value will be returned if key is not found."
(if (listp alist)
(alist-get key alist default nil #'string-equal)
default))
(defun scrim--db-get-in (alist keys &optional default)
"Finds a value in a nested alist, where all keys are strings. Optional
default value will be returned if any keys are not found."
(if keys
(let* ((sentinel (gensym))
(result (scrim--db-get alist (car keys) sentinel)))
(if (eq result sentinel)
default
(scrim--db-get-in result (cdr keys) default)))
alist))
(defvar scrim--db-symbol-regexp "^\\(.*\\)/\\(.*\\)"
"A very permissive regexp that can be used to split a string
naming a Clojure symbol into namespace and symbol-name
components. It shouldn't be used to validate symbols.")
(defun scrim--db-parse-symbol (symbol)
"Parse a Clojure symbol into namespace and symbol-name
components. Returns (symbol-ns . symbol-name). symbol-ns may be a
fully-qualified namespace, nil, or an alias."
(if (string-match scrim--db-symbol-regexp symbol)
(cons (match-string 1 symbol)
(match-string 2 symbol))
(cons nil symbol)))
(defun scrim--db-lookup-symbol (current-ns symbol)
"Returns the metadata alist associated with symbol in
scrim--db. The symbol is looked up in the context of
current-ns. For example, if symbol is str/trim, where str is an
alias for clojure.string in current-ns, then the metadata
associated with clojure.string/trim will be returned.
Both args are strings."
(let* ((parsed-symbol (scrim--db-parse-symbol symbol))
(symbol-ns-local (car parsed-symbol))
(symbol-name (cdr parsed-symbol)))
(if (null symbol-ns-local)
;; Symbol does not have a namespace component.
(or
;; Symbol was refer'd.
(when-let ((symbol-ns (scrim--db-get-in scrim--db (list current-ns "refers" symbol-name))))
(scrim--db-get-in scrim--db (list symbol-ns "interns" symbol-name)))
;; Symbol is in the current ns.
(scrim--db-get-in scrim--db (list current-ns "interns" symbol-name))
;; Symbol is in clojure.core. scrim--db-build-clj elides symbols in
;; clojure.core to save space, so we need to check for it explicitly.
(scrim--db-get-in scrim--db (list "clojure.core" "interns" symbol-name))
;; Symbol is a special-form.
(scrim--db-get-in scrim--db (list "#special-forms#" symbol-name)))
;; Symbol has a namespace component.
(or
;; Alias
(when-let ((symbol-ns (scrim--db-get-in scrim--db (list current-ns "aliases" symbol-ns-local))))
(scrim--db-get-in scrim--db (list symbol-ns "interns" symbol-name)))
;; Fully-qualified
(scrim--db-get-in scrim--db (list symbol-ns-local "interns" symbol-name))))))
;;; Support for completion and xref (incomplete)
(defun scrim--db-get-all-namespaced-symbols ()
(mapcan (lambda (ns)
(mapcar (lambda (sym) (concat (car ns) "/" (car sym)))
(scrim--db-get ns "interns")))
scrim--db))
(defun scrim--db-completion-table (s)
(let* ((ns (clojure-find-ns))
(ns-alist (scrim--db-get scrim--db ns))
(interns (scrim--db-get ns-alist "interns"))
(refers (scrim--db-get ns-alist "refers"))
(aliases (scrim--db-get ns-alist "aliases")))
(nconc
(mapcar #'car (scrim--db-get-in scrim--db (list "#special-forms#")))
(mapcar #'car (scrim--db-get-in scrim--db (list "clojure.core" "interns")))
(mapcar #'car interns)
(mapcar #'car refers)
(mapcan (lambda (x)
(let* ((alias (car x))
(alias-ns (cdr x))
(alias-interns (scrim--db-get-in scrim--db (list alias-ns "interns"))))
(mapcar (lambda (x) (concat alias "/" (car x)))
alias-interns)))
aliases))))
(defun scrim--db-find-definition-location (identifier)
(let* ((ns (clojure-find-ns))
(alist (scrim--db-lookup-symbol ns identifier))
(file (scrim--db-get alist "file"))
(line (scrim--db-get alist "line"))
(column (scrim--db-get alist "column")))
(when (and file (not (string-equal file "NO_SOURCE_PATH")))
(list file line column))))
(defun scrim--db-get-possible-references (identifier)
"Takes a namespaced symbol and returns a list of (file strings),
where file is a file that might include a reference to this
identifier, and strings is a list of possible forms this
reference might take, such as a simple symbol if the symbol is
referred, or an aliased symbol if the symbol's namespace is
aliased.
This is intended to be used in an implementation of
`xref-backend-references'."
;; This has some limitations:
;; `identifier` must be a fully qualified symbol.
;; Doesn't detect references via :use.
;; Doesn't find fully qualified symbols, unless they are also mentioned in
;; the namespace's refers or aliases.
;; Doesn't find symbols evaluated in the REPL.
(let* ((parsed-symbol (scrim--db-parse-symbol identifier))
(symbol-ns (car parsed-symbol))
(symbol-name (cdr parsed-symbol)))
(mapcar (lambda (ns)
;; HACK! Getting the file from the ns based on the first
;; public symbol in that ns. TODO: Get the path to the
;; namespace file when building the db.
(let* ((file (seq-some (lambda (file)
(if (string-prefix-p "file:" file)
file
nil))
(mapcar
(lambda (x) (scrim--db-get x "file"))
(scrim--db-get ns "interns"))))
(refers (or (string-equal (scrim--db-get-in ns (list "refers" symbol-name)) symbol-ns)
(and (string-equal "clojure.core" symbol-ns)
(scrim--db-get-in scrim--db (list "clojure.core" "interns" symbol-name)))))
(alias (seq-some (lambda (x)
(and (string-equal (cdr x) symbol-ns)
(car x)))
(scrim--db-get ns "aliases")))
(strings (seq-remove #'null
(list (and refers symbol-name)
(and alias (concat alias "/" symbol-name))))))
(when (and file strings)
(list file strings))))
scrim--db)))
(defun scrim--db-get-apropos-locations (pattern)
(let ((regexp (xref-apropos-regexp pattern)))
(seq-filter (lambda (x) (string-match regexp (car x)))
(seq-remove #'null
(apply #'append
(mapcar (lambda (ns) (scrim--db-get ns "interns"))
scrim--db))))))
;;; eldoc
(defun scrim--db-eldoc-function (callback)
(when (not (nth 4 (syntax-ppss))) ; inside a comment?
(when-let ((sym (or (scrim-current-function-symbol)
(scrim-symbol-at-point))))
(let* ((ns (if (string-equal sym "ns")
"clojure.core"
(clojure-find-ns)))
(alist (scrim--db-lookup-symbol ns sym)))
(when alist
(if-let ((arglist (scrim--db-get alist "arglists")))
(format "%s: %s"
(propertize sym 'face 'font-lock-function-name-face)
arglist)
(if-let ((forms (scrim--db-get alist "forms")))
(format "%s: %s"
(propertize sym 'face 'font-lock-function-name-face)
forms)
(format "%s"
(propertize sym 'face 'font-lock-function-name-face)))))))))