-
Notifications
You must be signed in to change notification settings - Fork 6
/
filetree.el
2428 lines (2254 loc) · 104 KB
/
filetree.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
;;; filetree.el --- File tree view/manipulatation package -*- lexical-binding: t; -*-
;; Copyright (C) 2020 Ketan Patel
;;
;; Author: Ketan Patel <knpatel401@gmail.com>
;; URL: https://github.com/knpatel401/filetree
;; Package-Requires: ((dash "2.12.0") (helm "3.7.0")
;; (seq "2.23") (transient "0.3.6"))
;; Version: 1.1
;; 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 <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Filetree is a package that provides a set of interactive file management
;; tools. The core functionality is a file tree viewer which displays a
;; file list as a directory tree in a special buffer. There are numerous
;; interactive tools available to the user within this special buffer.
;; In addition to this file tree viewer functionality, there is also a
;; file note taking feature in the package. The file notes enable the user
;; to write and display (org-mode) notes associated with individual files
;; and directories. The note can be displayed in a side buffer either when
;; cycling through files in the file tree viewer or when the file is open
;; in a buffer.
;;
;; To use add the following to your ~/.emacs:
;; (require 'filetree')
;;
;; To bring up a menu from which you can select a source for the filetree
;; M-x filetree-load-cmd-menu
;;
;; Or use one of the following to run filetree for a common use case:
;; M-x filetree-show-recentf-files
;; M-x filetree-show-cur-dir
;; M-x filetree-show-cur-dir-recursively
;; M-x filetree-show-cur-buffers
;; M-x filetree-show-vc-dir-recursively
;;
;; Use the following command to pull up the help transient for available commands
;; M-x filetree-command-help
;;
;; -------------------------------------------
;;; Code:
(require 'dash)
(require 'xref)
(require 'helm)
(require 'seq)
;;(require 'vc)
;;(require 'dired-aux)
(require 'face-remap)
(require 'transient)
;;(require 'cl-lib)
;; External functions/variables
(declare-function org-narrow-to-subtree "org" ())
(declare-function all-the-icons-icon-for-dir "all-the-icons")
(declare-function all-the-icons-icon-for-file "all-the-icons")
(defvar recentf-list)
;;(defvar text-scale-mode-amount 0)
(defgroup filetree nil
"Tree view of file list and file notes."
:group 'files
:prefix "filetree-")
(defvar filetree-version "1.1")
(defconst filetree-buffer-name "*filetree*")
(defgroup filetree-files nil
"Filenames/paths for files used by filetree."
:group 'filetree)
(defcustom filetree-notes-file (concat user-emacs-directory
"filetree-notes.org")
"File used for file specific notes."
:group 'filetree-files
:type 'file)
(defcustom filetree-relative-notes-filename "filetree-notes-local.org"
"Filename for file specific notes file with relative path."
:group 'filetree-files
:type 'string)
(defcustom filetree-saved-lists-file (concat user-emacs-directory
"filetree-saved-lists.el")
"File used for saved file lists."
:group 'filetree-files
:type 'file)
(defgroup filetree-startup-prefs nil
"Filetree preferences for initial state."
:group 'filetree)
(defcustom filetree-use-all-the-icons nil
"Set to t to use file and directory icons.
This can also be toggled using `filetree-toggle-use-all-icons'."
:group 'filetree-startup-prefs
:type 'boolean)
(defcustom filetree-info-window nil
"Set to t to show info in side window.
This can also be toggled using `filetree-toggle-info-buffer'."
:group 'filetree-startup-prefs
:type 'boolean)
(defcustom filetree-preview-window nil
"Set to t to show preview in side window.
This can also be toggled using `filetree-toggle-preview-buffer'."
:group 'filetree-startup-prefs
:type 'boolean)
(defcustom filetree-show-remote-file-info nil
"Set to t to show additional file info for remote files as well."
:group 'filetree-startup-prefs
:type 'boolean)
(defgroup filetree-configurations nil
"Filetree configurations."
:group 'filetree)
(defcustom filetree-enable-nonexistent-file-removal t
"Set to t to check for and remove non-existent files during filetree updates."
:group 'filetree-configurations
:type 'boolean)
(defcustom filetree-exclude-list
'("~$" "#$" ".git\/" ".gitignore$" "\/\.\/$" "\/\.\.\/$" ".DS_Store$")
"List of regex for files to exclude from file list."
:group 'filetree-configurations
:type '(repeat regexp))
(defcustom filetree-helm-candidate-number-limit 10000
"Maximum number of candidates to show in tree when using helm-based filtering."
:group 'filetree-configurations
:type 'integer)
(defcustom filetree-preview-file-size-limit 10000000
"File size limit for preview."
:group 'filetree-configurations
:type 'integer)
(defcustom filetree-info-cycle-list
'(;; cycle 0 - no info
()
;; cycle 1 - modes/size/last mod
(("Modes" 11 filetree-get-file-modes "right")
("Size" 7 filetree-get-file-size "right")
("Last Mod" 12 filetree-get-file-last-modified "left"))
;; cycle 2 - size/last mod
(("Size" 7 filetree-get-file-size "right")
("Last Mod" 12 filetree-get-file-last-modified "left"))
;; cycle 3 - last mod
(("Last Mod" 12 filetree-get-file-last-modified "left"))
;; cycle 4 - last mod/modes
(("Last Mod" 12 filetree-get-file-last-modified "left")
("Modes" 11 filetree-get-file-modes "right"))
;; cycle 5 - last mod/modes/size
(("Last Mod" 12 filetree-get-file-last-modified "left")
("Modes" 11 filetree-get-file-modes "right")
("Size" 7 filetree-get-file-size "right")))
"List of file info contents to show on left side of filetree window.
Each entry of this list is itself a list of the columns of information
to show. A nil entry corresponds to showing no info. Each entry of this
list has the following entries:
- column heading (this can be propertized if desired)
- width of the column
- function that take a file as argument and returns a (possibly propertized)
string to show
- string with justification to use for the column contents
(left, right, center), default is left."
:group 'filetree-configurations
:type '(repeat (repeat :tag "View Set"
(list :tag "Column"
(string :tag "Heading")
(integer :tag "Column Width")
function
(choice :tag "Column Justification"
(const "left")
(const "right")
(const "center"))))))
(defcustom filetree-filetype-list
'(;;(" " "No Filter" "" "default")
("p" "Python" "\.py$" "filetree-python-face")
("o" "Org-mode" "\.org$" "filetree-org-mode-face")
("e" "elisp" "\\(?:\\.e\\(?:l\\|macs\\)\\)" "filetree-elisp-face")
("c" "C" "\\(?:\\.[ch]$\\|\\.cpp\\)" "filetree-C-face")
("d" "PDF" "\.pdf$" "filetree-pdf-face")
("m" "Matlab" "\.m$" "filetree-matlab-face")
("t" "Text" "\.txt$" "filetree-text-mode-face"))
"List of file types used for regex filt/expans & for syntax highlighting.
Each entry of this list is itself a list with the following entries:
- shortcut key or key sequence
- label for filetype
- regex for filetype
syntax highlighting to use for filetype"
:group 'filetree-configurations
:type '(repeat
(list :tag "Filetype"
(string :tag "shortcut")
(string :tag "Filetype label")
(regexp :tag "Regexp")
(face :tag "Face"))))
(defcustom filetree-custom-filelist-operations
'(("ss" "Sort by File size" filetree-sort-by-file-size)
("sd" "Sort by Last Mod Date" filetree-sort-by-last-modified)
("sr" "Reverse list" reverse))
"List of custom operations acting on file list.
Each entry has:
- keyboard shortcut under the filter menu
- label string
- function taking a file list as input and returning updated file list"
:group 'filetree-configurations
:type '(repeat
(list :tag "Operation"
(string :tag "shortcut")
(string :tag "Label")
function)))
(defcustom filetree-custom-single-operations
'(("d" "open dired on dir at point" dired)
("e" "open eshell in dir at point" filetree-run-eshell)
("ms" "magit-status on repo at point" filetree-run-magit-status)
("n" "Create file note from file at point" filetree-create-note))
"List of custom operations acting on file/dir at point.
Each entry has:
- keyboard shortcut under the file operation menu
- label string
- function taking a file/dir as input"
:group 'filetree-configurations
:type '(repeat
(list :tag "Operation"
(string :tag "shortcut")
(string :tag "Label")
function)))
(defcustom filetree-custom-marked-file-operations
'(("!" "Shell cmd on marked" filetree-do-shell-command-on-files)
("t" "file contents->buffer" filetree-contents-to-buffer))
"List of custom operations acting on marked files.
Each entry has:
- keyboard shortcut under the mark command menu
- label string
- function taking a file list as input"
:group 'filetree-configurations
:type '(repeat
(list :tag "Operation"
(string :tag "shortcut")
(string :tag "Label")
function)))
(defgroup filetree-symb-for nil
"Symbols used for drawing tree in filetree package."
:group 'filetree
:prefix "filetree-symb-for-")
(defcustom filetree-symb-for-root "\u25ba"
"Symbol for end of mark indicating root dir."
:type 'character
:group 'filetree-symb-for)
(defcustom filetree-symb-for-box "\u25a0"
"Box symbol used in mark for root dir."
:type 'character
:group 'filetree-symb-for)
(defcustom filetree-symb-for-vertical-pipe "\u2502"
"Symbol to indicate continuing branch."
:type 'character
:group 'filetree-symb-for)
(defcustom filetree-symb-for-horizontal-pipe "\u2500"
"Symbol for branch for node on current line."
:type 'character
:group 'filetree-symb-for)
(defcustom filetree-symb-for-left-elbow "\u2514"
"Symbol for last node on branch."
:type 'character
:group 'filetree-symb-for)
(defcustom filetree-symb-for-right-elbow "\u2518"
"Symbol for bottom right hand corner."
:type 'character
:group 'filetree-symb-for)
(defcustom filetree-symb-for-branch-and-cont "\u251c"
"Symbol indicating continuing branch which also includes node on current line."
:type 'character
:group 'filetree-symb-for)
(defcustom filetree-symb-for-file-node "\u25cf"
"Symbol for file node."
:type 'character
:group 'filetree-symb-for)
(defcustom filetree-symb-for-mark (propertize "\u25b6"
'font-lock-face
'(:foreground "DarkOliveGreen4"))
"Symbol for marking files."
:type 'character
:group 'filetree-symb-for)
;; Faces for filetypes
;; -------------------
(defgroup filetree-faces nil
"Faces used in filetree package."
:group 'filetree)
(defcustom filetree-default-file-face 'default
"Default face to use for files.
This is used if the file doesn't match any regex in `filetree-filetype-list'."
:group 'filetree-faces
:type 'face)
(defface filetree-menu-heading-face
'((((background dark)) (:foreground "steel blue"
:underline t
:weight bold
:height 1.2))
(t (:foreground "steel blue"
:underline t
:weight bold
:height 1.2)))
"Face used for help menu headings in filetree."
:group 'filetree-faces)
(defface filetree-menu-comment-face
'((((supports :slant italic))
:slant italic)
(((supports :underline t))
:underline t)
(t
;; Default to italic, even if it doesn't appear to be supported,
;; because in some cases the display engine will do its own
;; workaround (to `dim' on ttys).
:slant italic))
"Basic italic face."
:group 'filetree-faces)
;;(defface filetree-menu-heading-face
;; '(:foreground "steel blue" :underline t :weight bold :height 1.2)
;; "Face used for help menu headings in filetree."
;; :group 'filetree)
(defface filetree-python-face
'((((background dark)) (:foreground "steel blue"))
(t (:foreground "steel blue")))
"*Face used for python files in filetree."
:group 'filetree-faces)
(defface filetree-org-mode-face
'((((background dark)) (:foreground "DarkOliveGreen4"))
(t (:foreground "DarkOliveGreen4")))
"*Face used for org-mode files in filetree."
:group 'filetree-faces)
(defface filetree-elisp-face
'((((background dark)) (:foreground "purple1"))
(t (:foreground "purple1")))
"*Face used for elisp files in filetree."
:group 'filetree-faces)
(defface filetree-C-face
'((((background dark)) (:foreground "DeepSkyBlue1"))
(t (:foreground "DeepSkyBlue1")))
"*Face used for C files in filetree."
:group 'filetree-faces)
(defface filetree-pdf-face
'((((background dark)) (:foreground "orange red"))
(t (:foreground "orange red")))
"*Face used for pdf files in filetree."
:group 'filetree-faces)
(defface filetree-matlab-face
'((((background dark)) (:foreground "orange"))
(t (:foreground "orange")))
"*Face used for matlab files in filetree."
:group 'filetree-faces)
(defface filetree-text-mode-face
'((((background dark)) (:foreground "gray50"))
(t (:foreground "gray50")))
"*Face used for text files in filetree."
:group 'filetree-faces)
;; variables
;; ---------
(defvar filetree-info-buffer nil)
(defvar filetree-info-buffer-state nil)
(defvar filetree-preview-buffer nil)
(defvar filetree-saved-lists '(("recentf" (lambda ()
recentf-list))))
(if (file-exists-p filetree-saved-lists-file)
(with-temp-buffer
(insert-file-contents filetree-saved-lists-file)
(eval-buffer)))
(defvar filetree-start-position 0)
(defvar filetree-max-depth 0)
(defvar filetree-overall-depth nil)
(defvar filetree-current-file-list nil)
(defvar filetree-file-list-stack nil)
(defvar filetree-file-list-stack-save nil)
(defvar filetree-marked-file-list nil)
(defvar filetree-show-flat-list nil)
(defvar filetree-combine-dir-names t)
(defvar filetree-helm-source
'((name . "filetree")
(candidates . filetree-current-file-list)
(candidate-number-limit . filetree-helm-candidate-number-limit)
(cleanup . (lambda ()
(remove-hook 'helm-after-update-hook
#'filetree-helm-hook)
(setq filetree-file-list-stack filetree-file-list-stack-save)
(filetree-update-buffer)))
(buffer . ("*helm-filetree-buffer*"))
(prompt . ("selection:"))))
(defvar filetree-current-info-cycle 0
"This tracks the current state of file info on the left side of the window.")
(defvar filetree-mode-map
(let ((map (make-sparse-keymap)))
;; transient menus
(define-key map "h" 'filetree-command-help)
(define-key map "v" 'filetree-view-mode-menu)
(define-key map "l" 'filetree-load-cmd-menu)
(define-key map "o" 'filetree-file-ops-menu)
(define-key map "m" 'filetree-mark-cmd-menu)
(define-key map "f" 'filetree-filter)
(define-key map "e" 'filetree-expand)
(define-key map "E" 'filetree-expand-recursively)
;; navigation
(define-key map "j" 'filetree-next-line)
(define-key map "k" 'filetree-prev-line)
(define-key map (kbd "<down>") 'filetree-next-line)
(define-key map (kbd "<up>") 'filetree-prev-line)
(define-key map (kbd "SPC") 'filetree-next-branch)
(define-key map (kbd "TAB") 'filetree-prev-branch)
;; basic commands
(define-key map "q" 'filetree-close-session)
(define-key map "x" 'filetree-remove-item)
(define-key map (kbd "<RET>") 'filetree-open-or-narrow)
;; (define-key map (kbd "C-<RET>") 'filetree-open-in-other-window)
;; stack operations
(define-key map "b" 'filetree-pop-file-list-stack)
(define-key map "-" 'filetree-diff-with-file-list-stack)
(define-key map "+" 'filetree-union-with-file-list-stack)
;; legacy key bindings
;; keeping some common key bindings for now to prevent disruption
;; but will probably remove in the future
(define-key map "i" 'filetree-toggle-info-buffer)
(define-key map "I" (lambda ()
"Toggle filetree-info-buffer and switch to it if active"
(interactive)
(filetree-toggle-info-buffer t)))
(define-key map "0" 'filetree-set-max-depth)
(define-key map "1" 'filetree-set-max-depth-1)
(define-key map "2" 'filetree-set-max-depth-2)
(define-key map "3" 'filetree-set-max-depth-3)
(define-key map "4" 'filetree-set-max-depth-4)
(define-key map "5" 'filetree-set-max-depth-5)
(define-key map "6" 'filetree-set-max-depth-6)
(define-key map "7" 'filetree-set-max-depth-7)
(define-key map "8" 'filetree-set-max-depth-8)
(define-key map "9" 'filetree-set-max-depth-9)
;; (define-key map "r" 'filetree-show-recentf-files)
(define-key map "/" 'filetree-toggle-combine-dir-names)
(define-key map "g" 'filetree-grep-marked-files)
;; (define-key map "C" 'filetree-copy-marked-files-only)
;; (define-key map "R" 'filetree-move-marked-files-only)
;; (define-key map "d" 'filetree-run-dired)
;; comment out legacy file marking and file list loading key bindings
;; (define-key map "o" 'filetree-open-marked-files)
;; (define-key map "K" 'filetree-kill-marked-buffers)
;; (define-key map "m" 'filetree-mark-item)
;; (define-key map "A" 'filetree-mark-all)
;; (define-key map "M" 'filetree-select-marked-items)
;; (define-key map "!" 'filetree-do-shell-command-on-marked-files-only)
;; (define-key map "c" 'filetree-clear-marks)
;; (define-key map "L" 'filetree-select-file-list)
;; (define-key map "S" 'filetree-save-list)
;; (define-key map "D" 'filetree-delete-list)
(define-key map "." 'filetree-toggle-flat-vs-tree)
(define-key map "s" 'filetree-helm-filter)
(define-key map ";" 'filetree-toggle-use-all-icons)
(define-key map "]" 'filetree-increment-current-info-cycle)
(define-key map "[" 'filetree-decrement-current-info-cycle)
map)
"Keymap for filetree.")
;; transient menus
;; ---------------
(transient-define-prefix filetree-command-help ()
"Filetree Help"
[:description (lambda ()
(filetree--transient-heading "Filetree Help Main Menu"
"Filetree keybinding help menu."))
[:description (lambda ()
(concat (propertize
"Sub-menu prefixes"
'face 'transient-heading)))
:pad-keys ""
:setup-children filetree--submenu-setup-children]]
[["Basic Actions" :pad-keys ""
:setup-children filetree--basic-cmd-menu-setup-children]
["Navigation" :pad-keys ""
:setup-children filetree--navigation-menu-setup-children]
["Stack Commands" :pad-keys ""
:setup-children filetree--stack-menu-setup-children]])
(defun filetree--submenu-setup-children (_)
"Setup submenu selections."
(mapcar (lambda (x)
(car
(transient--parse-child
'filetree-command-help
(append (list (car (where-is-internal
(if (car x)
(car x)
(nth 2 x))
filetree-mode-map)))
(cdr x)))))
'((nil "View modes - commands to change view" filetree-view-mode-menu)
(nil "Load cmds - commands to load filetree from different sources"
filetree-load-cmd-menu)
(nil "Simple ops - commands acting on file/dir at point"
filetree-file-ops-menu)
(nil "Mark cmds - commands related to marking files" filetree-mark-cmd-menu)
(nil "Filter/sort cmds - commands for filtering or sorting file list"
filetree-filter)
(nil "Expand dir - commands for adding files to file list"
filetree-expand)
(nil "Expand dir recursively"
filetree-expand-recursively)
(filetree-command-help "Exit help" transient-quit-all))))
(defun filetree--transient-heading (title comment)
"Help function for transient TITLE and COMMENT."
(concat (propertize title 'face 'filetree-menu-heading-face)
" (C-g to exit)\n"
(propertize comment 'face 'filetree-menu-comment-face)
"\n"))
(defun filetree--setup-children (child-list)
"Helper function to generate setup-children function for transient.
CHILD-LIST is a list of children to show in the transient menu. Each
entry of the list has the following:
- Label to show
- function to call
- any additional entries to send to transient--parse-child."
(mapcar (lambda (x)
(car
(transient--parse-child
'filetree-load-cmd-menu
(append (list (car (where-is-internal (nth 1 x) filetree-mode-map)))
x))))
child-list))
(defun filetree--navigation-menu-setup-children (_)
"Helper function to generate setup-children for navigation menu."
(filetree--setup-children '(("Down" filetree-next-line :transient t)
("Up" filetree-prev-line :transient t)
("Next branch" filetree-next-branch :transient t)
("Prev branch" filetree-prev-branch :transient t))))
(defun filetree--stack-menu-setup-children (_)
"Helper function to generate setup-children for stack menu."
(filetree--setup-children '(("Back (pop stack)" filetree-pop-file-list-stack
:transient t)
("Diff with stack" filetree-diff-with-file-list-stack
:transient t)
("Union with stack" filetree-union-with-file-list-stack
:transient t))))
(defun filetree--basic-cmd-menu-setup-children (_)
"Helper function to generate setup-children for basic cmds."
(append
(filetree--setup-children '(("Quit filetree" filetree-close-session)
("Remove item" filetree-remove-item :transient t)))
;; ("Open in other win" filetree-open-in-other-window :transient t)))
;; special handling because if point on file,
;; :transient should be nil and for dir :transient should be t
(transient--parse-child
'filetree-command-help
'("<RET>" "open/narrow" filetree-open-or-narrow :transient t))))
(transient-define-prefix filetree-view-mode-menu ()
"Transient for view modes"
[:description (lambda ()
(filetree--transient-heading "Filetree View Modes Menu"
"Commands to change the view mode."))
["View mode toggles"
("/" "Toggle Combine Dirname" filetree-toggle-combine-dir-names)
("." "Toggle tree/flat view" filetree-toggle-flat-vs-tree)
("i" "Toggle info buffer" filetree-toggle-info-buffer)
("p" "Toggle preview buffer" filetree-toggle-preview-buffer)
(";" "Toggle icons" filetree-toggle-use-all-icons)]
["Extra info controls"
("]" "Cycle+ extra info" filetree-increment-current-info-cycle)
("[" "Cycle- extra info" filetree-decrement-current-info-cycle)]
["Depth controls"
("0" "Full depth" filetree-set-max-depth)
("1" "Depth 1" filetree-set-max-depth-1)
("2" "Depth 2" filetree-set-max-depth-2)
("3" "Depth 3" filetree-set-max-depth-3)
("4" "Depth 4" filetree-set-max-depth-4)]
[""
("5" "Depth 5" filetree-set-max-depth-5)
("6" "Depth 6" filetree-set-max-depth-6)
("7" "Depth 7" filetree-set-max-depth-7)
("8" "Depth 8" filetree-set-max-depth-8)
("9" "Depth 9" filetree-set-max-depth-9)]]
[["Basic Actions" :pad-keys ""
:setup-children filetree--basic-cmd-menu-setup-children]
["Navigation" :pad-keys ""
:setup-children filetree--navigation-menu-setup-children]])
(defun filetree-filter-by-regex (&optional regex)
"Filter `filetree-current-file-list' by REGEX and update filetree."
(let ((regex (or regex
(read-string "Type a regex: "))))
(setq filetree-current-file-list
(delete nil (mapcar (lambda (x)
(if (string-match regex
(file-name-nondirectory x))
x nil))
filetree-current-file-list))))
(filetree-update-buffer))
;; wrapper function
(defun filetree-filter-by-regex-custom ()
"Filter `filetree-current-file-list' by user-defined regex and update filetree."
(interactive)
(filetree-filter-by-regex))
(transient-define-prefix filetree-filter ()
"Filter by regex commands"
[:description (lambda ()
(filetree--transient-heading "Filetree Filter Menu"
"Commands to filter the filetree list."))
["Regex filters"
:setup-children filetree--filter-regex-setup-children]
[""
("<RET>" "Custom" filetree-filter-by-regex-custom)]
["Other Filters"
("H" "Helm-based filter" filetree-helm-filter)]
["Custom functions"
:setup-children filetree--filter-custom-setup-children]]
[["Navigation" :pad-keys ""
:setup-children filetree--navigation-menu-setup-children]
["Stack Commands" :pad-keys ""
:setup-children filetree--stack-menu-setup-children]])
(defun filetree--filter-regex-setup-children (_)
"Setup regex filter functions."
(mapcar (lambda (x)
(car
(transient--parse-child
'filetree-filter
(list (car x)
(nth 1 x)
(lambda ()
(interactive)
(filetree-filter-by-regex (nth 2 x)))))))
filetree-filetype-list))
(defun filetree--filter-custom-setup-children (_)
"Setup custom filter functions."
(mapcar (lambda (x)
(car
(transient--parse-child
'filetree-filter
(list (car x)
(nth 1 x)
(lambda ()
(interactive)
(filetree--run-custom-function (nth 2 x)))))))
filetree-custom-filelist-operations))
(defun filetree-expand-dir (&optional dir regex recursive)
"Add files in DIR to `filetree-current-file-list'.
If DIR is not specified, use dir at point.
Only files matching regular expression REGEX are included.
If REGEX is not specified prompt user for regular expression.
If RECURSIVE is non-nil expand recursively."
(let ((dir (or dir (filetree-get-name)))
(regex (or regex
(read-string "Type a regex: ")))
(filetree-new-files nil))
;; search for relevant files
(setq filetree-new-files (if recursive
(directory-files-recursively dir regex nil t)
(delete nil (mapcar (lambda (x)
(if (string-match
regex
(file-name-nondirectory (car x)))
(if (null (nth 1 x))
(car x)
nil)))
(directory-files-and-attributes dir t)))))
;; (directory-files dir t regex)))
;; remove excluded files
(dolist (entry filetree-exclude-list)
(setq filetree-new-files (delete nil (mapcar (lambda (x)
(if (string-match
entry
x)
nil
x))
filetree-new-files))))
;; filter out duplicates
(setq filetree-current-file-list
(-distinct (-non-nil
(nconc filetree-current-file-list
filetree-new-files)))))
(filetree-update-buffer))
;; wrapper function
(defun filetree-expand-dir-custom ()
"Add files in dir at point to `filetree-current-file-list'.
Prompt user for regular expression."
(interactive)
(filetree-expand-dir nil nil))
(transient-define-prefix filetree-expand ()
"Expand/Add to file list"
[:description (lambda ()
(filetree--transient-heading "Filetree Expand Menu"
"Commands to expand the filetree list."))
["Regex filters"
:setup-children filetree--expand-setup-children]
[""
("<RET>" "Custom" filetree-expand-dir-custom)]]
[["Navigation" :pad-keys ""
:setup-children filetree--navigation-menu-setup-children]
["Stack Commands" :pad-keys ""
:setup-children filetree--stack-menu-setup-children]])
(defun filetree--expand-setup-children (_)
"Setup regex expansion functions."
(mapcar (lambda (x)
(car
(transient--parse-child
'filetree-expand
(list (car x)
(nth 1 x)
(lambda ()
(interactive)
(filetree-expand-dir nil (nth 2 x)))))))
filetree-filetype-list))
;; wrapper function
(defun filetree-expand-dir-recursive-custom ()
"Add files recursively in dir at point to `filetree-current-file-list'.
Prompt user for regular expression."
(interactive)
(filetree-expand-dir nil nil t))
(transient-define-prefix filetree-expand-recursively ()
"Expand/Add to file list recursively.
TODO: combine with filetree-expand."
[:description (lambda ()
(filetree--transient-heading "Filetree Expand Recursively Menu"
"Commands to expand the filetree list."))
["Regex filters"
:setup-children filetree--expand-recursive-setup-children]
[""
("<RET>" "Custom" filetree-expand-dir-recursive-custom)]]
[["Navigation" :pad-keys ""
:setup-children filetree--navigation-menu-setup-children]
["Stack Commands" :pad-keys
""
:setup-children filetree--stack-menu-setup-children]])
(defun filetree--expand-recursive-setup-children (_)
"TODO: combine with filetree--expand-setup-children."
(mapcar (lambda (x)
(car
(transient--parse-child
'filetree-expand-recursively
(list (car x)
(nth 1 x)
(lambda ()
(interactive)
(filetree-expand-dir nil (nth 2 x) t))))))
filetree-filetype-list))
(transient-define-prefix filetree-load-cmd-menu ()
"Transient for show commands."
[:description (lambda ()
(filetree--transient-heading "Filetree Load Command Menu"
"Commands to load file list from different sources."))
["Load commands"
("r" "Recent files filetree-show-recentf-files" filetree-show-recentf-files)
("c" "Current Dir filetree-show-cur-dir" filetree-show-cur-dir)
("C" "Current Dir recurs filetree-show-cur-dir-recursively" filetree-show-cur-dir-recursively)
("B" "Current Buffers filetree-show-cur-buffers" filetree-show-cur-buffers)
("v" "VC Root Dir filetree-show-vc-root-dir-recursively" filetree-show-vc-root-dir-recursively)
("n" "Files with Notes filetree-show-files-with-notes" filetree-show-files-with-notes)]
["Saved File List"
("L" "Load saved file list" filetree-select-file-list)
("S" "Save new file list" filetree-save-list)
("D" "Delete file list" filetree-delete-list)]]
[["Basic Actions" :pad-keys ""
:setup-children filetree--basic-cmd-menu-setup-children]
["Navigation" :pad-keys ""
:setup-children filetree--navigation-menu-setup-children]
["Stack Commands" :pad-keys ""
:setup-children filetree--stack-menu-setup-children]])
(defun filetree--ops-custom-setup-children (_)
"Setup custom filter functions."
(mapcar (lambda (x)
(car
(transient--parse-child
'filetree-file-ops-menu
(list (car x)
(nth 1 x)
(lambda ()
(interactive)
(filetree--run-custom-single-op (nth 2 x)))))))
filetree-custom-single-operations))
(transient-define-prefix filetree-file-ops-menu ()
"Transient for operations on file/dir at point."
[:description (lambda ()
(filetree--transient-heading "Filetree File Operations Menu"
"Commands acting on file/dir at point."))
["Operations" :pad-keys
""
:setup-children filetree--ops-custom-setup-children]]
[["Basic Actions" :pad-keys ""
:setup-children filetree--basic-cmd-menu-setup-children]
["Navigation" :pad-keys ""
:setup-children filetree--navigation-menu-setup-children]
["Stack Commands" :pad-keys ""
:setup-children filetree--stack-menu-setup-children]])
(defun filetree--marked-ops-custom-setup-children (_)
"Setup custom filter functions."
(mapcar (lambda (x)
(car
(transient--parse-child
'filetree-file-ops-menu
(list (car x)
(nth 1 x)
(lambda ()
(interactive)
(funcall (nth 2 x) filetree-marked-file-list))))))
filetree-custom-marked-file-operations))
(transient-define-prefix filetree-mark-cmd-menu ()
"Transient for mark commands"
[:description (lambda ()
(filetree--transient-heading "Filetree Mark Command Menu"
"Commands to mark files and perform operations on marked files."))
["Mark Commands"
"(menu persistent)"
("m" "Mark item" filetree-mark-item :transient t)
("A" "Mark all" filetree-mark-all :transient t)
("c" "Clear marks" filetree-clear-marks :transient t)]
["Basic Ops"
("M" "Keep only marked" filetree-select-marked-items)
("g" "Grep marked files" filetree-grep-marked-files)
("K" "Kill marked buffers" filetree-kill-marked-buffers)]
["File Manager Ops"
("C" "Copy marked files" filetree-copy-marked-files-only)
("R" "Move marked files" filetree-move-marked-files-only)
("o" "Open marked files" filetree-open-marked-files)
("D" "Delete marked files" filetree-delete-marked-files-only)]
["Custom Ops" :pad-keys ""
:setup-children filetree--marked-ops-custom-setup-children]]
[["Basic Actions" :pad-keys ""
:setup-children filetree--basic-cmd-menu-setup-children]
["Navigation" :pad-keys ""
:setup-children filetree--navigation-menu-setup-children]])
;; functions
(defun filetree-close-session ()
"Close filetree session."
(interactive)
(filetree-close-preview-buffer)
(filetree-close-info-buffer)
(filetree-buffer-check)
(kill-buffer (current-buffer)))
(defun filetree-buffer-check ()
"Check if buffer is `filetree-buffer-name'.
If not, then give error message and throw exception."
(interactive)
(if (not (equal (buffer-name)
filetree-buffer-name))
(error (concat "Error: Must be in buffer "
filetree-buffer-name
" to run command."))))
(defun filetree-get-file-size (filename)
"Return a string with the size of FILENAME."
(if (or filetree-show-remote-file-info
(not (file-remote-p filename)))
(let ((attributes (file-attributes filename)))
(if attributes
(format "%s"
(file-size-human-readable
(file-attribute-size attributes)))
"N/A"))
"remote"))
(defun filetree-get-file-modes (filename)
"Return a string with the file modes of FILENAME."
(if (or filetree-show-remote-file-info
(not (file-remote-p filename)))
(let ((attributes (file-attributes filename)))
(if attributes
(let ((modes (file-attribute-modes attributes)))
(if (string-prefix-p "d" modes)
(propertize modes 'font-lock-face 'bold)
modes))
"N/A "))
"remote "))
(defun filetree-get-file-last-modified (filename)
"Return a string with the last modification time for FILENAME."
(if (or filetree-show-remote-file-info
(not (file-remote-p filename)))
(let ((attributes (file-attributes filename)))
(if attributes
(format-time-string "%b %d %Y"
(file-attribute-modification-time attributes))
" N/A"))
" remote"))
(defun filetree-get-git-status (filename)
"Return a string with git status for FILENAME."
(if (or filetree-show-remote-file-info
(not (file-remote-p filename)))
(let ((attributes (file-attributes filename))
(default-directory (file-name-directory filename))
(tracked ""))
(if (string-prefix-p "d" (file-attribute-modes attributes))
""
(setq tracked (ignore-errors
(process-lines "git" "ls-files" "--error-unmatch"
(file-name-nondirectory filename))))
(if tracked
(let ((file-state (ignore-errors
(process-lines "git" "status" "--porcelain" "--ignored"
(file-name-nondirectory filename)))))
(if file-state
(let ((file-state-summary (car (split-string (car file-state)))))
(if (string-equal file-state-summary "M")
(let ((diff-state (ignore-errors
(process-lines "git" "diff" "--name-only" "--staged"
(file-name-nondirectory filename)))))
(if diff-state
;; staged
(propertize "\u25cb"
'font-lock-face '(:foreground "green")
'help-echo "Staged")
;; modified
(propertize "\u25cf"
'font-lock-face '(:foreground "blue")
'help-echo "Modified")))
file-state-summary))
;; up-to-date
(propertize "\u25cf"
'font-lock-face '(:foreground "green")
'help-echo "Up-to-date")))
;; untracked
(propertize "\u2349"
'font-lock-face '(:foreground "gray")
'help-echo "Untracked"))))
"remote"))
(defun filetree--run-custom-function (func)
"Update `filetree-current-file-list' from function FUNC and update filetree.
The function FUNC should take the current file list as input and output the
updated file list."
(setq filetree-current-file-list
(funcall func filetree-current-file-list))
(filetree-update-buffer))
(defun filetree-sort-by-file-size (input-file-list)
"Sort INPUT-FILE-LIST by file size."
(interactive)
(let ((sort-function (lambda (filename1 filename2)
(if (or filetree-show-remote-file-info
(and (not (file-remote-p filename1))
(not (file-remote-p filename2))))
(let ((attributes1 (file-attribute-size
(file-attributes filename1)))
(attributes2 (file-attribute-size
(file-attributes filename2))))
(if (> attributes1 attributes2)
t nil))
;; if both remote return alphabetical order