-
Notifications
You must be signed in to change notification settings - Fork 15
/
Copy pathcounsel-etags.el
1913 lines (1702 loc) · 73.1 KB
/
counsel-etags.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
;;; counsel-etags.el --- Fast and complete Ctags/Etags solution using ivy -*- lexical-binding: t -*-
;; Copyright (C) 2018-2021 Chen Bin
;; Author: Chen Bin <chenbin dot sh AT gmail dot com>
;; URL: http://github.com/redguardtoo/counsel-etags
;; Package-Requires: ((emacs "26.1") (counsel "0.13.4"))
;; Keywords: tools, convenience
;; Version: 1.10.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/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; Configuration,
;;
;; "Ctags" (Universal Ctags is recommended) should exist.
;; Or else, customize `counsel-etags-update-tags-backend' to generate tags file.
;; Please note etags bundled with Emacs is not supported any more.
;;
;; Usage,
;;
;; `counsel-etags-find-tag-at-point' to navigate. This command will also
;; run `counsel-etags-scan-code' AUTOMATICALLY if tags file does not exist.
;; It also calls `counsel-etags-fallback-grep-function' if not tag is found.
;;
;; Use `counsel-etags-imenu-excluded-names' to exclude tags by name.
;; Use `counsel-etags-imenu-excluded-types' to exclude tags by type
;;
;; `counsel-etags-scan-code' to create tags file
;; `counsel-etags-grep' to grep
;; `counsel-etags-grep-extra-arguments' has extra arguments for grep
;; `counsel-etags-grep-current-directory' to grep in current directory
;; `counsel-etags-recent-tag' to open recent tag
;; `counsel-etags-find-tag' to two steps tag matching use regular expression and filter
;; `counsel-etags-list-tag' to list all tags
;; `counsel-etags-update-tags-force' to update current tags file by force
;; `counsel-etags-ignore-config-file' specifies paths of ignore configuration files
;; (".gitignore", ".hgignore", etc). Path is either absolute or relative to the tags file.
;; `counsel-etags-universal-ctags-p' to detect if Universal Ctags is used.
;; `counsel-etags-exuberant-ctags-p' to detect if Exuberant Ctags is used.
;; See documentation of `counsel-etags-use-ripgrep-force' on using ripgrep.
;; If it's not set, correct grep program is automatically detected.
;;
;; Tips,
;; - Use `pop-tag-mark' to jump back.
;;
;; - The grep program path on Native Windows Emacs uses either forward slash or
;; backward slash. Like "C:/rg.exe" or "C:\\\\rg.exe".
;; If grep program path is added to environment variable PATH, you don't need
;; worry about slash problem.
;;
;; - Add below code into "~/.emacs" to AUTOMATICALLY update tags file:
;;
;; ;; Don't ask before reloading updated tags files
;; (setq tags-revert-without-query t)
;; ;; NO warning when loading large tag files
;; (setq large-file-warning-threshold nil)
;; (add-hook 'prog-mode-hook
;; (lambda ()
;; (add-hook 'after-save-hook
;; 'counsel-etags-virtual-update-tags 'append 'local)))
;;
;; - You can use ivy's exclusion patterns to filter candidates.
;; For example, input "keyword1 !keyword2 keyword3" means:
;; "(keyword1 and (not (or keyword2 keyword3)))"
;;
;; - `counsel-etags-extra-tags-files' contains extra tags files to parse.
;; Set it like,
;; (setq counsel-etags-extra-tags-files
;; '("./TAGS" "/usr/include/TAGS" "$PROJ1/include/TAGS"))
;;
;; Files in `counsel-etags-extra-tags-files' should have symbols with absolute path only.
;;
;; - You can set up `counsel-etags-ignore-directories' and `counsel-etags-ignore-filenames',
;; (with-eval-after-load 'counsel-etags
;; ;; counsel-etags-ignore-directories does NOT support wildcast
;; (push "build_clang" counsel-etags-ignore-directories)
;; (push "build_clang" counsel-etags-ignore-directories)
;; ;; counsel-etags-ignore-filenames supports wildcast
;; (push "TAGS" counsel-etags-ignore-filenames)
;; (push "*.json" counsel-etags-ignore-filenames))
;;
;; - Rust programming language is supported.
;; The easiest setup is to use ".dir-locals.el".
;; in root directory. The content of .dir-locals.el" is as below,
;;
;; ((nil . ((counsel-etags-update-tags-backend . (lambda (src-dir) (shell-command "rusty-tags Emacs")))
;; (counsel-etags-tags-file-name . "rusty-tags.emacs"))))
;;
;; - User could use `counsel-etags-convert-grep-keyword' to customize grep keyword.
;; Below setup enable `counsel-etags-grep' to search Chinese using pinyinlib,
;;
;; (unless (featurep 'pinyinlib) (require 'pinyinlib))
;; (setq counsel-etags-convert-grep-keyword
;; (lambda (keyword)
;; (if (and keyword (> (length keyword) 0))
;; (pinyinlib-build-regexp-string keyword t)
;; keyword)))
;;
;; - `counsel-etags-find-tag-name-function' finds tag name at point. If it returns nil,
;; `find-tag-default' is used. `counsel-etags-word-at-point' gets word at point.
;;
;; - You can append extra content into tags file in `counsel-etags-after-update-tags-hook'.
;; The parameter of hook is full path of the tags file.
;; `counsel-etags-tag-line' and `counsel-etags-append-to-tags-file' are helper functions
;; to update tags file in the hook.
;;
;; - The ignore files (.gitignore, etc) are automatically detected and append to ctags
;; cli options as "--exclude="@/ignore/file/path".
;; Set `counsel-etags-ignore-config-files' to nil to turn off this feature.
;;
;; - If base configuration file "~/.ctags.exuberant" exists, it's used to
;; generate "~/.ctags" automatically.
;; "~/.ctags.exuberant" is Exuberant Ctags format, but the "~/.ctags" could be
;; Universal Ctags format if Universal Ctags is used.
;; You can customize `counsel-etags-ctags-options-base' to change the path of
;; base configuration file.
;; - Grep result is sorted by string distance of current file path and candidate file path.
;; The sorting happens in Emacs 27+.
;; You can set `counsel-etags-sort-grep-result-p' to nil to disable sorting.
;; - Run `counsel-etags-list-tag-in-current-file' to list tags in current file.
;; You can also use native imenu with below setup,
;; (setq imenu-create-index-function
;; 'counsel-etags-imenu-default-create-index-function)
;;
;; See https://github.com/redguardtoo/counsel-etags/ for more tips.
;;; Code:
(require 'xref nil t) ; xref is optional
(require 'etags)
(require 'cl-lib)
(require 'find-file)
(require 'ivy nil t)
(require 'counsel nil t) ; counsel => swiper => ivy
(require 'tramp nil t)
(require 'browse-url)
(defgroup counsel-etags nil
"Complete solution to use ctags."
:group 'tools)
(defcustom counsel-etags-browse-url-function 'browse-url-generic
"The function to open url in tags file."
:group 'counsel-etags
:type 'function)
(defcustom counsel-etags-ignore-config-files
'(".gitignore"
".hgignore"
"~/.ignore")
"Path of configuration file which specifies files that should ignore.
Path is either absolute path or relative to the tags file."
:group 'counsel-etags
:type '(repeat string))
(defcustom counsel-etags-command-to-scan-single-code-file nil
"Shell Command to scan single file.
If it's nil, a command using ctags is automatically created."
:group 'counsel-etags
:type 'string)
(defcustom counsel-etags-extra-tags-files nil
"List of extra tags files to load. They are not updated automatically.
A typical format is
(\"./TAGS\" \"/usr/include/TAGS\" \"$PROJECT/*/include/TAGS\")
Environment variables can be inserted between slashes (`/').
They will be replaced by their definition. If a variable does
not exist, it is replaced (silently) with an empty string.
Symbol location inside tags file should use absolute path.
A CLI to create tags file:
find /usr/include | ctags -e -L -"
:group 'counsel-etags
:type '(repeat 'string))
(defcustom counsel-etags-stop-auto-update-tags nil
"If t, tags will not be updated automatically."
:group 'counsel-etags
:type 'boolean)
(defcustom counsel-etags-use-ripgrep-force nil
"Force use ripgrep as grep program.
If rg is not in $PATH, then it need be defined in `counsel-etags-grep-program'."
:group 'counsel-etags
:type 'boolean)
(defcustom counsel-etags-ripgrep-default-options
;; @see https://github.com/BurntSushi/ripgrep/issues/501
;; some shell will expand "/" to a complete file path.
;; so try to avoid "/" in shell
(format "-n -M 1024 --no-heading --color never -s %s"
(if (eq system-type 'windows-nt) "--path-separator \"\x2f\"" ""))
"Default options passed to ripgrep command line program."
:group 'counsel-etags
:type 'boolean)
(defcustom counsel-etags-grep-extra-arguments ""
"Extra arguments passed to grep program."
:group 'counsel-etags
:type 'string)
(defcustom counsel-etags-convert-grep-keyword 'identity
"Convert keyword to grep to new regex to feed into grep program."
:group 'counsel-etags
:type 'function)
(defcustom counsel-etags-fallback-grep-function #'counsel-etags-grep
"The fallback grep function if tag can't be found at first.
Hope grep can find something.
Below parameters is passed to the function.
The parameter \"keyword\" is the search keyword.
The parameter \"hint\" is the hint for grep ui.
The parameter \"root\" is the project root directory."
:group 'counsel-etags
:type 'function)
(defcustom counsel-etags-can-skip-project-root nil
"If t, scanning project root is optional."
:group 'counsel-etags
:type 'boolean)
(defcustom counsel-etags-find-tag-name-function 'counsel-etags-find-tag-name-default
"The function to use to find tag name at point.
It should be a function that takes no arguments and returns an string.
If it returns nil, the `find-tag-default' is used.
The function `counsel-etags-word-at-point' could be used find word at point.
The definition of word is customized by the user."
:group 'counsel-etags
:type 'function)
(defcustom counsel-etags-maximum-candidates-to-clean 1024
"Maximum candidates to clean up before displaying to users.
If candidates number is greater than this value, show all raw candidates."
:group 'counsel-etags
:type 'integer)
(defcustom counsel-etags-major-modes-to-strip-default-tag-name
'(org-mode
markdown-mode)
"Major mode where default tag name need be stripped.
It's used by `counsel-etags-find-tag-name-default'."
:group 'counsel-etags
:type '(repeat 'sexp))
(defcustom counsel-etags-ignore-directories
'(;; VCS
".git"
".svn"
".cvs"
".bzr"
".hg"
;; project misc
"bin"
"dist"
"fonts"
"images"
;; Mac
".DS_Store"
;; html/javascript/css
".npm"
".tmp" ; TypeScript
".sass-cache" ; SCSS/SASS
".idea"
"node_modules"
"bower_components"
;; python
".tox"
;; vscode
".vscode"
;; emacs
".cask")
"Ignore directory names."
:group 'counsel-etags
:type '(repeat 'string))
(defcustom counsel-etags-ignore-filenames
'(;; VCS
;; project misc
"*.log"
;; rusty-tags
"rusty-tags.vim"
"rusty-tags.emacs"
;; Ctags
"tags"
"TAGS"
;; compressed
"*.tgz"
"*.gz"
"*.xz"
"*.zip"
"*.tar"
"*.rar"
;; Global/Cscope
"GTAGS"
"GPATH"
"GRTAGS"
"cscope.files"
;; html/javascript/css
"*bundle.js"
"*min.js"
"*min.css"
;; Images
"*.png"
"*.jpg"
"*.jpeg"
"*.gif"
"*.bmp"
"*.tiff"
"*.ico"
;; documents
"*.doc"
"*.docx"
"*.xls"
"*.ppt"
"*.pdf"
"*.odt"
;; C/C++
".clang-format"
"*.obj"
"*.so"
"*.o"
"*.a"
"*.ifso"
"*.tbd"
"*.dylib"
"*.lib"
"*.d"
"*.dll"
"*.exe"
;; Java
".metadata*"
"*.class"
"*.war"
"*.jar"
;; Emacs/Vim
"*flymake"
"#*#"
".#*"
"*.swp"
"*~"
"*.elc"
;; Python
"*.pyc")
"Ignore file names. Wildcast is supported."
:group 'counsel-etags
:type '(repeat 'string))
(defcustom counsel-etags-project-file '("TAGS" "tags" ".svn" ".hg" ".git")
"The file/directory used to locate project root directory.
You can set up it in \".dir-locals.el\"."
:group 'counsel-etags
:type '(repeat 'string))
(defcustom counsel-etags-project-root nil
"Project root directory. The directory automatically detects if it's nil."
:group 'counsel-etags
:type 'string)
(defcustom counsel-etags-tags-file-name "TAGS"
"Tags file name."
:group 'counsel-etags
:type 'string)
(defcustom counsel-etags-ctags-options-file "~/.ctags"
"File to read options from, like \"~/.ctags\".
Universal Ctags won't read options from \"~/.ctags\" by default.
So we force Universal Ctags to load \"~/.ctags\".
Exuberant Ctags can NOT read option file \".ctags\" through cli option.
So we use Emacs Lisp to load \"~.ctags\".
Use file name \"ctags.cnf\" instead \".ctags\" if it needs change.
Universal Ctags does NOT have this bug.
Please do NOT exclude system temporary folder in ctags configuration
because imenu functions need create and scan files in this folder."
:group 'counsel-etags
:type 'string)
(defcustom counsel-etags-ctags-options-base "~/.ctags.exuberant"
"Ctags configuration base use by all Ctags implementations.
Universal Ctags converts it to `counsel-etags-ctags-options-file'.
If it's nil, nothing happens."
:group 'counsel-etags
:type 'string)
(defcustom counsel-etags-imenu-excluded-names
'("this"
"if"
"unless"
"import"
"const"
"public"
"static"
"private"
"for"
"while"
"export"
"declare"
"let")
"Some imenu items should be excluded by name."
:group 'counsel-etags
:type '(repeat 'string))
(defcustom counsel-etags-imenu-excluded-types
'("variable"
"constant")
"Some imenu items should be excluded by type.
Run \"ctags -x some-file\" to see the type in second column of output."
:group 'counsel-etags
:type '(repeat 'string))
(defcustom counsel-etags-candidates-optimize-limit 256
"Sort candidates if its size is less than this variable's value.
Candidates whose file path has Levenshtein distance to current file/directory.
You may set it to nil to disable re-ordering for performance reason.
If `string-distance' exists, sorting happens and this variable is ignored."
:group 'counsel-etags
:type 'integer)
(defcustom counsel-etags-sort-grep-result-p t
"Sort grep result by string distance."
:group 'counsel-etags
:type 'boolean)
(defcustom counsel-etags-max-file-size 512
"Ignore files bigger than `counsel-etags-max-file-size' kilobytes.
This option is ignored if GNU find is not installed."
:group 'counsel-etags
:type 'integer)
(defcustom counsel-etags-after-update-tags-hook nil
"Hook after tags file is actually updated.
The parameter of hook is full path of the tags file."
:group 'counsel-etags
:type 'hook)
(defcustom counsel-etags-org-property-name-for-grepping
"GREP_PROJECT_ROOT"
"Org node property name for get grepping project root."
:group 'counsel-etags
:type 'string)
(defcustom counsel-etags-org-extract-project-root-from-node-p
t
"Extract project root directory from org node."
:group 'counsel-etags
:type 'boolean)
(defcustom counsel-etags-update-interval 300
"The interval (seconds) to update tags file.
Used by `counsel-etags-virtual-update-tags'.
Default value is 300 seconds."
:group 'counsel-etags
:type 'integer)
(defcustom counsel-etags-ctags-program nil
"Ctags Program. Ctags is automatically detected if it's nil.
You can set it to the full path of the executable."
:group 'counsel-etags
:type 'string)
(defcustom counsel-etags-grep-program nil
"Grep program. Program is automatically detected if it's nil.
You can set it to the full path of the executable."
:group 'counsel-etags
:type 'string)
(defcustom counsel-etags-quiet-when-updating-tags t
"Be quiet when updating tags."
:group 'counsel-etags
:type 'boolean)
(defcustom counsel-etags-update-tags-backend
'counsel-etags-scan-dir-internal
"A user-defined function to update tags file during auto-updating.
The function has same parameters as `counsel-etags-scan-dir-internal'."
:group 'counsel-etags
:type 'sexp)
(defconst counsel-etags-no-project-msg
"No project found. You can create tags file using `counsel-etags-scan-code'.
So we don't need the project root at all.
Or you can set up `counsel-etags-project-root'."
"Message to display when no project is found.")
(defvar counsel-etags-debug nil "Enable debug mode.")
;; Timer to run auto-update tags file
(defvar counsel-etags-timer nil "Internal timer.")
(defvar counsel-etags-keyword nil "The keyword to grep.")
(defvar counsel-etags-opts-cache '() "Grep CLI options cache.")
(defvar counsel-etags-tag-history nil "History of tag names.")
(defvar counsel-etags-tags-file-history nil
"Tags files history. Recently accessed file is at the top of history.
The file is also used by tags file auto-update process.")
(defvar counsel-etags-find-tag-candidates nil "Find tag candidate.")
(defvar counsel-etags-cache nil "Cache of multiple tags files.")
(defvar counsel-etags-find-tag-map (make-sparse-keymap)
"Ivy keymap while narrowing down tags.")
(defvar counsel-etags-last-tagname-at-point nil
"Last tagname queried at point.")
(declare-function outline-up-heading "outline")
(declare-function org-entry-get "outline")
(defun counsel-etags-org-entry-get-project-root ()
"Get org property from current node or parent node recursively."
(when (and (derived-mode-p 'org-mode)
counsel-etags-org-extract-project-root-from-node-p)
(unless (featurep 'org) (require 'org))
(unless (featurep 'outline) (require 'outline))
(let* ((pos (point))
(prop-name counsel-etags-org-property-name-for-grepping)
(rlt (org-entry-get pos prop-name))
(loop t)
old-pos)
(save-excursion
(unless rlt
(setq old-pos (point))
(condition-case nil (outline-up-heading 1) (error nil))
(while loop
(cond
((or (setq rlt (org-entry-get (point) prop-name))
(eq (point) old-pos))
(setq loop nil))
(t
(setq old-pos (point))
(condition-case nil (outline-up-heading 1) (error nil)))))
(goto-char pos))
rlt))))
(defun counsel-etags-win-path (executable-name drive)
"Guess EXECUTABLE-NAME's full path in Cygwin on DRIVE."
(let* ((path (concat drive ":\\\\cygwin64\\\\bin\\\\" executable-name ".exe")))
(if (file-exists-p path) path)))
;;;###autoload
(defun counsel-etags-guess-program (executable-name)
"Guess path from its EXECUTABLE-NAME on Windows.
Return nil if it's not found."
(cond
((file-remote-p default-directory)
;; Assume remote server has already added EXE into $PATH!
executable-name)
((eq system-type 'windows-nt)
(or (counsel-etags-win-path executable-name "c")
(counsel-etags-win-path executable-name "d")
(counsel-etags-win-path executable-name "e")
(counsel-etags-win-path executable-name "f")
(counsel-etags-win-path executable-name "g")
(counsel-etags-win-path executable-name "h")
executable-name))
(t
(if (executable-find executable-name) (executable-find executable-name)))))
;;;###autoload
(defun counsel-etags-version ()
"Return version."
(message "1.10.1"))
;;;###autoload
(defun counsel-etags-get-hostname ()
"Reliable way to get current hostname.
`(getenv \"HOSTNAME\")' won't work because $HOSTNAME is NOT an
environment variable.
`system-name' won't work because /etc/hosts could be modified"
(with-temp-buffer
(shell-command "hostname" t)
(goto-char (point-max))
(delete-char -1)
(buffer-string)))
(defun counsel-etags-get-tags-file-path (dir)
"Get full path of tags file from DIR."
(and dir (expand-file-name (concat (file-name-as-directory dir)
counsel-etags-tags-file-name))))
(defun counsel-etags-locate-tags-file ()
"Find tags file: Search `counsel-etags-tags-file-history' and parent directories."
(counsel-etags-get-tags-file-path (locate-dominating-file default-directory
counsel-etags-tags-file-name)))
(defun counsel-etags-tags-file-directory ()
"Directory of tags file."
(let* ((f (counsel-etags-locate-tags-file)))
(if f (file-name-directory (expand-file-name f)))))
(defun counsel-etags-locate-project ()
"Return the root of the project."
(let* ((tags-dir (if (listp counsel-etags-project-file)
(cl-some (apply-partially 'locate-dominating-file
default-directory)
counsel-etags-project-file)
(locate-dominating-file default-directory
counsel-etags-project-file)))
(project-root (or counsel-etags-project-root
(and tags-dir (file-name-as-directory tags-dir)))))
(or project-root
(progn (message counsel-etags-no-project-msg)
nil))))
(defun counsel-etags-add-tags-file-to-history (tags-file)
"Add TAGS-FILE to the top of `counsel-etags-tags-file-history'."
(let* ((file (expand-file-name tags-file)))
(setq counsel-etags-tags-file-history
(delq nil (mapcar
(lambda (s)
(unless (string= file (expand-file-name s)) s))
counsel-etags-tags-file-history)))
(push tags-file counsel-etags-tags-file-history)))
;;;###autoload
(defun counsel-etags-async-shell-command (command tags-file)
"Execute string COMMAND and create TAGS-FILE asynchronously."
(let* ((proc (start-file-process "Shell" nil shell-file-name shell-command-switch command)))
(set-process-sentinel
proc
`(lambda (process signal)
(let* ((status (process-status process)))
(when (memq status '(exit signal))
(cond
((string= (substring signal 0 -1) "finished")
(let* ((cmd (car (cdr (cdr (process-command process))))))
(if counsel-etags-debug (message "`%s` executed." cmd))
;; If tramp exists and file is remote, clear file cache
(when (and (fboundp 'tramp-cleanup-this-connection)
,tags-file
(file-remote-p ,tags-file))
(tramp-cleanup-this-connection))
;; reload tags-file
(when (and ,tags-file (file-exists-p ,tags-file))
(run-hook-with-args 'counsel-etags-after-update-tags-hook ,tags-file)
(message "Tags file %s was created." ,tags-file))))
(t
(message "Failed to create tags file. Error=%s CLI=%s"
signal
,command)))))))))
(defun counsel-etags-dir-pattern (dir)
"Trim * from DIR."
(setq dir (replace-regexp-in-string "[*/]*\\'" "" dir))
(setq dir (replace-regexp-in-string "\\`[*]*" "" dir))
dir)
(defun counsel-etags-emacs-bin-path ()
"Get Emacs binary path."
(let* ((emacs-executable (file-name-directory (expand-file-name invocation-name
invocation-directory))))
(replace-regexp-in-string "/" "\\\\" emacs-executable)))
(defun counsel-etags--ctags--info (ctags-program)
"Get CTAGS-PROGRAM information."
(shell-command-to-string (concat ctags-program " --version")))
;;;###autoload
(defun counsel-etags-exuberant-ctags-p (ctags-program)
"If CTAGS-PROGRAM is Exuberant Ctags."
(let* ((cmd-output (counsel-etags--ctags--info ctags-program)))
(and (not (string-match-p "Universal Ctags" cmd-output))
(string-match-p "Exuberant Ctags" cmd-output))))
;;;###autoload
(defun counsel-etags-universal-ctags-p (ctags-program)
"If CTAGS-PROGRAM is Universal Ctags."
(and (executable-find ctags-program)
(not (counsel-etags-exuberant-ctags-p ctags-program))))
(defun counsel-etags-valid-ctags (ctags-program)
"If CTAGS-PROGRAM is Ctags return the program.
If it's Emacs etags return nil."
(when ctags-program
(let* ((cmd-output (counsel-etags--ctags--info ctags-program)))
(unless (string-match-p " ETAGS.README" cmd-output)
ctags-program))))
(defun counsel-etags-languages (ctags-program)
"List languages CTAGS-PROGRAM supports."
(let* ((cmd (concat ctags-program " --list-languages")))
(split-string (shell-command-to-string cmd) "\n")))
(defun counsel-etags-universal-ctags-opt ()
"Generate option for Universal ctags."
(format "--options=\"%s\""
(expand-file-name counsel-etags-ctags-options-file)))
(defun counsel-etags-convert-config (config program)
"Convert CONFIG of PROGRAM into Universal Ctags format."
(let* ((rlt config)
(langs (counsel-etags-languages program))
ch
regex)
(dolist (lang langs)
(when (not (string= "" lang))
(setq ch (substring-no-properties lang 0 1))
(setq regex (format "--langdef=[%s%s]%s *$"
ch
(downcase ch)
(substring-no-properties lang 1)))
(setq rlt (replace-regexp-in-string regex "" rlt))))
rlt))
(defun counsel-etags-ctags-options-file-cli (program)
"Use PROGRAM to create cli for `counsel-etags-ctags-options-file'."
(let* (str
(exuberant-ctags-p (counsel-etags-exuberant-ctags-p program)))
(cond
;; Don't use any configuration file at all
((or (not counsel-etags-ctags-options-file)
(string= counsel-etags-ctags-options-file ""))
"")
;; ~/.ctags.exuberant => ~/.ctags
((file-exists-p counsel-etags-ctags-options-base)
(setq str
(counsel-etags-read-internal counsel-etags-ctags-options-base))
(unless exuberant-ctags-p
;; Universal Ctags
(setq str (counsel-etags-convert-config str program)))
;; Make sure ~/.ctags exist
(counsel-etags-write-internal str counsel-etags-ctags-options-file)
;; OK, no we can pass option to cli
(if exuberant-ctags-p "" (counsel-etags-universal-ctags-opt)))
;; ~/.ctags is missing
((not (file-exists-p counsel-etags-ctags-options-file))
"")
;; If options file is "~/.ctags" and Exuberant Ctags is used
;; "~/.ctags" won't be loaded.
;; But if options file is empty, "~/.ctags" will be loaded.
;; It's a bug of Exuberant Ctags, work around here.
(exuberant-ctags-p
;; For Exuberant Ctags, I only accept ~/.ctags
"")
;; Universal Ctags
(t
(counsel-etags-universal-ctags-opt)))))
(defun counsel-etags-ctags-ignore-config ()
"Specify ignore configuration file (.gitignore, for example) for Ctags."
(let* (rlt configs filename)
(dolist (f counsel-etags-ignore-config-files)
(when (file-exists-p (setq filename (expand-file-name f)))
(push (file-local-name filename) configs)))
(setq rlt (mapconcat (lambda (c) (format "--exclude=\"@%s\"" c)) configs " "))
(when counsel-etags-debug
(message "counsel-etags-ctags-ignore-config returns %s" rlt))
rlt))
(defun counsel-etags-get-scan-command (ctags-program &optional code-file)
"Create command for CTAGS-PROGRAM.
If CODE-FILE is a real file, the command scans it and output to stdout."
(let* ((cmd ""))
(cond
;; Use ctags only
(ctags-program
(setq cmd
(format "%s %s %s -e %s %s %s -R %s"
ctags-program
(mapconcat (lambda (p)
(format "--exclude=\"*/%s/*\" --exclude=\"%s/*\""
(counsel-etags-dir-pattern p)
(counsel-etags-dir-pattern p)))
counsel-etags-ignore-directories " ")
(mapconcat (lambda (p)
(format "--exclude=\"%s\"" p))
counsel-etags-ignore-filenames " ")
(counsel-etags-ctags-options-file-cli ctags-program)
(counsel-etags-ctags-ignore-config)
;; print a tabular, human-readable cross reference
;; --<my-lang>-kinds=f still accept all user defined regex
;; so we have to filter in Emacs Lisp
(if code-file "-x -w" "")
(if code-file (format "\"%s\"" code-file) ""))))
(t
(message "You need install Ctags at first. Universal Ctags is highly recommended.")))
(when counsel-etags-debug
(message "counsel-etags-get-scan-command called => ctags-program=%s cmd=%s"
ctags-program cmd))
cmd))
;;;###autoload
(defun counsel-etags-scan-dir-internal (src-dir)
"Create tags file from SRC-DIR."
;; TODO save the ctags-opts into hash
(let* ((ctags-program (or counsel-etags-ctags-program
(counsel-etags-valid-ctags
(counsel-etags-guess-program "ctags"))))
(default-directory src-dir)
;; if both find and ctags exist, use both
;; if only ctags exists, use ctags
;; run find&ctags to create TAGS, `-print` is important option to filter correctly
(cmd (counsel-etags-get-scan-command ctags-program))
(tags-file (counsel-etags-get-tags-file-path src-dir)))
(unless ctags-program
(error "Please install Exuberant Ctags or Universal Ctags before running this program!"))
(when counsel-etags-debug
(message "counsel-etags-scan-dir-internal called => src-dir=%s" src-dir)
(message "default-directory=%s cmd=%s" default-directory cmd))
;; always update cli options
(message "%s at %s" (if counsel-etags-debug cmd "Scan") default-directory)
(counsel-etags-async-shell-command cmd tags-file)))
(defun counsel-etags-toggle-auto-update-tags ()
"Stop/Start tags auto update."
(interactive)
(if (setq counsel-etags-stop-auto-update-tags
(not counsel-etags-stop-auto-update-tags))
(message "Tags is NOT automatically updated any more.")
(message "Tags will be automatically updated.")))
(defun counsel-etags-scan-dir (src-dir)
"Create tags file from SRC-DIR."
(if counsel-etags-debug (message "counsel-etags-scan-dir called => %s" src-dir))
(cond
(counsel-etags-stop-auto-update-tags
;; do nothing
)
(t
(funcall counsel-etags-update-tags-backend src-dir))))
;;;###autoload
(defun counsel-etags-directory-p (regex)
"Does directory of current file match REGEX?"
(let* ((case-fold-search nil)
(dir (or (when buffer-file-name
(file-name-directory buffer-file-name))
;; buffer is created in real time
default-directory
"")))
(string-match-p regex dir)))
;;;###autoload
(defun counsel-etags-filename-p (regex)
"Does current file match REGEX?"
(let* ((case-fold-search nil)
(file (or buffer-file-name default-directory "")))
(string-match-p regex file)))
(defun counsel-etags-read-internal (file)
"Read content of FILE."
(with-temp-buffer
(insert-file-contents file)
(buffer-string)))
(defun counsel-etags-write-internal (content file)
"Write CONTENT into FILE."
(write-region content nil file))
(defun counsel-etags-read-file (file)
"Return FILE content with child files included."
(let* ((raw-content (counsel-etags-read-internal file))
(start 0)
(re "^\\([^,]+\\),include$")
included
(extra-content ""))
(while (setq start (string-match re raw-content start))
(when (file-exists-p (setq included (match-string 1 raw-content)))
(setq extra-content (concat extra-content
"\n"
(counsel-etags-read-internal included))))
(setq start (+ start (length included))))
(concat raw-content extra-content)))
(defmacro counsel-etags--tset (table x y val row-width)
"Set TABLE cell at position (X, Y) with VAL and ROW-WIDTH."
`(aset ,table (+ ,x (* ,row-width ,y)) ,val))
(defmacro counsel-etags--tref (table x y row-width)
"Get TABLE cell at position (X, Y) with ROW-WIDTH."
`(aref ,table (+ ,x (* ,row-width ,y))))
(defun counsel-etags-levenshtein-distance (str1 str2 hash)
"Return the edit distance between strings STR1 and STR2.
HASH store the previous distance."
(let* ((val (gethash str1 hash)))
(unless val
(let* ((length-str1 (length str1))
(length-str2 (length str2))
;; it's impossible files name has more than 512 characters
(d (make-vector (* (1+ length-str1) (1+ length-str2)) 0))
;; d is a table with lenStr2+1 rows and lenStr1+1 columns
(row-width (1+ length-str1))
(i 0)
(j 0))
;; i and j are used to iterate over str1 and str2
(while (<= i length-str1) ;; for i from 0 to lenStr1
(counsel-etags--tset d i 0 i row-width) ;; d[i, 0] := i
(setq i (1+ i)))
(while (<= j length-str2) ;; for j from 0 to lenStr2
(counsel-etags--tset d 0 j j row-width) ;; d[0, j] := j
(setq j (1+ j)))
(setq i 1)
(while (<= i length-str1) ;; for i from 1 to lenStr1
(setq j 1)
(while (<= j length-str2) ;; for j from 1 to lenStr2
(let* ((cost
;; if str[i] = str[j] then cost:= 0 else cost := 1
(if (equal (aref str1 (1- i)) (aref str2 (1- j))) 0 1))
;; d[i-1, j] + 1 // deletion
(deletion (1+ (counsel-etags--tref d (1- i) j row-width)))
;; d[i, j-1] + 1 // insertion
(insertion (1+ (counsel-etags--tref d i (1- j) row-width)))
;; d[i-j,j-1] + cost // substitution
(substitution (+ (counsel-etags--tref d (1- i) (1- j) row-width) cost))
(distance (min insertion deletion substitution)))
(counsel-etags--tset d i j distance row-width)
(setq j (1+ j))))
(setq i (1+ i))) ;; i++
;; return d[lenStr1, lenStr2] or the max distance
(setq val (counsel-etags--tref d length-str1 length-str2 row-width))
(puthash str1 val hash)))
val))
(defun counsel-etags--strip-path (path strip-count)
"Strip PATH with STRIP-COUNT."
(let* ((i (1- (length path))))
(while (and (> strip-count 0)
(> i 0))
(when (= (aref path i) ?/)
(setq strip-count (1- strip-count)))
(setq i (1- i)))
(if (= 0 strip-count) (substring path (+ 1 i))
path)))
(defun counsel-etags-sort-candidates-maybe (cands strip-count is-string current-file)
"Sort CANDS by string distance.
STRIP-COUNT strips the string before calculating distance.
IS-STRING is t if the candidate is string.
CURRENT-FILE is used to compare with candidate path."
(let* ((ref (and current-file (counsel-etags--strip-path current-file strip-count))))
(cond
;; don't sort candidates if `current-file' is nil
((or (not ref)
(not counsel-etags-candidates-optimize-limit)
(>= (length cands) counsel-etags-candidates-optimize-limit))
cands)
; sort in C
((fboundp 'string-distance)
;; Emacs 27 `string-distance' is much faster than Lisp implementation.
(sort cands
`(lambda (item1 item2)
(let* ((a (counsel-etags--strip-path (expand-file-name (if ,is-string item1 (cadr item1))) ,strip-count))
(b (counsel-etags--strip-path (expand-file-name (if ,is-string item2 (cadr item2))) ,strip-count)))
(< (string-distance a ,ref t)
(string-distance b ,ref t))))))
;; sort in Lisp. It's slow so `counsel-etags-candidates-optimize-limit'
;; limits the maximum number of candidates to be sorted
(t
(let* ((h (make-hash-table :test 'equal)))
(sort cands
`(lambda (item1 item2)
(let* ((a (counsel-etags--strip-path (expand-file-name (if ,is-string item1 (cadr item1))) ,strip-count))
(b (counsel-etags--strip-path (expand-file-name (if ,is-string item2 (cadr item2))) ,strip-count)))
(< (counsel-etags-levenshtein-distance a ,ref ,h)
(counsel-etags-levenshtein-distance b ,ref ,h))))))))))
(defun counsel-etags-cache-invalidate (tags-file)
"Invalidate the cache of TAGS-FILE."