-
Notifications
You must be signed in to change notification settings - Fork 109
/
clj-refactor.el
4454 lines (3896 loc) · 175 KB
/
clj-refactor.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
;;; clj-refactor.el --- A collection of commands for refactoring Clojure code -*- lexical-binding: t -*-
;; Copyright © 2012-2014 Magnar Sveen
;; Copyright © 2014-2023 Magnar Sveen, Lars Andersen, Benedek Fazekas, Bozhidar Batsov
;; Author: Magnar Sveen <[email protected]>
;; Lars Andersen <[email protected]>
;; Benedek Fazekas <[email protected]>
;; Bozhidar Batsov <[email protected]>
;; Version: 3.12.0
;; Keywords: convenience, clojure, cider
;; Package-Requires: ((emacs "26.1") (seq "2.19") (yasnippet "0.6.1") (paredit "24") (multiple-cursors "1.2.2") (clojure-mode "5.18.0") (cider "1.11.1") (parseedn "1.2.0") (inflections "2.6") (hydra "0.13.2"))
;; 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/>.
;;; Commentary:
;; See README.md at https://github.com/clojure-emacs/clj-refactor.el
;;; Code:
(require 'seq)
(require 'yasnippet)
(require 'paredit)
(require 'multiple-cursors-core)
(require 'clojure-mode)
(require 'cider)
(require 'parseedn)
(require 'sgml-mode)
(require 'inflections)
(require 'hydra)
(require 'subword)
(defgroup cljr nil
"Clojure refactoring facilities."
:prefix "cljr-"
:group 'clojure
:link '(url-link :tag "GitHub"
"https://github.com/clojure-emacs/clj-refactor.el"))
(defcustom cljr-add-ns-to-blank-clj-files t
"If t, automatically add a ns form to new .clj files."
:type 'boolean
:safe #'booleanp)
(defcustom cljr-auto-sort-ns t
"If t, sort ns form after any command that changes it."
:type 'boolean
:safe #'booleanp)
(defcustom cljr-magic-requires t
"Whether to automatically require common namespaces when they are used.
These are the namespaces listed in `cljr-magic-require-namespaces'
and returned by the `namespace-aliases' middleware op.
If this variable is `:prompt', typing the short form followed by
`\\[cljr-slash]' will ask if you want to add the corresponding require
statement to the ns form.
Any other non-nil value means to add the form without asking."
:type '(choice (const :tag "true" t)
(const :tag "prompt" :prompt)
(const :tag "false" nil)))
(defcustom cljr-slash-uses-suggest-libspec t
"If t, `cljr-slash'' magic requires' functionality will use `cljr-suggest-libspec'.
The `suggest-libspec' middleware operation replaces the `namespace-aliases'
operation. It incorporates the requested namespace alias, buffer and scoped
language context (clj, cljs, cljc, etc), preferred-aliases from the
`cljr-magic-require-namespaces', with existing aliases from the project and
returns a candidate list of suitable libspec entries. This is passed to the
completion framework along with language context information to add a
require which will satisfy the alias for a given namespace.
Currently testing this flag as the default, remove associated deprecated
paths once this flag is removed."
:type 'boolean
:safe #'booleanp)
(defcustom cljr-magic-require-namespaces
'(("edn" . "clojure.edn")
("io" "clojure.java.io" :only ("clj"))
("math" . "clojure.math")
("set" . "clojure.set")
("str" . "clojure.string")
("walk" . "clojure.walk")
("zip" . "clojure.zip"))
"Alist of aliases to namespace libspec recommendations for `\\[cljr-slash]'.
An optional keyword `:only` can limit a recommendation to the set of
language contexts (clj, cljs) the libspec is available in."
:type '(repeat (cons (string :tag "Short alias")
(string :tag "Full namespace")))
:safe #'listp)
(defcustom cljr-project-clean-prompt t
"If t, `cljr-project-clean' asks before doing anything.
If nil, the project clean functions are run without warning."
:type 'boolean
:safe #'booleanp)
(defcustom cljr-project-clean-functions
(list #'cljr-clean-ns)
"List of functions called by `cljr-project-clean'.
These are called on all .clj files in the project."
:type '(repeat function)
:safe #'listp)
(defcustom cljr-project-clean-exceptions '("dev/user.clj" "project.clj" "boot.clj")
"A list of files that `cljr-project-clean' should avoid."
:type '(repeat string)
:safe #'listp)
(defcustom cljr-hotload-dependencies nil
"If t, newly added dependencies are also hotloaded into the repl.
This only applies to dependencies added by `cljr-add-project-dependency'."
:type 'boolean
:safe #'booleanp)
(defcustom cljr-favor-private-functions t
"If t, refactorings insert private function declarations."
:type 'boolean
:safe #'booleanp)
(defcustom cljr-favor-prefix-notation nil
"If t, `cljr-clean-ns' favors prefix notation in the ns form."
:type 'boolean
:safe #'booleanp)
(defcustom cljr-insert-newline-after-require t
"If t, `cljr-clean-ns' will place a newline after the `:require` and `:import` tokens."
:type 'boolean
:safe #'booleanp)
(defcustom cljr-use-multiple-cursors t
"If t, some refactorings use the `multiple-cursors' package.
This improves interactivity of the commands. If nil, those
refactorings will use regular prompts instead."
:type 'boolean
:safe #'booleanp)
(defcustom cljr-auto-clean-ns t
"If t, call `cljr-clean-ns' after commands that change the ns."
:type 'boolean
:safe #'booleanp)
(defcustom cljr-populate-artifact-cache-on-startup t
"If t, the middleware will eagerly populate the artifact cache.
This makes `cljr-add-project-dependency' as snappy as can be."
:type 'boolean
:safe #'booleanp)
(defcustom cljr-warn-on-eval t
"If t, warn the user before running any op that requires ASTs to be built,
that the project will be evaled.
If this is not preferred the op will
be aborted. Also effectively overrides `cljr-eagerly-build-asts-on-startup'
so if this is on the AST cache is not warmed at startup or after certain
operations."
:type 'boolean
:safe #'booleanp)
(defcustom cljr-eagerly-build-asts-on-startup t
"If t, the middleware will eagerly populate the ast cache.
This makes `cljr-find-usages' and `cljr-rename-symbol' as snappy
as can be."
:type 'boolean
:safe #'booleanp)
(defcustom cljr-suppress-middleware-warnings nil
"If t, no middleware warnings are printed to the repl."
:type 'boolean
:safe #'booleanp)
(defcustom cljr-suppress-no-project-warning nil
"If t, no warning is printed when starting a REPL outside a project.
By default, a warning is printed in this case since clj-refactor
will not work as expected in such REPLs."
:type 'boolean
:safe #'booleanp)
(define-obsolete-variable-alias 'cljr-find-usages-ignore-analyzer-errors 'cljr-ignore-analyzer-errors "2.3.0")
(defcustom cljr-ignore-analyzer-errors nil
"If t, `cljr-find-usages' `cljr-inline-symbol' `cljr-rename-symbol' ignores namespaces that cannot be analyzed.
If any namespaces presents an analyzer error, it is skipped and
the command carries on looking for the given symbol in those
namespaces which can be analyzed.
If nil, `cljr-find-usages' `cljr-inline-symbol' `cljr-rename-symbol'
won't run if there is a broken namespace in the project."
:type 'boolean
:safe #'booleanp)
(defcustom cljr-auto-eval-ns-form t
"When t, refactorings which change the ns form also trigger its re-evaluation."
:type 'boolean
:safe #'booleanp)
(defcustom cljr-midje-test-declaration "[midje.sweet :as midje]"
"The require form to use when midje is in use."
:type 'string
:safe #'stringp)
(defcustom cljr-expectations-test-declaration "[expectations :as e]"
"The require form to use when expectations is in use."
:type 'string
:safe #'stringp)
(defcustom cljr-cljc-clojure-test-declaration "#?(:clj [clojure.test :as t]
:cljs [cljs.test :as t :include-macros true])"
"The require form to use when clojure.test and cljs.test is in use in a cljc file."
:type 'string
:safe #'stringp)
(defcustom cljr-cljs-clojure-test-declaration "[cljs.test :as t :include-macros true]"
"The require form to use when cljs.test is in use in a cljs file."
:type 'string
:safe #'stringp)
(defcustom cljr-clojure-test-declaration "[clojure.test :as t]"
"The require form to use when clojure.test is in use in a clj file."
:type 'string
:safe #'stringp)
(defcustom cljr-clojure-test-namespace-under-test-alias "sut"
"The package alias to use for the namespace under test."
:type 'string
:safe #'stringp)
(defcustom cljr-inject-dependencies-at-jack-in t
"When nil, do not inject repl dependencies (most likely nREPL middlewares)
at `cider-jack-in' time."
:type 'boolean
:safe #'booleanp)
;; TODO: deprecated by `cljr-slash-uses-suggest-libspec'
(defcustom cljr-assume-language-context nil
"If set to `clj' or `cljs',
clj-refactor will use that value in situations where the language context is ambiguous.
If set to nil, a popup will be created in each ambiguous case asking user to choose language context."
:type 'string
:safe #'stringp)
(defcustom cljr-libspec-whitelist
'("^cljsns" "^slingshot.test" "^monger.joda-time" "^monger.json")
"List of regexes to match against libspec names which shouldn't be pruned.
This is useful when `clean-ns' should leave a libspec alone even
if it appears to be unused."
:type '(repeat string)
:safe #'listp)
(defvar cljr-minimum-clojure-version "1.8.0"
"The oldest Clojure version supported by our middleware.")
(defvar clj-refactor-map (make-sparse-keymap))
(defvar cljr--add-require-snippet
"${1:[${2:${3:} :as ${4:${3:$(cljr--ns-name yas-text)}}}]}"
"The snippet used in in `cljr-add-require-to-ns'.")
(defun cljr--ns-name (ns)
"Return the last name in a full NS."
(replace-regexp-in-string ".*\\." "" ns))
(defvar cljr--add-use-snippet "[$1 :refer ${2:[$3]}]"
"The snippet used in in `cljr-add-use-to-ns'.")
(defvar *cljr--noninteractive* nil
"t, when our interactive functions are called programmatically.")
(defvar cljr--file-column-pattern
"^\\(.+?\\):\\([1-9][0-9]*\\):\\([0-9][0-9]*\\): "
"A regexp pattern that groups output into filename,
line number and column number.")
(defvar cljr--debug-mode nil)
(defvar cljr--occurrences nil)
(defvar cljr--signature-changes nil)
(defvar cljr--change-signature-buffer "*cljr-change-signature*")
(defvar cljr--manual-intervention-buffer "*cljr-manual-intervention*")
(defvar cljr--find-symbol-buffer "*cljr-find-usages*")
(defvar cljr--post-command-messages nil "Message(s) to display after the current command is done.")
(defcustom cljr-before-warming-ast-cache-hook nil
"Runs before each time the AST is loaded."
:type 'hook)
(defcustom cljr-after-warming-ast-cache-hook nil
"Runs after each time the AST is loaded."
:type 'hook)
(defcustom cljr-middleware-ignored-paths nil
"List of (Java style) regexes to paths that should be ignored by the middleware."
:type '(repeat string)
:safe #'listp)
;;; Buffer Local Declarations
;; tracking state of find-symbol buffer
(defvar-local cjr--occurrence-count 0 "Counts occurrences of found symbols.")
(defvar-local cljr--num-syms -1 "Keeps track of overall number of symbol occurrences.")
(defvar-local cljr--occurrence-ids '() "Keeps track of already processed symbol occurrences.")
(defmacro cljr--update-file (filename &rest body)
"If there is an open buffer for FILENAME, then change that.
Otherwise open the file and do the changes non-interactively."
(declare (debug (form body))
(indent 1))
(let ((fn (make-symbol "filename"))
(bf (make-symbol "buffer"))
(wo (make-symbol "was-open")))
`(let* ((,fn ,filename)
(,wo (get-file-buffer ,fn))
(,bf (find-file-noselect ,fn)))
(when ,bf
(set-buffer ,bf)
,@body
(save-buffer)
(when (not ,wo)
;; Don't accumulate open buffers, since this can slow down Emacs for large projects:
(kill-buffer))))))
(define-key clj-refactor-map [remap paredit-raise-sexp] 'cljr-raise-sexp)
(define-key clj-refactor-map [remap paredit-splice-sexp-killing-backward] 'cljr-splice-sexp-killing-backward)
(define-key clj-refactor-map [remap paredit-splice-sexp-killing-forward] 'cljr-splice-sexp-killing-forward)
(define-key clj-refactor-map (kbd "/") 'cljr-slash)
(defun cljr--use-multiple-cursors-p ()
(and cljr-use-multiple-cursors
(not (bound-and-true-p evil-mode))))
(defun cljr--vector-at-point-p ()
(eq (char-after) ?\[))
(defun cljr--fix-special-modifier-combinations (key)
(cl-case key
("C-s-i" "s-TAB")
("C-s-m" "s-RET")
(otherwise key)))
(defun cljr--key-pairs-with-modifier (modifier keys)
(read-kbd-macro
(string-join
(seq-map
(lambda (it)
(cljr--fix-special-modifier-combinations (concat modifier (char-to-string it))))
(string-to-list keys)) " ")))
(defun cljr--key-pairs-with-prefix (prefix keys)
(read-kbd-macro (concat prefix " " keys)))
(defvar cljr--all-helpers
'(("ai" . (cljr-add-import-to-ns "Add import to ns" ?i ("ns")))
("am" . (cljr-add-missing-libspec "Add missing libspec" ?m ("ns")))
("ap" . (cljr-add-project-dependency "Add project dependency" ?p ("ns" "project")))
("ar" . (cljr-add-require-to-ns "Add require to ns" ?r ("ns")))
("as" . (cljr-add-stubs "Add stubs for the interface/protocol at point" ?s ("toplevel-form")))
("au" . (cljr-add-use-to-ns "Add use to ns" ?U ("ns")))
("ci" . (clojure-cycle-if "Cycle if" ?I ("code")))
("cn" . (cljr-clean-ns "Clean ns" ?c ("ns")))
("cp" . (clojure-cycle-privacy "Cycle privacy" ?P ("toplevel-form")))
("cs" . (cljr-change-function-signature "Change function signature" ?C ("toplevel-form" "project")))
("ct" . (cljr-cycle-thread "Cycle thread" ?t ("code")))
("dk" . (cljr-destructure-keys "Destructure keys" ?d ("code")))
("ec" . (cljr-extract-constant "Extract constant" ?c ("toplevel-form")))
("ed" . (cljr-extract-def "Extract form as def" ?D ("toplevel-form")))
("ef" . (cljr-extract-function "Extract function" ?e ("toplevel-form")))
("el" . (cljr-expand-let "Expand let" ?e ("code")))
("fe" . (cljr-create-fn-from-example "Create function from example" ?f ("toplevel-form")))
("fu" . (cljr-find-usages "Find usages" ?u ("project" "code")))
("hd" . (cljr-hotload-dependency "Hotload dependency" ?h ("project")))
("il" . (cljr-introduce-let "Introduce let" ?l ("code")))
("is" . (cljr-inline-symbol "Inline symbol" ?i ("project" "toplevel-form" "code")))
("mf" . (cljr-move-form "Move form" ?m ("toplevel-form" "project")))
("ml" . (cljr-move-to-let "Move to let" ?m ("code")))
("pc" . (cljr-project-clean "Project clean" ?c ("project")))
("pf" . (cljr-promote-function "Promote function" ?p ("code" "toplevel-form")))
("rf" . (cljr-rename-file-or-dir "Rename file-or-dir" ?r ("project" "toplevel-form")))
("rl" . (cljr-remove-let "Remove let" ?r ("code")))
("rm" . (cljr-require-macro "Add to or extend the require-macros form" ?M ("ns")))
("rs" . (cljr-rename-symbol "Rename symbol" ?s ("project" "code")))
("sc" . (cljr-show-changelog "Show the project's changelog" ?c ("cljr")))
("sp" . (cljr-sort-project-dependencies "Sort project dependencies" ?S ("project")))
("sr" . (cljr-stop-referring "Stop referring" ?t ("ns")))
("tf" . (clojure-thread-first-all "Thread first all" ?f ("code")))
("th" . (clojure-thread "Thread" ?T ("code")))
("tl" . (clojure-thread-last-all "Thread last all" ?L ("code")))
("ua" . (clojure-unwind-all "Unwind all" ?U ("code")))
("up" . (cljr-update-project-dependencies "Update project dependencies" ?U ("project")))
("uw" . (clojure-unwind "Unwind" ?w ("code")))
("ad" . (cljr-add-declaration "Add declaration" ?d ("toplevel-form")))
("?" . (cljr-describe-refactoring "Describe refactoring" ?d ("cljr")))
("hh" . (hydra-cljr-help-menu/body "Parent menu for hydra menus" ?h ("hydra")))
("hn" . (hydra-cljr-ns-menu/body "Hydra menu for ns refactorings" ?n ("hydra")))
("hc" . (hydra-cljr-code-menu/body "Hydra menu for code refactorings" ?c ("hydra")))
("hp" . (hydra-cljr-project-menu/body "Hydra menu for project refactorings" ?p ("hydra")))
("ht" . (hydra-cljr-toplevel-form-menu/body "Hydra menu for top level refactorings " ?t ("hydra")))
("hs" . (hydra-cljr-cljr-menu/body "Hydra menu for self features" ?s ("hydra")))))
(defhydra hydra-cljr-ns-menu (:color pink :hint nil)
"
Ns related refactorings
------------------------------------------------------------------------------------------------------------------------------------------------------
_ai_: Add import to ns _am_: Add missing libspec _ap_: Add project dependency
_ar_: Add require to ns _au_: Add use to ns _cn_: Clean ns
_rm_: Require a macro into the ns _sr_: Stop referring
_b_: Back to previous Hydra
"
("ai" cljr-add-import-to-ns) ("am" cljr-add-missing-libspec)
("ap" cljr-add-project-dependency) ("ar" cljr-add-require-to-ns)
("au" cljr-add-use-to-ns) ("cn" cljr-clean-ns)
("rm" cljr-require-macro) ("sr" cljr-stop-referring)
("b" hydra-cljr-help-menu/body :exit t)
("q" nil "quit"))
(defhydra hydra-cljr-code-menu (:color pink :hint nil)
"
Code related refactorings
------------------------------------------------------------------------------------------------------------------------------------------------------
_ci_: Cycle if _ct_: Cycle thread
_dk_: Destructure keys _el_: Expand let _fu_: Find usages
_il_: Introduce let _is_: Inline symbol _ml_: Move to let
_pf_: Promote function _rl_: Remove let _rs_: Rename symbol
_tf_: Thread first all _th_: Thread _tl_: Thread last all
_ua_: Unwind all _uw_: Unwind
_b_: Back to previous Hydra
"
("ci" clojure-cycle-if) ("ct" cljr-cycle-thread)
("dk" cljr-destructure-keys) ("el" cljr-expand-let)
("fu" cljr-find-usages) ("il" cljr-introduce-let)
("is" cljr-inline-symbol) ("ml" cljr-move-to-let)
("pf" cljr-promote-function) ("rl" cljr-remove-let)
("rs" cljr-rename-symbol) ("tf" clojure-thread-first-all)
("th" clojure-thread) ("tl" clojure-thread-last-all)
("ua" clojure-unwind-all) ("uw" clojure-unwind)
("b" hydra-cljr-help-menu/body :exit t)
("q" nil "quit"))
(defhydra hydra-cljr-project-menu (:color pink :hint nil)
"
Project related refactorings
------------------------------------------------------------------------------------------------------------------------------------------------------
_ap_: Add project dependency _cs_: Change function signature _fu_: Find usages
_hd_: Hotload dependency _is_: Inline symbol _mf_: Move form
_pc_: Project clean _rf_: Rename file-or-dir _rs_: Rename symbol _sp_: Sort project dependencies
_up_: Update project dependencies
_b_: Back to previous Hydra
"
("ap" cljr-add-project-dependency) ("cs" cljr-change-function-signature)
("fu" cljr-find-usages) ("hd" cljr-hotload-dependency)
("is" cljr-inline-symbol) ("mf" cljr-move-form)
("pc" cljr-project-clean) ("rf" cljr-rename-file-or-dir)
("rs" cljr-rename-symbol) ("sp" cljr-sort-project-dependencies)
("up" cljr-update-project-dependencies)
("b" hydra-cljr-help-menu/body :exit t)
("q" nil "quit"))
(defhydra hydra-cljr-toplevel-form-menu (:color pink :hint nil)
"
Toplevel form related refactorings
------------------------------------------------------------------------------------------------------------------------------------------------------
_as_: Add stubs for the interface/protocol at point_cp_: Cycle privacy _cs_: Change function signature
_ec_: Extract constant _ed_: Extract form as def _ef_: Extract function
_fe_: Create function from example _is_: Inline symbol _mf_: Move form
_pf_: Promote function _rf_: Rename file-or-dir _ad_: Add declaration
_b_: Back to previous Hydra
"
("as" cljr-add-stubs) ("cp" clojure-cycle-privacy)
("cs" cljr-change-function-signature) ("ec" cljr-extract-constant)
("ed" cljr-extract-def) ("ef" cljr-extract-function)
("fe" cljr-create-fn-from-example) ("is" cljr-inline-symbol)
("mf" cljr-move-form) ("pf" cljr-promote-function)
("rf" cljr-rename-file-or-dir) ("ad" cljr-add-declaration)
("b" hydra-cljr-help-menu/body :exit t)
("q" nil "quit"))
(defhydra hydra-cljr-cljr-menu (:color pink :hint nil)
"
Cljr related refactorings
------------------------------------------------------------------------------------------------------------------------------------------------------
_sc_: Show the project's changelog _?_: Describe refactoring
_b_: Back to previous Hydra
"
("sc" cljr-show-changelog) ("?" cljr-describe-refactoring)
("b" hydra-cljr-help-menu/body :exit t)
("q" nil "quit"))
(defhydra hydra-cljr-help-menu (:color pink :hint nil)
"
Available refactoring types
-----------------------------------------------------------------------------
_n_: Ns related refactorings _c_: Code related refactorings
_p_: Project related refactorings _t_: Top level forms related refactorings
_s_: Refactor related functions
"
("n" hydra-cljr-ns-menu/body :exit t)
("c" hydra-cljr-code-menu/body :exit t)
("p" hydra-cljr-project-menu/body :exit t)
("t" hydra-cljr-toplevel-form-menu/body :exit t)
("s" hydra-cljr-cljr-menu/body :exit t)
("q" nil "quit" :color blue))
(defun cljr--add-keybindings (key-fn)
"Build the keymap from the list of keys/functions in `cljr--all-helpers'."
(dolist (details cljr--all-helpers)
(let ((key (car details))
(fn (cadr details)))
(define-key clj-refactor-map (funcall key-fn key) fn))))
;;;###autoload
(defun cljr-add-keybindings-with-prefix (prefix)
"Bind keys in `cljr--all-helpers' under a PREFIX key."
(cljr--add-keybindings (apply-partially 'cljr--key-pairs-with-prefix prefix)))
;;;###autoload
(defun cljr-add-keybindings-with-modifier (modifier)
"Bind keys in `cljr--all-helpers' under a MODIFIER key."
(cljr--add-keybindings (apply-partially 'cljr--key-pairs-with-modifier modifier)))
;; ------ utilities -----------
(defun cljr--extract-sexp ()
(buffer-substring (point) (cljr--point-after 'paredit-forward)))
(defun cljr--delete-sexp ()
(delete-region (point) (cljr--point-after 'paredit-forward)))
(defun cljr--extract-sexp-as-list (&optional with-whitespace)
"Returns list of strings representing the elements of the SEXP at point.
If optional `with-whitespace' is T sexp elements are not trimmed."
(save-excursion
(let* ((beg (progn (paredit-backward-up)
(forward-char)
(point)))
(end (1- (cljr--point-after 'paredit-forward-up)))
sexp-elems)
(while (/= (point) end)
(paredit-forward)
(let ((sexp-elem (buffer-substring-no-properties beg (point))))
(push (if with-whitespace sexp-elem (string-trim sexp-elem)) sexp-elems))
(setq beg (point)))
(nreverse sexp-elems))))
(defun cljr--extract-region (beg end)
(prog1
(buffer-substring-no-properties beg end)
(delete-region beg end)))
(defun cljr--comment-line-p ()
(save-excursion
(goto-char (line-beginning-position))
(looking-at "\\s-*;+")))
(defun cljr--search-forward-within-sexp (s &optional save-excursion regexp)
"Searches forward for S in the current sexp.
if SAVE-EXCURSION is T POINT does not move."
(let ((bound (save-excursion (forward-list 1) (point)))
(f (if regexp
're-search-forward
'search-forward)))
(if save-excursion
(save-excursion
(funcall f s bound t))
(funcall f s bound t))))
(defun cljr--goto-toplevel ()
(paredit-backward-up (cljr--depth-at-point))
(when (looking-back "#" 1)
(backward-char)))
(defun cljr--top-level-p ()
"T unless we're in an s-expression or string."
(= (cljr--depth-at-point) 0))
(defun cljr--depth-at-point ()
"Returns the depth in s-expressions, or strings, at point."
(let ((depth (car (paredit-current-parse-state))))
(if (paredit-in-string-p)
(1+ depth)
depth)))
(defun cljr--cleanup-whitespace (stuff)
"Removes blank lines preceding `stuff' as well as trailing whitespace."
(with-temp-buffer
(insert stuff)
(goto-char (point-min))
(delete-blank-lines)
(when (looking-at "[ \t]*$")
(delete-region (line-beginning-position) (line-end-position)))
(let ((delete-trailing-lines t))
(delete-trailing-whitespace)
(buffer-substring-no-properties (point-min) (point-max)))))
(defun cljr--delete-line ()
"Deletes the current line without introducing whitespace errors."
(delete-region (line-beginning-position) (line-end-position))
(join-line)
(paredit-forward-delete 1))
(defun cljr--looking-at-dependency-p ()
(or
;; boot & leiningen dependency vector
(looking-at "\\[[^[[:space:]]+[[:space:]]+\"")
;; clj dependency style
(looking-at "\\([a-z0-9\-\./]+\\)[[:space:]]*\{.*\\(:mvn\\|:local\\|:git\\)/\\(root\\|version\\|url\\)[[:space:]]+\\(\"[^\"]+\"\\)")))
(defun cljr--just-one-blank-line ()
"Ensure there's only one blank line at POINT."
(newline 2)
(forward-line -1)
(delete-blank-lines))
(defun cljr--point-after (&rest actions)
"Returns POINT after performing ACTIONS.
An action is either the symbol of a function or a two element
list of (fn args) to pass to `apply''"
(save-excursion
(dolist (fn-and-args actions)
(let ((f (if (listp fn-and-args) (car fn-and-args) fn-and-args))
(args (if (listp fn-and-args) (cdr fn-and-args) nil)))
(apply f args)))
(point)))
(defun cljr--whitespacep (s)
"True if S contains only whitespace."
(or (null s) (string-blank-p (string-trim s))))
(defun cljr--make-room-for-toplevel-form ()
(if (cljr--whitespacep (buffer-substring-no-properties (point) (point-max)))
;; make room at end of buffer
(progn (open-line 2)
(delete-blank-lines)
(open-line 1)
(forward-line))
(cljr--goto-toplevel)
(goto-char (line-beginning-position))
(open-line 2)))
(defun cljr--new-toplevel-form (form)
"Insert a new toplevel FORM before the form containing POINT."
(cljr--make-room-for-toplevel-form)
(insert form))
(defun cljr--goto-toplevel-forward ()
"Move forward and up until we reach toplevel."
(paredit-forward-up (cljr--depth-at-point)))
(defun cljr--indent-defun ()
"Indent the toplevel form containing point."
(indent-region (cljr--point-after 'cljr--goto-toplevel)
(cljr--point-after 'cljr--goto-toplevel-forward)))
(defun cljr--point-at-text-matching
(regexp direction &optional bound noerror count)
"Return the point after searching in DIRECTION for TEXT.
DIRECTION is either :forward or :backward.
the optional arguments are passed on the to search function. See
e.g. `re-search-forward'"
(save-excursion
(cond
;; NOTE: non-optional direction is intentional because I think it
;; improves readability greatly at the call site
((eq direction :forward)
(re-search-forward regexp bound noerror count))
((eq direction :backward)
(re-search-backward regexp bound noerror count))
(t (error "Only know how to search :forward or :backward, you asked for '%s'"
direction)))))
(defun cljr--inside-prefixed-libspec-vector-p ()
"If we're inside a prefixed libspec vector then point is assumed to be just inside the vector.
Note that this function also moves point from the suffix to the prefix."
(and (looking-back "\\[" 1)
(progn (paredit-backward-up 2)
(paredit-forward-down)
(looking-back "\\[" 1))))
(defun cljr--resolve-alias (alias)
"Look up ALIAS in the ns form.
if alias is util and the ns-from contains
(:require [refactor-nrepl [util s-expresions]])
refactor-nrepl.util will be returned."
(save-excursion
(cljr--goto-ns)
(when (re-search-forward
(format ":as\\(-alias\\)?\\s-*\n*\\s-*%s\\_>" (regexp-quote alias))
(cljr--point-after 'paredit-forward)
:noerror)
(paredit-backward-up)
(paredit-forward-down)
(let ((ns (buffer-substring-no-properties
(point)
(cljr--point-after 'paredit-forward))))
(if (cljr--inside-prefixed-libspec-vector-p)
(format "%s.%s" (buffer-substring-no-properties
(point) (cljr--point-after 'paredit-forward))
ns)
ns)))))
(defun cljr--point-for-anon-function ()
"Returns the location of point,
if the point is currently placed at the opening parentheses of an anonymous function."
(cond
((looking-at "(fn \\(\\_<[^ ]+\\_>[[:space:]\n]+\\)?\\[")
(point))
((save-excursion (backward-char) (looking-at "#("))
(1- (point)))))
(defun cljr--goto-fn-definition ()
(if (zerop (car (paredit-current-parse-state)))
(error "Not inside a s-expression")
(let* ((pt-orig (point))
(search-bound (cljr--point-after 'cljr--goto-toplevel))
found-fn-p)
(while (not found-fn-p)
(paredit-backward-up)
(if-let (fn-beg (cljr--point-for-anon-function))
(let ((fn-end (save-excursion (paredit-forward) (point))))
(when (and (< fn-beg pt-orig) (< pt-orig fn-end))
(setq found-fn-p t)
(when (looking-back "#" 1)
(backward-char))))
(when (<= (point) search-bound)
(error "Can't find definition of anonymous function")))))))
(defun cljr--evenp (n)
;; evenp lives in cl.el...
(zerop (mod n 2)))
(defun cljr--remove-tramp-prefix-from-msg (entry)
(let* ((k (car entry))
(v (cadr entry)))
(list k
(if (and (member k '("file" "dir" "path" "old-path" "new-path"))
(stringp v))
(if-let* ((p (cider-tramp-prefix)))
(string-remove-prefix p v)
v)
v))))
(defun cljr--create-msg (op &rest kvs)
"Create a msg for the middleware for OP and optionally include the kv pairs KVS.
All config settings are included in the created msg."
(cl-assert (cljr--evenp (length kvs)) nil "Can't create msg to send to the middleware.\
Received an uneven number of kv pairs: %s " kvs)
(apply #'list
"op" op
"prefix-rewriting"
(if cljr-favor-prefix-notation
"true"
"false")
"insert-newline-after-require"
(if cljr-insert-newline-after-require
"true"
"false")
"debug"
(if cljr--debug-mode
"true"
"false")
(seq-mapcat #'cljr--remove-tramp-prefix-from-msg
(seq-partition kvs 2))))
(defun cljr--post-command-message (format-string &rest args)
"Display msg in a post command hook, to ensure it doesn't drown in emacs' general chatter."
(push (apply #'format format-string args)
cljr--post-command-messages))
(defun cljr--post-command-hook ()
(seq-map #'message cljr--post-command-messages)
(setq cljr--post-command-messages nil))
(defun cljr-show-changelog ()
"Show the changelog for `clj-refactor'.
See: https://github.com/clojure-emacs/clj-refactor.el/wiki/cljr-show-changelog"
(interactive)
(find-file (format "%s/CHANGELOG.md" (file-name-directory (locate-library "clj-refactor"))))
(when (fboundp 'markdown-mode)
(markdown-mode))
(view-mode 1))
;; ------ reify protocol defrecord -----------
(defun cljr--goto-reify ()
(let ((point (point)))
(while (not (or (cljr--top-level-p)
(looking-at-p "(reify")))
(paredit-backward-up))
(unless (looking-at-p "(reify")
(goto-char point)
(error "Can't find call to reify"))))
(defun cljr-reify-to-defrecord ()
"Replace a call to reify with a call to a new constructor.
A new record is created to define this constructor."
(interactive "")
(cljr--goto-reify)
(let ((record-name (cljr--prompt-user-for "Name of new record: "))
(reify-sexp (clojure-delete-and-extract-sexp))
(placeholder "#85dffa31d"))
(insert placeholder)
(cljr--new-toplevel-form reify-sexp)
(paredit-backward)
(paredit-forward-down)
(clojure-delete-and-extract-sexp)
(insert "defrecord " record-name " []")
(if (looking-at-p "[ \t]*$")
(forward-line)
(newline-and-indent))
(cljr--goto-toplevel)
(indent-region (point) (cljr--point-after 'paredit-forward))
(re-search-forward placeholder)
(paredit-backward)
(clojure-delete-and-extract-sexp)
(insert "("record-name ".)")
(paredit-backward-down)))
;; ------ file -----------
(defun cljr--locate-project-file (file)
(ignore-errors
(file-truename
(locate-dominating-file default-directory file))))
(defun cljr--project-dir ()
(or
(thread-last '("project.clj" "build.boot" "deps.edn" "shadow-cljs.edn" "pom.xml")
(mapcar 'cljr--locate-project-file)
(delete 'nil)
car)
""))
(defun cljr--inside-project-p ()
"Return non-nil if `default-directory' is inside a Clojure project."
(not (string-empty-p (cljr--project-dir))))
(defun cljr--project-file ()
(let ((project-dir (cljr--project-dir)))
(or (let ((file (expand-file-name "project.clj" project-dir)))
(and (file-exists-p file) file))
(let ((file (expand-file-name "build.boot" project-dir)))
(and (file-exists-p file) file))
(let ((file (expand-file-name "deps.edn" project-dir)))
(and (file-exists-p file) file))
(let ((file (expand-file-name "shadow-cljs.edn" project-dir)))
(and (file-exists-p file) file))
(let ((file (expand-file-name "pom.xml" project-dir)))
(and (file-exists-p file) file)))))
(defun cljr--project-files ()
(split-string (shell-command-to-string
(format "find %s -type f \\( %s -or %s \\) %s | head -n %s"
(cljr--project-dir)
(format "-name \"%s\"" "*.clj")
(format "-name \"%s\"" "*.cljc")
"-not -regex \".*svn.*\""
1000))))
(defun cljr--project-with-deps-p (project-file)
(string-match "/deps.edn$" project-file))
(defun cljr--buffers-visiting-dir (dir)
(seq-filter (lambda (buf)
(when-let (path (buffer-file-name buf))
(string-prefix-p dir path :ignore-case)))
(buffer-list)))
(defun cljr--revisit-buffers (buffers new-dir active)
"After moving a directory revisit all files visited by BUFFERS by looking them up in NEW-DIR.
ACTIVE is the buffer the user was looking at when the command was issued, and should be left focused."
(let ((files (directory-files new-dir))
(new-dir (if (string-suffix-p "/" new-dir) new-dir (format "%s/" new-dir)))
(same-file (lambda (buf f)
(when (string= (file-name-nondirectory f)
(file-name-nondirectory (buffer-file-name buf)))
f))))
(dolist (buf buffers)
(find-file
(format "%s%s" new-dir (seq-some (apply-partially same-file buf) files)))
(kill-buffer buf))
(find-file (format "%s/%s" new-dir (seq-some (apply-partially same-file active) files)))))
(defcustom cljr-print-right-margin 72
"Will be forwarded to `clojure.pprint/*print-right-margin*' when refactor-nrepl pretty-prints ns forms,
as performed after `clean-ns', `rename-file-or-dir', etc.
You can set it to the string \"nil\" for disabling line wrapping.
See also: `cljr-print-miser-width'."
:type '(choice integer string)
:safe (lambda (s) (or (integerp s) (stringp s)))
:package-version "3.2.0")
(defcustom cljr-print-miser-width 40
"Will be forwarded to `clojure.pprint/*print-miser-width*' when refactor-nrepl pretty-prints ns forms,
as performed after `clean-ns', `rename-file-or-dir', etc.
You can set it to the string \"nil\" for disabling line wrapping.
See also: `cljr-print-right-margin'."
:type '(choice integer string)
:safe (lambda (s) (or (integerp s) (stringp s)))
:package-version "3.2.0")
;;;###autoload
(defun cljr-rename-file-or-dir (old-path new-path)
"Rename a file or directory of files.
Buffers visiting any affected file are killed and the
corresponding files are revisited.
See: https://github.com/clojure-emacs/clj-refactor.el/wiki/cljr-rename-file-or-dir"
(interactive
(let ((old (read-file-name "Old path: " nil nil 'mustmatch "")))
(list old
(if (file-directory-p old)
(read-directory-name "New path: " old)
(read-file-name "New path: "
(file-name-directory old)
nil nil
(file-name-nondirectory old))))))
(cljr--ensure-op-supported "rename-file-or-dir")
(when (cljr--asts-y-or-n-p)
(let* ((active-buffer (current-buffer))
(affected-buffers (when (file-directory-p old-path)
(cljr--buffers-visiting-dir old-path)))
(old-path (expand-file-name old-path))
(new-path (cljr--maybe-replace-dash-in-file-name (expand-file-name new-path)))
(nrepl-new-path (funcall cider-to-nrepl-filename-function new-path))
(nrepl-old-path (funcall cider-to-nrepl-filename-function old-path)))
(when (y-or-n-p (format "Really rename %s to %s?" old-path new-path))
(let* ((changed-files (cljr--call-middleware-sync
(cljr--create-msg "rename-file-or-dir"
"old-path" nrepl-old-path
"new-path" nrepl-new-path
"print-right-margin" cljr-print-right-margin
"print-miser-width" cljr-print-miser-width)
"touched"))
(changed-files-count (length changed-files)))
(cond
((null changed-files) (cljr--post-command-message "Rename complete! No files affected."))
((= changed-files-count 1) (cljr--post-command-message "Renamed %s to %s." old-path new-path))
(t (cljr--post-command-message "Rename complete! %s files affected." changed-files-count)))
(when (and (> changed-files-count 0) (not cljr-warn-on-eval))
(cljr--warm-ast-cache)))
(if affected-buffers
(cljr--revisit-buffers affected-buffers new-path active-buffer)
(kill-buffer active-buffer)
(find-file new-path))))))
;;;###autoload
(defun cljr-rename-file (new-path)
(interactive
(let ((old (buffer-file-name)))
(list (read-file-name "New path: "
(file-name-directory old)
nil nil
(file-name-nondirectory old)))))
(cljr-rename-file-or-dir (buffer-file-name) new-path))
(defun cljr--op-supported-p (op)
"Is the OP we require provided by the current middleware stack?"