-
Notifications
You must be signed in to change notification settings - Fork 1
/
scrim.el
1049 lines (879 loc) · 38.8 KB
/
scrim.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
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;;; scrim.el --- Simple Clojure REPL Interaction Mode -*- lexical-binding: t; -*-
;; Copyright © 2023 Austin Haas
;;
;; Author: Austin Haas <austin@pettomato.com>
;; URL: http://github.com/austinhaas/scrim
;; Version: 0.0.9
;; This file is not part of GNU Emacs.
;;; Commentary:
;; See README.md.
;;; 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 'comint)
(require 'lisp-mnt)
(require 'project)
(require 'subr-x)
(require 'thingatpt)
;; Additional dependencies
(require 'clojure-mode) ; https://github.com/clojure-emacs/clojure-mode/
(defconst scrim-version
(eval-when-compile
(lm-version (or load-file-name buffer-file-name)))
"The current version of `scrim'.")
;;;; Project support
(defun scrim-project-root ()
"Return root directory of the current project."
(or (clojure-project-dir default-directory)
(project-root (project-current t))))
;;;; Functions that extract expressions from Clojure buffers
(defun scrim-symbol-at-point ()
"Return the symbol at point."
(when (and (not (nth 3 (syntax-ppss))) ; Not inside a string.
(not (nth 4 (syntax-ppss)))) ; Not inside a comment.
(thing-at-point 'symbol t)))
(defun scrim-last-sexp ()
"Return the sexp before point."
(save-excursion
(let ((start (point)))
(backward-sexp)
(let ((beginning (point)))
(forward-sexp)
(let ((end (point)))
(when (<= end start)
(buffer-substring-no-properties beginning end)))))))
(defun scrim--beginning-of-sexp ()
"Move to the beginning of current sexp. Return the number of
nested sexp the point was over or after."
;; Based on `elisp--beginning-of-sexp`
(let ((ppss (syntax-ppss))
(parse-sexp-ignore-comments t)
(num-skipped-sexps 0))
(when (< 0 (nth 0 ppss)) ;; Must be inside at least one pair of parens.
(condition-case _
(progn
;; First account for the case the point is directly over a
;; beginning of a nested sexp.
(condition-case _
(let ((p (point)))
(forward-sexp -1)
(forward-sexp 1)
(when (< (point) p)
(setq num-skipped-sexps 1)))
(error))
;; Move out of any strings.
(when-let ((pos (nth 8 ppss)))
(goto-char pos)
(forward-sexp 1))
(while
(let ((p (point)))
(forward-sexp -1)
(when (< (point) p)
(setq num-skipped-sexps (1+ num-skipped-sexps))))))
(error))
;; `elisp--beginning-of-sexp` stops at the pos just inside the paren, but I
;; want this to be consistent with `beginning-of-defun` and move point to
;; the opening paren.
(backward-char)
num-skipped-sexps)))
(defun scrim--current-function-info ()
"Return a list of current function name and argument index."
;; Based on `elisp--fnsym-in-current-sexp`
(save-excursion
(when-let ((n (scrim--beginning-of-sexp)))
(let ((argument-index (1- n)))
;; If we are at the beginning of function name, this will be -1.
(when (< argument-index 0)
(setq argument-index 0))
(forward-char)
(list (scrim-symbol-at-point) argument-index)))))
(defun scrim-current-function-symbol ()
"Return the symbol in function position in the sexp around
point."
(car (scrim--current-function-info)))
(defun scrim-current-sexp ()
"Return sexp around point."
(save-excursion
(let ((start (point)))
(scrim--beginning-of-sexp)
(forward-sexp)
(let ((end (point)))
(backward-sexp)
(let ((beginning (point)))
(when (< beginning start end)
(buffer-substring-no-properties beginning end)))))))
(defun scrim-top-level-sexp ()
"Return the top-level sexp around point."
(save-excursion
(let ((start (point)))
(beginning-of-defun)
(forward-sexp)
(let ((end (point)))
(backward-sexp)
(let ((beginning (point)))
(when (< beginning start end)
(buffer-substring-no-properties beginning end)))))))
(defun scrim-top-level-or-last-sexp ()
"Return the outer sexp around point, if point is inside a sexp,
otherwise return the sexp before point."
(or (scrim-top-level-sexp)
(scrim-last-sexp)))
(defun scrim-sexps-in-region (start end)
"Return a list of all sexps in region."
(save-restriction
(narrow-to-region start end)
(check-parens)
(let ((all-bounds (let ((out ()))
(while (let ((e (scan-sexps start 1)))
(if e
(let ((s (scan-sexps e -1)))
(if s
(progn (setq out (cons (cons s e) out))
(setq start e))
nil))
nil)))
(reverse out))))
(mapcar (lambda (bounds)
(buffer-substring-no-properties (car bounds) (cdr bounds)))
all-bounds))))
;;;; Configuration
(defgroup scrim nil
"Scrim group"
:prefix "scrim-"
:group 'clojure
:link '(url-link :tag "GitHub" "https://github.com/austinhaas/scrim")
:link '(emacs-commentary-link :tag "Commentary" "scrim"))
(defcustom scrim-prompt-read-only t
"If t, the prompt in the Scrim REPL buffer is read-only."
:type 'boolean
:safe 'booleanp)
(defcustom scrim-prompt-regexp "^[^=> \n]+=> *"
"Regexp for the Clojure prompt. Default should match the default
Clojure REPL prompt.
See https://clojure.github.io/clojure/clojure.main-api.html#clojure.main/repl
for customizing the Clojure REPL prompt."
:type 'regexp
:safe 'stringp)
;;;; REPL buffer
(defvar scrim--buffer-name "*scrim*"
"The name of the Scrim REPL buffer.")
(defun scrim-proc ()
"Return the current Scrim REPL process, or nil if it doesn't
exist."
(get-buffer-process scrim--buffer-name))
(defun scrim-clear-repl-buffer ()
"Clear the Scrim REPL buffer."
(interactive nil scrim-mode scrim-minor-mode)
(with-current-buffer scrim--buffer-name
(comint-clear-buffer)
(goto-char (point-max))))
(defun scrim-repl-buffer-end ()
"Move point to the end of the Scrim REPL buffer."
(interactive nil scrim-mode scrim-minor-mode)
(if (scrim-proc)
(set-window-point (get-buffer-window scrim--buffer-name "visible")
(process-mark (scrim-proc)))
(user-error "Not connected.")))
(defun scrim-show-or-hide-repl-buffer ()
"Show the Scrim REPL buffer, if it exists and is not already
visible, or if it is visible, replace it with the previous
buffer."
(interactive nil scrim-mode scrim-minor-mode)
(if (get-buffer scrim--buffer-name)
(let ((window (get-buffer-window scrim--buffer-name "visible")))
(if window
(switch-to-prev-buffer window)
(display-buffer scrim--buffer-name)))
(user-error "Not connected.")))
(defun scrim-last-output ()
"Return the text between the last prompt and the current prompt
in the REPL."
(when (scrim-proc)
(with-current-buffer scrim--buffer-name
(let* ((s (buffer-substring-no-properties comint-last-input-end (process-mark (scrim-proc))))
;; Remove any trailing prompt.
(s (replace-regexp-in-string (concat scrim-prompt-regexp "\\'") "" s))
;; Remove any trailing newlines.
(s (replace-regexp-in-string "\n+\\'" "" s)))
s))))
;;;; Low-level, comint I/O
(defun scrim--indent-line ()
"If point is near a hidden input expression in the REPL show the expression,
otherwise indent the line via `clojure-indent-line'."
(or (scrim-show-repl-input-at-point)
(clojure-indent-line)))
(defun scrim--isearch-show (ov)
"Delete overlay OV.
This function is meant to be used as the `isearch-open-invisible'
property of an overlay."
(delete-overlay ov))
(defun scrim--isearch-show-temporary (ov hide-p)
"Hide or show overlay OV depending on HIDE-P. If HIDE-P is
non-nil, overlay OV is hidden. Otherwise, OV is shown.
This function is meant to be used as the `isearch-open-invisible-temporary'
property of an overlay."
(overlay-put ov 'invisible (and hide-p 'scrim)))
(defun scrim--invisible-overlay-at (position)
"Return invisible scrim overlay at POSITION, or nil if none to be found."
;; Implementation based on `hs-overlay-at'.
(seq-find (lambda (ov) (and (overlay-get ov 'scrim)
(overlay-get ov 'invisible)))
(overlays-at position)))
(defun scrim-show-repl-input-at-point ()
(interactive)
;; Very simplified version of `hs-show-block'. See that implementation, if
;; more is needed.
(when-let ((ov (or (scrim--invisible-overlay-at (line-end-position))
;; Based on `help-at-pt-string'.
(save-excursion
(goto-char (line-end-position))
(backward-char)
(scrim--invisible-overlay-at (point))))))
(delete-overlay ov)
(message "Showing input... done")))
(defun scrim--add-repl-input-overlay (start end)
(save-excursion
(goto-char start)
;; One overlay for all of the input.
(let ((ov (make-overlay start end)))
(overlay-put ov 'scrim t)
(overlay-put ov 'evaporate t)
(overlay-put ov 'kbd-help "<tab> to expand input"))
;; One overlay to hide everything after the first line.
(let ((ov (make-overlay (line-end-position) end)))
(overlay-put ov 'scrim t)
(overlay-put ov 'evaporate t)
(overlay-put ov 'invisible 'scrim)
(overlay-put ov 'isearch-open-invisible 'scrim--isearch-show)
(overlay-put ov 'isearch-open-invisible-temporary 'scrim--isearch-show-temporary))))
(defun scrim--send-indirectly (process string)
"Send STRING to PROCESS by first writing STRING to the process
buffer and then sending it from there as if a user typed it in."
;; The management of point is derived from
;; https://emacs.stackexchange.com/a/12346 and `append-to-buffer'.
(if process
(let* ((buffer (process-buffer process))
(windows (get-buffer-window-list buffer t t)))
(save-excursion
(with-current-buffer buffer
;; If point is at the end of the buffer, move it forward, otherwise leave it. This doesn't work
;; if point is within the previous output. I think comint adjusts point when the response is
;; received. This is supposed to be DWIM, but might be too magical.
(let ((point (point))
(point-at-max-p (= (point) (point-max))))
(comint-goto-process-mark)
(let ((input-start (point)))
(insert string)
(let ((input-end (point)))
;; Need to send the input before adding the overlay,
;; because `comint-send-input' removes overlays (and
;; text properties) since Emacs commit 4268d9a2b6b.
(comint-send-input)
(put-text-property input-start input-end 'read-only t)
(scrim--add-repl-input-overlay input-start input-end)))
(unless point-at-max-p
(goto-char point))
(dolist (window windows)
(when (= (window-point window) point)
(set-window-point window (point))))))))
(user-error "Not connected.")))
(defun scrim--send-directly (process string)
"Send STRING to PROCESS directly."
(if process
(comint-simple-send process string)
(user-error "Not connected.")))
(defun scrim--send (process string)
(scrim--send-indirectly process string))
(defun scrim--redirect-result-from-process (process command)
"Send COMMAND to PROCESS. Return the output. Does not show input
or output in Scrim REPL buffer.
Adapted from comint-redirect-results-list-from-process."
(if process
(let ((output-buffer " *Scrim Redirect Work Buffer*"))
(with-current-buffer (get-buffer-create output-buffer)
(erase-buffer)
(comint-redirect-send-command-to-process command output-buffer process nil t)
;; Wait for the process to complete
(set-buffer (process-buffer process))
(while (and (null comint-redirect-completed)
(accept-process-output process 60)))
;; Collect the output
(set-buffer output-buffer)
(let ((s (buffer-substring-no-properties (point-min) (point-max))))
;; Remove any trailing newlines
(replace-regexp-in-string "\n+\\'" "" s))))
(user-error "Not connected.")))
;;;; High-level, Clojure I/O
(defun scrim-eval-region (start end)
"Send each top-level expression in the region bound by start and
end to the REPL process, one at a time. Note that top-level is
constrained to the region."
(interactive "r" scrim-minor-mode)
(mapc (lambda (sexp)
;; Give the process a chance to reply before the next input, so that
;; input and output are interleaved in the buffer.
;; TODO: Consider creating a blocking send or some other way of
;; confirming a response before continuing. Maybe scrim-last-output
;; could be used.
(sleep-for 0.05)
(scrim--send (scrim-proc) sexp))
(scrim-sexps-in-region start end)))
(defun scrim-eval-buffer ()
"Send each expression in the accessible portion of current buffer
to the REPL process, one at a time. `narrow-to-region` can be
used to limit the part of buffer to be evaluated."
(interactive nil scrim-minor-mode)
(scrim-eval-region (point-min) (point-max)))
(defun scrim-eval-defn ()
"Send the top-level expression containing point, or before point
if point is not inside a top-level expression, to the REPL
process."
(interactive nil scrim-minor-mode)
(if-let ((s (scrim-top-level-or-last-sexp)))
(scrim--send (scrim-proc) s)
(user-error "No expression.")))
(defun scrim-eval-last-sexp ()
"Send the expression before point to the REPL process."
(interactive nil scrim-minor-mode)
(if-let ((s (scrim-last-sexp)))
(scrim--send (scrim-proc) s)
(user-error "No expression.")))
(defun scrim-eval-current-sexp ()
"Send the expression around point to the REPL process."
(interactive nil scrim-minor-mode)
(if-let ((s (scrim-current-sexp)))
(scrim--send (scrim-proc) s)
(user-error "No expression.")))
(defun scrim-quit ()
"Send EOF to the Scrim REPL process."
(interactive nil scrim-minor-mode)
(if (get-buffer scrim--buffer-name)
(with-current-buffer scrim--buffer-name
(comint-send-eof))
(user-error "Not connected.")))
;;;; Helper functions that interact with the REPL.
;; These functions send Clojure expressions to the REPL for evaluation. The
;; expressions evaluate to Clojure data structures, which are then returned to
;; Emacs as a string. The data structures are compatible with Elisp, so they can
;; be read into the Elisp process.
;;; REPL-based completion
(defvar cljs-default-namespaces (list "cljs.core"
"cljs.pprint"
"cljs.repl"
"cljs.spec.alpha"
"cljs.spec.gen.alpha"
"clojure.string"
"cljs.test"
"cljs.user"
"clojure.walk")
"A list of namespaces that ClojureScript will always have
available. This is intended to be used as a workaround to support
completion tables in ClojureScript, which doesn't have `all-ns'.")
(defun scrim--repl-get-all-namespaces ()
"Query the REPL for a list of all namespace names in the current environment.
In cljs, this returns `cljs-default-namespaces', because cljs
doesn't have `all-ns'.
This is intended to be used to support completion, and shouldn't
be considered an exhaustive list."
(read (scrim--redirect-result-from-process
(scrim-proc)
(format "#?(:clj (->> (all-ns) (map ns-name) (map name)) :cljs '%s)"
cljs-default-namespaces))))
(defun scrim--repl-get-all-namespaced-symbols ()
"Query the REPL for a list of all namespaced symbols.
In cljs, this only returns results for namespaces in
`cljs-default-namespaces', because cljs doesn't have `all-ns'.
This is intended to be used to support completion, and shouldn't
be considered an exhaustive list."
(read (scrim--redirect-result-from-process
(scrim-proc)
(format "#?(:clj
(->> (all-ns)
(mapcat (comp vals ns-interns))
(map meta)
(map #(str (:ns %%) \"/\" (:name %%))))
:cljs (->> (list %s)
(mapcat vals)
(map meta)
(map #(str (:ns %%) \"/\" (:name %%)))))"
;; In cljs, the argument to `ns-interns' must be quoted, so
;; we have to wrap each ns individually here.
(string-join
(mapcar (lambda (ns) (format "(ns-interns '%s)" ns))
cljs-default-namespaces)
" ")))))
(defun scrim--repl-get-all-symbols-in-current-ns ()
"Query the REPL for a list of all symbols that MAY BE in the ns
that corresponds to the current buffer. The list will include
simple symbols that are interned or refered, all aliased symbols
that could be in the current ns, and imports.
Note that the symbols may or may not actually appear in the
buffer/namespace. We're just looking at what is possible given
the currently loaded state of the namespace. For example, if
`clojure.string' is aliased as `str', then `str/split' will be
included.
This assumes that the ns in the current buffer is loaded. If the
buffer ns hasn't been loaded, then this will return nil.
In cljs, refered and aliased symbols are not included, because
cljs doesn't have `ns-refers' and `ns-aliases'.
This is intended to be used to support completion, and shouldn't
be considered an exhaustive list."
(read (let ((ns (clojure-find-ns)))
(scrim--redirect-result-from-process
(scrim-proc)
(format "(try
#?(:clj
(let [ns '%s]
(concat
(map str (keys (ns-interns ns)))
(map str (keys (ns-refers ns)))
(for [[alias ns'] (ns-aliases ns), sym (keys (ns-publics ns'))] (str alias \"/\" sym))
(map str (keys (ns-imports ns)))
(map str (vals (ns-imports ns)))))
:cljs
(concat
(map str (keys (ns-publics 'cljs.core)))
(map str (keys (ns-interns '%s)))
(map str (keys (ns-imports '%s)))
(map str (vals (ns-imports '%s)))))
(catch #?(:clj Throwable :cljs :default) e
nil))"
ns ns ns ns)))))
(defun scrim--repl-get-namespaced-symbol (symbol)
"Returns the namespaced symbol for the given symbol in the
current namespace."
(or (read (scrim--redirect-result-from-process
(scrim-proc)
(format "(try (when-let [m (meta (resolve '%s))] (str (:ns m) \"/\" (:name m)))
(catch #?(:clj Throwable :cljs :default) e nil))"
symbol)))
(error "Could not resolve symbol.")))
(defun scrim--repl-get-path-to-namespace-source-file (ns)
"Query the REPL for the path to the source file for namespace
ns.
In cljs, this returns nil, because I don't know how to get the
source file location for a namespace in cljs."
(read (scrim--redirect-result-from-process
(scrim-proc)
(format "#?(:clj
;; Based on clojure.core/load-one, clojure.core/load, and clojure.lang.RT/load.
(let [path (#'clojure.core/root-resource (ns-name '%s))
path (if (.startsWith path \"/\")
path
(str (#'clojure.core/root-directory (ns-name *ns*)) \\/ path))
path (.substring path 1)]
(str (or #_(.getResource (clojure.lang.RT/baseLoader) (str path \"__init\" \".class\"))
(.getResource (clojure.lang.RT/baseLoader) (str path \".clj\"))
(.getResource (clojure.lang.RT/baseLoader) (str path \".cljc\")))))
:cljs
nil)"
ns))))
(defun scrim--repl-get-path-to-symbol-source (symbol)
"Query the REPL for file, line, and column of the symbol's
source definition.
In cljs, this returns nil, because I don't know how to get the
source file location for a symbol in cljs."
(read (scrim--redirect-result-from-process
(scrim-proc)
(format "#?(:clj
(when-let [{:keys [file line column]} (meta (resolve '%s))]
(when (not (= \"NO_SOURCE_PATH\" file))
(list (or (some-> (.getResource (clojure.lang.RT/baseLoader) file) str)
(str \"file:\"file))
line
column)))
:cljs
nil)" symbol))))
(defun scrim--repl-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.
In cljs, this returns nil, because cljs doesn't have `all-ns' or
`ns-refers'.
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* ((namespaces (scrim--repl-get-all-namespaces))
(xs (read (scrim--redirect-result-from-process
(scrim-proc)
(format "#?(:clj
(let [symbol-in '%s
symbol-ns (namespace symbol-in)
symbol-name (name symbol-in)
simple-symbol (symbol symbol-name)]
(keep (fn [ns]
(let [strings (concat
;; Source ns
(when (= (name (ns-name ns)) symbol-ns)
[symbol-name])
;; Referred (make sure ns matches)
(when (some->
(ns-refers ns)
(get simple-symbol)
meta
:ns
ns-name
name
(= symbol-ns))
[symbol-name])
;; Aliased (make sure ns matches)
(for [[k v] (ns-aliases ns)
:when (= (name (ns-name v)) symbol-ns)]
(str k \"/\" symbol-name)))]
(when (seq strings)
(list (ns-name ns) strings))))
(all-ns)))
:cljs nil)"
identifier)))))
(mapcar (lambda (x)
(let* ((ns (car x))
(strings (cadr x))
(file (scrim--repl-get-path-to-namespace-source-file ns)))
(list file strings)))
xs)))
;;;; Commands that build common Clojure expressions, usually based on symbols
;;;; near point, and send them to the REPL.
(defcustom scrim-always-prompt-p nil
"If non-nil, interactive commands that take an argument and send
expressions to the REPL will always prompt the user before sending."
:type 'boolean
:safe 'booleanp)
(defmacro scrim--cmd (name docstring default-fn prompt-fn clj-format-string error-msg)
"Macro for defining simple commands that compose a Clojure
expression, usually based on a symbol near point, and send it to
the REPL process.
NAME is a symbol that will be the name of the new command.
DOCSTRING is a docstring for the command.
DEFAULT-FN and PROMPT-FN are used to produce an input
value. DEFAULT-FN is either nil or a function that takes no
arguments and returns an input value. PROMPT-FN is a function
that takes whatever DEFAULT-FN returns, or nil if DEFAULT-FN is
nil, and returns an input value.
The idea is that DEFAULT-FN is used to automatically guess which
symbol or expression the user probably wants, and PROMPT-FN is
used to prompt the user to either confirm the automatic value or
supply a new one.
PROMPT-FN is only called if DEFAULT-FN is nil, if DEFAULT-FN
returns nil or a blank string, if a prefix argument was supplied,
or if scrim-always-prompt-p is non-nil. This allows users to
control the conditions under which they will get prompted. For
example, one user might want the command to DWIM and avoid a
prompt, if possible, whereas another user might want to confirm
every expression before it is sent to the REPL.
CLJ-FORMAT-STRING is a format string for a Clojure expression. It
should take one argument: the input value.
ERROR-MSG will be displayed if the input value is nil or a blank
string."
`(defun ,name (arg)
,docstring
(interactive (let ((arg (when ,default-fn (funcall ,default-fn))))
(if (or current-prefix-arg
scrim-always-prompt-p
(null arg)
(and (stringp arg)
(string-blank-p arg)))
(list (funcall ,prompt-fn arg))
(list arg)))
scrim-mode scrim-minor-mode)
(if (or (null arg)
(string-blank-p arg))
(user-error ,error-msg)
(scrim--send (scrim-proc) (format ,clj-format-string arg)))))
;;; core
(scrim--cmd scrim-send-require
"Send (require ns) to the REPL."
'clojure-find-ns
(lambda (default-ns)
(read-string (format-prompt "require ns" "default-ns")
nil nil default-ns))
"(require '%s)"
"Namespace not found")
(scrim--cmd scrim-send-in-ns
"Send (in-ns ns) to the REPL."
'clojure-find-ns
(lambda (default-ns)
(completing-read (format-prompt "in ns" default-ns)
(completion-table-with-cache
(lambda (s)
(scrim--repl-get-all-namespaces)))
nil nil nil nil
default-ns))
"(in-ns '%s)"
"Namespace not found")
(scrim--cmd scrim-send-arglists
"Send (:arglists (meta (resolve ns))) to the REPL."
'scrim-current-function-symbol
(lambda (default-symbol)
(completing-read (format-prompt "arglists for function" default-symbol)
(completion-table-dynamic
(lambda (s)
(append (scrim--repl-get-all-symbols-in-current-ns)
(scrim--repl-get-all-namespaced-symbols)))
t)
nil nil nil nil
default-symbol))
"(:arglists (meta (resolve '%s)))"
"No function near point")
(scrim--cmd scrim-send-macroexpand
"Send (macroexpand form) to the REPL."
'scrim-last-sexp
(lambda (form)
(read-string (format-prompt "macroexpand form" form)
nil nil form))
"(macroexpand '%s)"
"No sexp found")
(scrim--cmd scrim-send-macroexpand-1
"Send (macroexpand-1 form) to the REPL."
'scrim-last-sexp
(lambda (form)
(read-string (format-prompt "macroexpand-1 form" form)
nil nil form))
"(macroexpand-1 '%s)"
"No sexp found")
(scrim--cmd scrim-send-macroexpand-all
"Send (clojure.walk/macroexpand-all form) to the REPL."
'scrim-last-sexp
(lambda (form)
(read-string (format-prompt "macroexpand-all form" form)
nil nil form))
"(clojure.walk/macroexpand-all '%s)"
"No sexp found")
(scrim--cmd scrim-send-load-file
"Send (load-file name) to the REPL."
(lambda () buffer-file-name)
(lambda (default-file-name)
(let ((file (expand-file-name
(read-file-name "file: "
nil default-file-name t
(file-name-nondirectory default-file-name)))))
(comint-check-source file)
file))
"(load-file \"%s\")"
"No file found")
;;; repl
;; TODO: Can't cache this completion because we need the SWITCH-BUFFER
;; argument that only completion-table-dynamic provides, in order to
;; use `clojure-find-ns' in `scrim--repl-get-all-symbols-in-current-ns'.
(scrim--cmd scrim-send-doc
"Send (clojure.repl/doc name) to the REPL."
'scrim-symbol-at-point
(lambda (default-symbol)
(completing-read (format-prompt "name" default-symbol)
(completion-table-dynamic
(lambda (s)
;; TODO: Include keywords, for specs.
(append (scrim--repl-get-all-namespaces)
(scrim--repl-get-all-symbols-in-current-ns)
(scrim--repl-get-all-namespaced-symbols)))
t)
nil nil nil nil
default-symbol))
"(clojure.repl/doc %s)"
"No name near point")
(scrim--cmd scrim-send-find-doc
"Send (clojure.repl/find-doc re-string-or-pattern) to the REPL."
nil
(lambda (x) (read-string (format-prompt "re-string-or-pattern" nil)))
"(clojure.repl/find-doc %s)"
"No input")
(scrim--cmd scrim-send-source
"Send (clojure.repl/source n) to the REPL."
'scrim-symbol-at-point
(lambda (default-symbol)
(completing-read (format-prompt "symbol" default-symbol)
(completion-table-dynamic
(lambda (s)
(append (scrim--repl-get-all-namespaces)
(scrim--repl-get-all-symbols-in-current-ns)
(scrim--repl-get-all-namespaced-symbols)))
t)
nil nil nil nil
default-symbol))
"(clojure.repl/source %s)"
"No symbol near point")
(scrim--cmd scrim-send-dir
"Send (clojure.repl/dir nsname) to the REPL."
'clojure-find-ns
(lambda (default-ns)
(completing-read (format-prompt "ns" default-ns)
(completion-table-with-cache
(lambda (s)
(scrim--repl-get-all-namespaces)))
nil nil nil nil
default-ns))
"(clojure.repl/dir %s)"
"No namespace found")
(scrim--cmd scrim-send-apropos
"Send (doseq [v (sort (clojure.repl/apropos str-or-pattern))] (println v)) to the REPL."
nil
(lambda (x) (read-string (format-prompt "str-or-pattern" nil)))
"(doseq [v (sort (clojure.repl/apropos %s))] (println v))"
"No input")
(defun scrim-send-pst ()
"Send (clojure.repl/pst) to the REPL."
(interactive nil scrim-mode scrim-minor-mode)
(scrim--send (scrim-proc) "(clojure.repl/pst)"))
;;; pretty print
(defun scrim-send-pp ()
"Send #?(:clj (clojure.pprint/pp) :cljs (cljs.pprint/pp)) to the REPL."
(interactive nil scrim-mode scrim-minor-mode)
(scrim--send (scrim-proc) "#?(:clj (clojure.pprint/pp) :cljs (cljs.pprint/pp))"))
;;; javadoc
(scrim--cmd scrim-send-javadoc
"Send (clojure.java.javadoc/javadoc class-or-object) to the REPL."
nil
(lambda (x) (read-string (format-prompt "class-or-object" nil)))
"(clojure.java.javadoc/javadoc %s)"
"No input")
;;;; Keymaps
(defvar scrim-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map comint-mode-map)
(define-key map (kbd "C-c C-q") #'scrim-quit)
(define-key map (kbd "C-c o") #'scrim-clear-repl-buffer)
(define-key map (kbd "C-c C-s e") #'scrim-repl-buffer-end)
(define-key map (kbd "C-c C-z") #'scrim-show-or-hide-repl-buffer)
map))
(defvar scrim-minor-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c C-M-c") #'scrim-connect)
(define-key map (kbd "C-c C-q") #'scrim-quit)
(define-key map (kbd "C-c C-z") #'scrim-show-or-hide-repl-buffer)
(define-key map (kbd "C-c o") #'scrim-clear-repl-buffer)
(define-key map (kbd "C-c C-o") #'scrim-clear-repl-buffer)
(define-key map (kbd "C-c C-s e") #'scrim-repl-buffer-end)
(define-key map (kbd "C-c e") #'scrim-eval-last-sexp)
(define-key map (kbd "C-c C-e") #'scrim-eval-last-sexp)
(define-key map (kbd "C-x C-e") #'scrim-eval-last-sexp)
(define-key map (kbd "C-c C-c") #'scrim-eval-defn)
(define-key map (kbd "C-M-x") #'scrim-eval-defn)
(define-key map (kbd "C-c b") #'scrim-eval-buffer)
(define-key map (kbd "C-c C-b") #'scrim-eval-buffer)
(define-key map (kbd "C-c C-M-r") #'scrim-eval-region)
(define-key map (kbd "C-c l") #'scrim-send-load-file)
(define-key map (kbd "C-c C-l") #'scrim-send-load-file)
(define-key map (kbd "C-c r") #'scrim-send-require)
(define-key map (kbd "C-c C-r") #'scrim-send-require)
(define-key map (kbd "C-c n") #'scrim-send-in-ns)
(define-key map (kbd "C-c C-n") #'scrim-send-in-ns)
(define-key map (kbd "C-c a") #'scrim-send-arglists)
(define-key map (kbd "C-c C-a") #'scrim-send-arglists)
(define-key map (kbd "C-c m m") #'scrim-send-macroexpand)
(define-key map (kbd "C-c C-m m") #'scrim-send-macroexpand)
(define-key map (kbd "C-c m 1") #'scrim-send-macroexpand-1)
(define-key map (kbd "C-c C-m 1") #'scrim-send-macroexpand-1)
(define-key map (kbd "C-c m a") #'scrim-send-macroexpand-all)
(define-key map (kbd "C-c C-m a") #'scrim-send-macroexpand-all)
(define-key map (kbd "C-c C-d d") #'scrim-send-doc)
(define-key map (kbd "C-c C-d j") #'scrim-send-javadoc)
(define-key map (kbd "C-c C-d f") #'scrim-send-find-doc)
(define-key map (kbd "C-c C-d s") #'scrim-send-source)
(define-key map (kbd "C-c C-d a") #'scrim-send-apropos)
(define-key map (kbd "C-c C-M-d") #'scrim-send-dir)
(define-key map (kbd "C-c C-M-e") #'scrim-send-pst)
(define-key map (kbd "C-c p") #'scrim-send-pp)
map))
;;;; Modes
;;;###autoload
(define-minor-mode scrim-minor-mode
"Minor mode for interacting with the Scrim REPL buffer.
\\{scrim-minor-mode-map}"
:lighter " Scrim"
:keymap scrim-minor-mode-map)
(define-derived-mode scrim-mode comint-mode "scrim"
"Major mode for a Clojure REPL.
\\{scrim-mode-map}"
(clojure-mode-variables)
(clojure-font-lock-setup)
(setq-local comint-prompt-regexp scrim-prompt-regexp)
(setq-local comint-scroll-to-bottom-on-input t)
(setq-local mode-line-process '(":%s"))
(setq-local comint-prompt-read-only scrim-prompt-read-only)
;; Keep original text properties.
(setq-local comint-highlight-input nil)
(setq-local indent-line-function #'scrim--indent-line)
(setq-local help-at-pt-display-when-idle t)
(add-to-invisibility-spec '(scrim . t)))
;;;; Starting
;;;###autoload
(defun scrim (program &rest args)
"Launch a Scrim REPL buffer, running PROGRAM.
PROGRAM should be one of the following:
- a string, denoting an executable program that launches a
Clojure REPL
- a cons pair of the form (HOST . SERVICE), denoting a TCP
connection to a Clojure socket server
Note that PROGRAM must be something that launches a Clojure
native REPL, like \"clojure\" or \"clj\" from the Clojure CLI
tools. \"lein repl\" will not work, for instance, because it uses
nrepl, which this library does not support. A workaround is to
launch a process with a socket server, outside of Emacs, and
connect to it via `scrim-connect'."
(interactive (cons (read-string (format-prompt "program" "clojure") nil nil "clojure")
(split-string (read-string (format-prompt "args" nil) nil nil ""))))
(if (get-buffer-process scrim--buffer-name)
(user-error "Already connected.")
(message "Starting a Clojure REPL...")
(let ((default-directory (scrim-project-root))
;; Binding process-connection-type to nil causes the communication with
;; the subprocess to use a pipe rather than a pty. Without this,