-
Notifications
You must be signed in to change notification settings - Fork 11
/
Copy pathhmouse-tag.el
1629 lines (1483 loc) · 66.2 KB
/
hmouse-tag.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
;;; hmouse-tag.el --- Smart Key support of programming language constructs -*- lexical-binding: t; -*-
;;
;; Author: Bob Weiner
;;
;; Orig-Date: 24-Aug-91
;; Last-Mod: 29-Jan-25 at 20:26:54 by Mats Lidell
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
;; Copyright (C) 1991-2024 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
;;
;; This file is part of GNU Hyperbole.
;;; Commentary:
;;; Code:
;;; ************************************************************************
;;; Other required Elisp libraries
;;; ************************************************************************
(eval-and-compile
(mapc #'require '(find-func hpath hui-select))
(unless (or (featurep 'etags) (featurep 'tags))
;; Force use of .elc file here since otherwise the bin/etags
;; executable might be found in a user's load-path by the load
;; command.
(load "etags.elc" t t t)))
(require 'hsys-xref)
;;; ************************************************************************
;;; Public declarations
;;; ************************************************************************
(declare-function br-edit "ext:br")
(declare-function br-edit-feature "ext:br-ftr")
(declare-function python-import-file "ext:br-python-ft")
(declare-function python-to-definition "ext:br-python-ft")
(declare-function epc:manager-server-process "ext:epc")
(declare-function java-to-definition "ext:br-java-ft")
(declare-function jedi:-get-servers-in-use "ext:jedi-core")
(declare-function jedi:goto--line-column "ext:jedi-core")
(declare-function jedi:goto-definition "ext:jedi-core")
(declare-function objc-to-definition "ext:br-objc-ft")
(defvar br-env-spec)
(defvar br-lang-prefix)
(defvar buffer-tag-table)
(defvar jedi-mode)
(defvar jedi:find-file-function) ;; FIXME: RSW customization?
(defvar java-class-def-name-grpn)
(defvar java-class-def-regexp)
(defvar hkey-value) ; "hui-mouse.el"
(declare-function hsys-org-get-value "hsys-org")
(declare-function org-in-src-block-p "org")
(declare-function ibtype:def-symbol "hbut")
;;; ************************************************************************
;;; Public variables
;;; ************************************************************************
(defconst find-defact-regexp "^\\s-*(defact\\s-+%s\\s-"
"The regexp used to search for a Hyperbole action type definition.
Note it must contain a '%s' at the place where `format'
should insert the action type definition name.")
(defconst find-defal-regexp "^\\s-*(defal\\s-+%s\\s-"
"The regexp used to search for a Hyperbole action link type definition.
Note it must contain a '%s' at the place where `format'
should insert the action link type definition name.")
(defconst find-defib-regexp "^\\s-*(defib\\s-+%s\\s-"
"The regexp used to search for a Hyperbole implicit button type definition.
Note it must contain a '%s' at the place where `format'
should insert the implicit button type definition name.")
(defconst find-defil-regexp "^\\s-*(defil\\s-+%s\\s-"
"The regexp used to search for a Hyperbole implicit link type definition.
Note it must contain a '%s' at the place where `format’
should insert the implicit link type definition name.")
;; Change ert-deftest lookups to use this regexp rather than the
;; default, `xref-find-definitions', so is not dependent on TAGS
;; tables or the `default-directory' in the ERT results buffer. When
;; a test is loaded, its symbol property, `ert--test', holds the
;; absolute path to its file, and find-function uses that when its
;; entry in `find-function-regexp-alist' is a regexp.
(defconst find-ert-test-regexp "^\\s-*(ert-deftest\\s-+%s\\s-"
"The regexp used to search for an ert test definition.
Note it must contain a '%s' at the place where `format'
should insert the implicit link type definition name.")
;; Add Hyperbole def types to `find-function-regexp-alist'.
(mapc (lambda (item)
(setq find-function-regexp-alist
(assq-delete-all (car item) find-function-regexp-alist))
(push item find-function-regexp-alist))
'((defact . find-defact-regexp)
(defal . find-defal-regexp)
(defib . find-defib-regexp)
(defil . find-defil-regexp)
(ert--test . find-ert-test-regexp)))
(define-obsolete-variable-alias 'smart-asm-include-dirs
'smart-asm-include-path "06.00")
(defcustom smart-asm-include-path nil
"*Ordered list of directories to search for assembly language include files.
Each directory must end with a directory separator."
:type '(repeat directory)
:group 'hyperbole-commands)
(defconst smart-asm-include-regexp
"[ \t*#|;]*\\(include\\|lib\\)[ \t]+\\([^ \t\n\r]+\\)"
"Regexp to match to assembly language include file lines.
Include keyword matched is grouping 1. File name is grouping 2 but may be
missing its suffix, so add \".ins\" or \".inc\" if need be.
Examples include:
INCLUDE GLOBALS
should jump to file \"globals.ins\"
lib conditionals_equ.inc
should include \"conditionals_equ.inc\"")
(define-obsolete-variable-alias 'smart-c-cpp-include-dirs
'smart-c-cpp-include-path "06.00")
(defcustom smart-c-cpp-include-path '("/usr/include/")
"*Ordered list of include directories by default searched by C/C++ preprocessor.
Each directory must end with a directory separator. See also
`smart-c-include-path'."
:type '(repeat directory)
:group 'hyperbole-commands)
(define-obsolete-variable-alias 'smart-c-include-dirs
'smart-c-include-path "06.00")
(defcustom smart-c-include-path nil
"*Ordered list of directories to search for C/C++ include files.
Each directory must end with a directory separator. Directories normally
searched by the C/C++ pre-processor should be set instead in
`smart-c-cpp-include-path'."
:type '(repeat directory)
:group 'hyperbole-commands)
(defcustom smart-c-use-lib-man nil
"Non-nil means `smart-c' and `smart-c++' display man pages for library symbols.
When nil, the default, `smart-c' and `smart-c++' look up only symbols defined in
an etags TAGS file.
Create the file ~/.CLIBS-LIST and populate it with the full pathnames (one per
line) of all of the C/C++ libraries whose symbols you want to match against.
Your MANPATH environment variable must include paths for the man pages of
these libraries also.
Your smart-clib-sym executable script included with Hyperbole
must output a 1 if a symbol is from a C/C++ library listed in
~/.CLIBS-LIST or 0 if not! Otherwise, don't set this variable to
t."
:type 'boolean
:group 'hyperbole-commands)
(defconst smart-c-include-regexp
"[ \t/*]*#[ \t]*\\(include\\|import\\)[ \t]+\\([\"<]\\)\\([^\">]+\\)[\">]"
"Regexp to match to C, C++, or Objective-C include file lines.
Include keyword matched is grouping 1. Type of include, user-specified via
double quote, or system-related starting with `<' is given by grouping 2.
File name is grouping 3.")
(defcustom smart-java-package-path
(and (fboundp 'getenv) (getenv "JAVA_HOME")
(list (expand-file-name "src/" (file-name-as-directory (getenv "JAVA_HOME")))))
"*Ordered list of directories to search for imported Java packages.
Each directory must end with a directory separator."
:type '(repeat directory)
:group 'hyperbole-commands)
(define-obsolete-variable-alias 'smart-java-include-dirs
'smart-java-include-path "06.00")
(defconst smart-java-package-regexp
"[ \t/*]*\\(package\\|import\\)[ \t]+\\([^; \t\n\r\f]+\\)"
"Regexp to match to Java `package' and `import' lines.
Keyword matched is grouping 1. Referent is grouping 2.")
(defcustom smart-emacs-tags-file nil
"*Full path name of etags file for GNU Emacs source."
:type '(file :must-match t)
:group 'hyperbole-commands)
;;; ************************************************************************
;;; Public functions
;;; ************************************************************************
(defun smart-asm (&optional identifier next)
"Jump to the definition of optional assembly IDENTIFIER or the one at point.
Optional second arg NEXT means jump to next matching assembly tag.
It assumes that its caller has already checked that the key was pressed in an
appropriate buffer and has moved the cursor to the selected buffer.
If:
(1) on an include statement, the include file is displayed;
Look for include file in directory list `smart-asm-include-path';
(2) on an identifier, the identifier definition is displayed,
assuming the identifier is found within an `etags' generated tag file
in the current directory or any of its ancestor directories."
(interactive)
(or (if identifier nil (smart-asm-include-file))
(let ((tag (or identifier (smart-asm-at-tag-p t))))
;; (message "Looking for `%s'..." tag)
(condition-case ()
(progn
(smart-tags-display tag next)
;; (message "Found definition for `%s'" tag)
t)
(error (message "`%s' definition not found in identifier lookup/tag tables" tag)
(beep))))))
;;;###autoload
(defun smart-asm-at-tag-p (&optional no-flash)
"Return assembly tag name that point is within, else nil.
When optional NO-FLASH, do not flash."
(let* ((identifier-chars "_.$a-zA-Z0-9")
(identifier (concat "[_.$a-zA-Z][" identifier-chars "]*")))
(save-excursion
(skip-chars-backward identifier-chars)
(if (looking-at identifier)
(if no-flash
(buffer-substring-no-properties (point) (match-end 0))
(smart-flash-tag
(buffer-substring-no-properties (point) (match-end 0))
(point) (match-end 0)))))))
;;;###autoload
(defun smart-c++ (&optional identifier next)
"Jump to the definition of optional C++ IDENTIFIER or the one at point.
Optional second arg NEXT means jump to next matching C++ tag.
It assumes that its caller has already checked that the key was pressed in an
appropriate buffer and has moved the cursor to the selected buffer.
See the documentation for `c++-to-definition' for the behavior of this
function when the OO-Browser has been loaded.
Otherwise:
(1) on a `#include' statement, the include file is displayed;
Look for include file in directory lists `smart-c-cpp-include-path'
and `smart-c-include-path';
(2) on a C++ identifier, the identifier definition is displayed,
assuming the identifier is found within an `etags' generated tag file
in the current directory or any of its ancestor directories;
(3) if `smart-c-use-lib-man' is non-nil, the C++ identifier is
recognized as a library symbol, and a man page is found for the
identifier, then the man page is displayed."
(interactive)
(if (fboundp 'c++-to-definition)
;; Only fboundp if the OO-Browser has been loaded.
(c++-to-definition t)
(or (if identifier nil (smart-c-include-file))
(smart-c++-tag identifier next))))
;;;###autoload
(defun smart-c++-tag (&optional identifier next)
"Jump to the definition of optional C++ IDENTIFIER or the one at point.
Optional second arg NEXT means jump to next matching C++ tag."
(let ((tag (or identifier (smart-c++-at-tag-p))))
;; (message "Looking for `%s'..." tag)
(condition-case ()
(progn
(smart-tags-display tag next)
;; (message "Found definition for `%s'" tag)
t)
(error
(if (or (not smart-c-use-lib-man)
(not (file-readable-p "~/.CLIBS-LIST")))
(progn (message "`%s' definition not found in identifier lookup/tag tables" tag)
(beep)
nil)
(message "Checking if `%s' is a C++ library function..." tag)
(if (smart-library-symbol tag)
(progn (message "Displaying C++ library man page for `%s'" tag)
(manual-entry tag)
t)
(message "`%s' definition not found in identifier lookup/tag tables or C++ libraries" tag)
(beep)
nil))))))
(defconst smart-c++-keywords
'("_pragma" "alignas" "alignof" "and" "and_eq" "asm" "atomic_cancel"
"atomic_commit " "atomic_noexcept" "auto" "bitand" "bitor" "bool"
"break" "case" "catch" "char" "char16_t" "char32_t" "class" "compl"
"concept" "const" "const_cast" "constexpr" "continue" "decltype"
"default" "define" "defined" "delete" "do" "double" "dynamic_cast"
"elif" "else" "else" "endif" "enum" "error" "explicit" "export"
"extern" "false" "final" "float" "for" "friend" "goto" "if" "if"
"ifdef" "ifndef" "import" "include" "inline" "int" "line" "long"
"module" "mutable" "namespace" "new" "noexcept" "not" "not_eq"
"nullptr" "operator" "or" "or_eq" "override" "posix" "pragma"
"private" "protected" "public" "register" "reinterpret_cast"
"requires" "return" "short" "signed" "sizeof" "static" "static_assert"
"static_cast" "std" "struct" "switch" "synchronized" "template" "this"
"thread_local" "throw" "transaction_safe" "transaction_safe_dynamic"
"true" "try" "typedef" "typeid" "typename" "undef" "union" "unsigned"
"using" "virtual" "void" "volatile" "wchar_t" "while" "xor" "xor_eq"))
(defun smart-c++-at-tag-p ()
"Return C++ tag name that point is within, else nil."
(let* ((identifier-chars "_:~<>a-zA-Z0-9")
(identifier-regexp
(concat "\\([_~:<a-zA-Z][" identifier-chars "]*\\)"
"\\([ \t]*[^]\) \t:;.,?~{}][^[\( \t:;.,~^!|?{}]?[=*]?\\)?"))
op-identifier identifier)
(save-excursion
(skip-chars-backward identifier-chars)
(when (and (looking-at identifier-regexp)
(not (member (downcase (match-string 0)) smart-c++-keywords)))
;; Don't flash button here since it was already flashed before
;; this was called.
(setq op-identifier (buffer-substring-no-properties (match-beginning 0) (match-end 0))
identifier (buffer-substring-no-properties (match-beginning 1) (match-end 1)))
;; Have to allow for identifiers such as, `operator () (int, int)'
;; yet not include the opening parenthesis in `min ()'.
(if (string-match "\\<operator\\>" op-identifier)
op-identifier
identifier)))))
(defun smart-c (&optional identifier next list-of-tags-tables)
"Jump to the definition of optional C IDENTIFIER or the one at point.
Optional second arg NEXT means jump to next matching C tag.
It assumes that its caller has already checked that the key was pressed in an
appropriate buffer and has moved the cursor to the selected buffer.
If:
(1) on a `#include' statement, the include file is displayed;
Look for include file in directory lists `smart-c-cpp-include-path'
and `smart-c-include-path';
(2) on a C identifier, the identifier definition is displayed,
assuming the identifier is found within an `etags' generated tag file
in the current directory or any of its ancestor directories;
(3) if `smart-c-use-lib-man' is non-nil, the C identifier is
recognized as a library symbol, and a man page is found for the
identifier, then the man page is displayed."
(interactive)
(or (if identifier nil (smart-c-include-file))
(let ((tag (or identifier (smart-c-at-tag-p t))))
;; (message "Looking for `%s'..." tag)
(condition-case ()
(progn
(smart-tags-display tag next list-of-tags-tables)
;; (message "Found definition for `%s'" tag)
t)
(error
(if (or (not smart-c-use-lib-man)
(not (file-readable-p "~/.CLIBS-LIST")))
(progn (message "`%s' definition not found in identifier lookup/tag tables" tag)
(beep))
(message "Checking if `%s' is a C library function..." tag)
(if (smart-library-symbol tag)
(progn (message "Displaying C library man page for `%s'" tag)
(manual-entry tag))
(message "`%s' definition not found in identifier lookup/tag tables or C libraries" tag)
(beep))))))))
(defconst smart-c-keywords
'("_generic" "_pragma" "alignas" "alignof" "asm" "atomic_bool"
"atomic_char" "atomic_char16_t" "atomic_char32_t" "atomic_int"
"atomic_int_fast16_t" "atomic_int_fast32_t" "atomic_int_fast64_t"
"atomic_int_fast8_t" "atomic_int_least16_t" "atomic_int_least32_t"
"atomic_int_least64_t" "atomic_int_least8_t" "atomic_intmax_t"
"atomic_intptr_t" "atomic_llong" "atomic_long" "atomic_ptrdiff_t"
"atomic_schar" "atomic_short" "atomic_size_t" "atomic_uchar"
"atomic_uint" "atomic_uint_fast16_t" "atomic_uint_fast32_t"
"atomic_uint_fast64_t" "atomic_uint_fast8_t" "atomic_uint_least16_t"
"atomic_uint_least32_t" "atomic_uint_least64_t" "atomic_uint_least8_t"
"atomic_uintmax_t" "atomic_uintptr_t" "atomic_ullong" "atomic_ulong"
"atomic_ushort" "atomic_wchar_t" "auto" "bool" "break" "case" "char"
"complex" "const" "continue" "default" "define" "defined" "do"
"double" "elif" "else" "endif" "enum" "error" "extern" "float"
"for" "fortran" "goto" "if" "ifdef" "ifndef" "imaginary"
"include" "inline" "int" "line" "long" "noreturn" "pragma" "register"
"restrict" "return" "short" "signed" "sizeof" "static" "static_assert"
"struct" "switch" "thread_local" "typedef" "undef" "union" "unsigned"
"void" "volatile" "while")
"Sorted list of C keywords, all in lowercase.")
;;;###autoload
(defun smart-c-at-tag-p (&optional no-flash)
"Return C tag name that point is within, else nil.
When optional NO-FLASH, do not flash."
(let* ((identifier-chars "_a-zA-Z0-9")
(identifier (concat "[_a-zA-Z][" identifier-chars "]*")))
(save-excursion
(skip-chars-backward identifier-chars)
(if (and (looking-at identifier)
(not (member (downcase (match-string 0)) smart-c++-keywords)))
(if no-flash
(buffer-substring-no-properties (point) (match-end 0))
(smart-flash-tag
(buffer-substring-no-properties (point) (match-end 0))
(point) (match-end 0)))))))
;;;###autoload
(defun smart-cc-mode-initialize ()
"Load and initialize cc-mode if possible and always return nil."
(ignore-errors (require 'cc-mode) (c-initialize-cc-mode))
nil)
(defun smart-emacs-lisp-mode-p (&optional skip-identifier-flag)
"Return non-nil if in a mode using Emacs Lisp symbols."
;; Beyond Lisp files, Emacs Lisp symbols appear frequently in Byte-Compiled
;; buffers, debugger buffers, program ChangeLog buffers, Help buffers,
;; *Warnings*, *Flymake log* and *Flymake diagnostics buffers.
(or (apply #'derived-mode-p '(emacs-lisp-mode lisp-data-mode lisp-interaction-mode
debugger-mode ert-results-mode))
(string-match-p (concat "\\`\\*\\(Warnings\\|Flymake log\\|Compile-Log\\(-Show\\)?\\)\\*"
"\\|\\`\\*Flymake diagnostics")
(buffer-name))
;; Consider the following buffer types only if on an Emacs Lisp
;; symbol that can be looked up, e.g. in a TAGS file or via a
;; previous symbol load.
(and (or (apply #'derived-mode-p '(help-mode change-log-mode))
(string-match-p "\\`\\*Help\\|Help\\*\\'" (buffer-name)))
(or skip-identifier-flag (smart-lisp-at-known-identifier-p)))))
(defun smart-fortran (&optional identifier next)
"Jump to the definition of optional Fortran IDENTIFIER or the one at point.
Optional second arg NEXT means jump to next matching Fortran tag.
It assumes that its caller has already checked that the key was pressed in an
appropriate buffer and has moved the cursor to the selected buffer.
If on a Fortran identifier, the identifier definition is displayed,
assuming the identifier is found within an `etags' generated tag file
in the current directory or any of its ancestor directories."
(interactive)
(let ((tag (or identifier (smart-fortran-at-tag-p t))))
;; (message "Looking for `%s'..." tag)
(condition-case ()
(progn
(smart-tags-display tag next)
;; (message "Found definition for `%s'" tag)
t)
(error
(message "`%s' definition not found in identifier lookup/tag tables" tag)
(beep)))))
(defconst smart-fortran-keywords
'("abstract" "all" "allocatable" "allocate" "assign" "associate"
"asynchronous" "backspace" "bind" "block" "block" "call" "case"
"class" "close" "codimension" "common" "concurrent" "contains"
"contiguous" "continue" "critical" "cycle" "data" "data" "deallocate"
"deferred" "dimension" "do" "elemental" "else" "else" "elsewhere"
"end" "endfile" "endif" "entry" "enum" "enumerator" "equivalence"
"error" "exit" "extends" "external" "final" "flush" "forall" "format"
"function" "generic" "goto" "if" "if" "images" "implicit" "import"
"include" "inquire" "intent" "interface" "intrinsic" "lock" "memory"
"module" "namelist" "non_overridable" "nopass" "nullify" "only" "open"
"operator" "optional" "parameter" "pass" "pause" "pointer" "print"
"private" "procedure" "program" "protected" "public" "pure" "read"
"recursive" "result" "return" "rewind" "rewrite" "save" "select"
"sequence" "stop" "stop" "submodule" "subroutine" "sync" "target"
"then" "unlock" "use" "value" "volatile" "wait" "where" "while"
"write")
"Sorted list of Fortran keywords, all in lowercase.")
;;;###autoload
(defun smart-fortran-at-tag-p (&optional no-flash)
"Return Fortran tag name that point is within, else nil.
When optional NO-FLASH, do not flash."
(let* ((identifier-chars "_a-zA-Z0-9")
(identifier (concat "[_a-zA-Z][" identifier-chars "]*")))
(save-excursion
(skip-chars-backward identifier-chars)
(if (looking-at identifier)
(if no-flash
(buffer-substring-no-properties (point) (match-end 0))
(smart-flash-tag
(buffer-substring-no-properties (point) (match-end 0))
(point) (match-end 0)))))))
;;;###autoload
(defun smart-java (&optional identifier next)
"Jump to the definition of optional Java IDENTIFIER or the one at point.
Optional second arg NEXT means jump to next matching Java tag.
It assumes that its caller has already checked that the key was pressed in an
appropriate buffer and has moved the cursor to the selected buffer.
See the documentation for `smart-java-oo-browser' for the behavior of this
function when the OO-Browser has been loaded.
Otherwise:
(1) within a commented @see cross-reference, the referent is displayed;
(2) on a `package' or `import' statement, the referent is displayed;
Look for referent files in the directory list `smart-java-package-path';
(3) on a Java identifier, the identifier definition is displayed,
assuming the identifier is found within an `etags' generated tag file
in the current directory or any of its ancestor directories."
(interactive)
(if (fboundp 'java-to-definition)
;; Only fboundp if the OO-Browser has been loaded.
(smart-java-oo-browser)
(or (if identifier nil (or (smart-java-cross-reference) (smart-java-packages)))
(smart-java-tag identifier next))))
;;;###autoload
(defun smart-java-tag (&optional identifier next)
"Jump to the definition of optional Java IDENTIFIER or the one at point.
Optional second arg NEXT means jump to next matching Java tag."
(let ((tag (or identifier (smart-java-at-tag-p t))))
;; (message "Looking for `%s'..." tag)
(condition-case ()
(progn
(smart-tags-display tag next)
;; (message "Found definition for `%s'" tag)
t)
(error (progn (message "`%s' definition not found in identifier lookup/tag tables" tag)
(beep))))))
;;; The following should be called only if the OO-Browser is available.
(defun smart-java-oo-browser (&optional _junk)
"Jump to the definition of selected Java construct via OO-Browser support.
Optional JUNK is ignored. Does nothing if the OO-Browser is not available.
It assumes that its caller has already checked that the key was pressed in an
appropriate buffer and has moved the cursor to the selected buffer.
If key is pressed:
(1) within a commented @see cross-reference, the referent is displayed;
(2) on a `package' or `import' statement, the referent is displayed;
Look for referent files in the directory list `smart-java-package-path';
(3) within a method declaration, its definition is displayed;
(4) on a class name, the class definition is shown;
(5) on a unique identifier reference, its definition is shown (when possible)."
(interactive)
(or (smart-java-cross-reference)
(smart-java-packages)
(java-to-definition t)))
(defconst smart-java-keywords
'("abstract" "assert" "boolean" "break" "byte" "case" "catch" "char"
"class" "const" "continue" "default" "do" "double" "else" "enum"
"extends" "final" "finally" "float" "for" "goto" "if" "implements"
"import" "instanceof" "int" "interface" "long" "native" "new"
"package" "private" "protected" "public" "return" "short" "static"
"strictfp" "super" "switch" "synchronized" "this" "throw" "throws"
"transient" "try" "void" "volatile" "while")
"Sorted list of Java keywords, all in lowercase.")
;;;###autoload
(defun smart-java-at-tag-p (&optional no-flash)
"Return Java tag name that point is within, else nil.
When optional NO-FLASH, do not flash."
(let* ((identifier-chars "_$.a-zA-Z0-9")
(identifier
(concat "[_$a-zA-Z][" identifier-chars "]*")))
(save-excursion
(skip-chars-backward identifier-chars)
(if (and (/= (preceding-char) ?@) (looking-at identifier)
(not (member (downcase (match-string 0)) smart-java-keywords)))
(if no-flash
(buffer-substring-no-properties (point) (match-end 0))
(smart-flash-tag
(buffer-substring-no-properties (point) (match-end 0))
(point) (match-end 0)))))))
;;;###autoload
(defun smart-javascript (&optional identifier next)
"Jump to the definition of optional JavaScript IDENTIFIER or the one at point.
Optional second arg NEXT means jump to next matching JavaScript tag.
It assumes that its caller has already checked that the key was pressed in an
appropriate buffer and has moved the cursor to the selected buffer.
If on a JavaScript identifier, the identifier definition is displayed,
assuming the identifier is found within an `etags' generated tag file
in the current directory or any of its ancestor directories."
(interactive)
(let ((tag (or identifier (smart-javascript-at-tag-p t))))
;; (message "Looking for `%s'..." tag)
(condition-case ()
(progn
(smart-tags-display tag next)
;; (message "Found definition for `%s'" tag)
t)
(error
(message "`%s' definition not found in identifier lookup/tag tables" tag)
(beep)))))
(defconst smart-javascript-keywords
'("break" "case" "catch" "class" "const" "continue" "debugger"
"default" "delete" "do" "else" "extends" "export" "false" "finally"
"for" "function" "if" "in" "instanceof" "import" "let" "new" "null"
"return" "super" "switch" "this" "throw" "true" "try" "typeof" "var"
"void" "while" "with" "yield")
"Sorted list of JavaScript keywords, all in lowercase.")
;;;###autoload
(defun smart-javascript-at-tag-p (&optional no-flash)
"Return JavaScript tag name that point is within, else nil.
When optional NO-FLASH, do not flash."
(if (if (memq major-mode '(html-mode web-mode))
;; Must be within a <script> tag or this predicate function
;; fails (returns nil).
(save-excursion (if (re-search-backward "<\\(/?script\\)[\> \t\n]" nil t)
(string-equal (match-string 1) "script")))
t)
(let* ((identifier-chars "_$a-zA-Z0-9")
(identifier (concat "[_$a-zA-Z][" identifier-chars "]*")))
(save-excursion
(skip-chars-backward identifier-chars)
(and (looking-at identifier)
(not (member (downcase (match-string 0)) smart-javascript-keywords))
(if no-flash
(buffer-substring-no-properties (point) (match-end 0))
(smart-flash-tag
(buffer-substring-no-properties (point) (match-end 0))
(point) (match-end 0))))))))
;;;###autoload
(defconst smart-lisp-identifier-first-char-regexp "[-<>*a-zA-Z]"
"Regexp matching the first character of a Lisp identifier.")
;;;###autoload
(defconst smart-lisp-identifier-chars "-_:/*+=%$&?!<>a-zA-Z0-9~^@"
"Regexp matching a valid char in a Lisp identifier except the first char.
Excludes character matching square brackets, so may be used with
skip-characters-forward/backward.")
;;;###autoload
(defconst smart-lisp-identifier (concat smart-lisp-identifier-first-char-regexp
"[" smart-lisp-identifier-chars "]*")
"Regexp matching a Lisp identifier.")
(defun smart-lisp (&optional show-doc)
"Jump to the definition of any selected Lisp identifier or optionally SHOW-DOC.
Assume caller has checked that (smart-emacs-lisp-mode-p) is true.
If on an Emacs Lisp require, load, or autoload clause and the
`find-library' function from the \"load-library\" package has
been loaded, this jumps to the library source whenever possible.
Otherwise, if a definition for the identifier is found within a TAGS
file in the current directory or any of its ancestor directories, this
jumps to the definition. Supports Hyperbole implicit button types and
action types.
With optional SHOW-DOC flag, show documentation for the tag at point
rather than displaying its source code definition. In this case, tag
must be a bound or fbound symbol or it is ignored.
This command assumes that its caller has already checked that the key was
pressed in an appropriate buffer and has moved the cursor to the selected
buffer."
(interactive)
(unless (and (fboundp 'find-library)
;; Handle Emacs Lisp `require', `load', and `autoload' clauses.
(let ((opoint (point))
type
name
lib)
(setq lib (and (search-backward "\(" nil t)
(or
;; load with a filename
(looking-at "(\\(load\\)[ \t]+\\(\\)\"\\([^][() \t\n\r`'\"]+\\)")
;; autoload or require with a name and filename
(looking-at "(\\(autoload\\|require\\)[ \t]+'\\([^][() \t\n\r`'\"]+\\)[ \t\n\r]+\"\\([^][() \t\n\r`'\"]+\\)")
;; require without a separate filename
(looking-at "(\\(require\\)\\(\\)[ \t]+'\\([^][() \t\n\r`'\"]+\\)"))))
(goto-char opoint)
(when lib
(setq type (match-string-no-properties 1)
name (match-string-no-properties 2)
lib (match-string-no-properties 3))
(hpath:display-buffer (current-buffer))
(find-library lib)
(goto-char (point-min))
(when (equal type "autoload")
;; Ignore defgroup matches
(if (re-search-forward
(format "^[; \t]*(def.[^r][^ \t\n\r]*[ \t]+%s[ \t\n\r]" (regexp-quote name))
nil t)
(goto-char (match-beginning 0))
(error "(smart-lisp): Found autoload library but no definition for `%s'" name)))
t)))
(smart-lisp-find-tag nil show-doc)))
(defun smart-lisp-find-tag (&optional tag show-doc)
"Find the definition of optional Lisp TAG or show its documentation.
Use identifier at point when TAG is nil. With optional prefix
arg SHOW-DOC non-nil, show its documentation.
Use `hpath:display-buffer' to show definition or documentation."
(interactive
(list (read-string (format "%s Lisp identifier: "
(if current-prefix-arg
"Show doc for" "Find")))
current-prefix-arg))
(when (and tag (symbolp tag))
(setq tag (symbol-name tag)))
(unless (stringp tag)
(setq tag (if (stringp hkey-value) hkey-value (smart-lisp-at-tag-p t))))
(let* ((elisp-flag (smart-emacs-lisp-mode-p))
(tag-sym (intern-soft tag)))
(cond ((and show-doc elisp-flag)
;; Emacs Lisp function, variable and face documentation display.
(cond ((fboundp tag-sym) (describe-function tag-sym))
((and tag-sym (boundp tag-sym)) (describe-variable tag-sym))
((facep tag-sym) (describe-face tag-sym))
(tag-sym
;; Handles ert test definitions, as one example.
(describe-symbol tag-sym))
;; Ignore unbound symbols if displaying doc.
(t nil)))
((and elisp-flag (fboundp 'find-function-noselect)
(let ((result (smart-lisp-bound-symbol-def tag-sym)))
(when (and (cdr result)
(hpath:display-buffer (car result)))
(widen)
(goto-char (cdr result))
t))))
;; If elisp-flag is true and tag-sym is a bound ert test
;; symbol, then make xref use tags tables rather than its
;; elisp backend since that does not support ert test
;; symbols. Otherwise, use standard xref backends for the
;; current language.
(t (let ((etags-mode (and elisp-flag
(fboundp 'ert-test-boundp)
(ert-test-boundp tag-sym)
(boundp 'xref-etags-mode)
xref-etags-mode)))
(unwind-protect
(progn
(and (not etags-mode) elisp-flag (fboundp 'xref-etags-mode)
(xref-etags-mode 1))
(condition-case ()
;; Tag of any language
(when (featurep 'etags)
(smart-tags-display tag show-doc)
t)
(error (unless (and elisp-flag (stringp smart-emacs-tags-file)
(condition-case ()
(progn (smart-tags-display
tag show-doc (list smart-emacs-tags-file))
t)
(error nil)))
(error "(smart-lisp): No definition found for `%s'" tag)))))
(and (not etags-mode) elisp-flag (fboundp 'xref-etags-mode)
(xref-etags-mode 0))))))))
(defun smart-lisp-at-definition-p ()
"Return non-nil if point is on the first line of a non-alias Lisp definition.
Apply only to non-help buffers and return nil in others."
(unless (derived-mode-p 'help-mode)
(save-excursion
(beginning-of-line)
;; Exclude any define- lines.
(and (looking-at "\\(;*[ \t]*\\)?(\\(ert-\\)?def[[:alnum:]]+[[:space:]]")
;; Ignore alias definitions since those typically have symbol tags to lookup.
(not (looking-at "\\(;*[ \t]*\\)?(def[^ \t\n\r]*alias"))
;; Ignore lines that start with (default
(not (looking-at "\\(;*[ \t]*\\)?(default"))))))
(defun smart-lisp-at-load-expression-p ()
"Return t if on the first line of a Lisp library load expression, else nil."
(save-excursion
(beginning-of-line)
(looking-at "\\(;*[ \t]*\\)?(\\(autoload\\|load\\|require\\)\\s-")))
(defun smart-lisp-at-change-log-tag-p ()
"When in change-log mode, match to bound Elisp identifiers only.
Also match to identifiers with a '-' in the middle.
These tight tests help eliminate undesired matches.
Return matching Elisp tag name that point is within, else nil."
(when (derived-mode-p 'change-log-mode)
(let ((identifier (smart-lisp-at-tag-p)))
(and identifier (intern-soft identifier)
(string-match-p "[^-]-[^-]" identifier)
identifier))))
(defun smart-lisp-htype-tag (tag)
"Given TAG at point, if a Hyperbole type, return the full symbol name, else TAG."
(setq tag (cond ((and tag (string-match-p "::" tag))
tag)
((and tag
(save-excursion
(skip-chars-backward "^ \t\n\r\f")
(skip-chars-backward " \t\n\r\f")
(equal (smart-lisp-at-non-htype-tag-p t) "hact")))
;; If tag is preceded by an 'hact' call, then treat as a Hyperbole actype.
(or (symtable:actype-p tag) tag))
(tag
(let ((tag-sym (intern-soft tag)))
;; The partial names of htypes will be interned
;; but not fboundp or boundp.
(if (and tag-sym (or (fboundp tag-sym) (boundp 'tag-sym)))
tag
(or (symtable:ibtype-p tag) (symtable:actype-p tag) tag))))))
(cond ((or (null tag) (stringp tag))
tag)
((symbolp tag)
(symbol-name tag))))
(defun smart-lisp-at-tag-p (&optional no-flash)
"Return possibly non-existent Lisp tag name that point is within, else nil.
When optional NO-FLASH, do not flash. Return nil when point is
on the first line of a non-alias Lisp definition.
Resolve Hyperbole implicit button type and action type references."
(smart-lisp-htype-tag
(smart-lisp-at-non-htype-tag-p no-flash)))
(defun smart-lisp-at-non-htype-tag-p (&optional no-flash)
"Return possibly non-existent Lisp tag name that point is within, else nil.
When optional NO-FLASH, do not flash. Return nil when point is
on the first line of a non-alias Lisp definition."
(unless (smart-lisp-at-definition-p)
(save-excursion
(skip-chars-backward smart-lisp-identifier-chars)
;; Ignore double quoted strings and environment variables: $PATH, ${PATH}, $(PATH), {$PATH}, ($PATH)
(unless (save-excursion
(skip-chars-backward "[\"${(]")
(looking-at "\"\\|\\$[{(]\\|[{]\\$]"))
(when (and (looking-at smart-lisp-identifier)
;; Ignore any punctuation matches.
(not (string-match-p "\\`[-<>*]+\\'" (match-string 0))))
;; Ignore any leading '<' character from action buttons or
;; other links, i.e. only when followed by an alphabetic character.
(let* ((action-button-prefix-flag
(and (eq (following-char) ?\<)
(memq (char-syntax (1+ (point))) '(?_ ?w))))
(suffix-flag
(or (eq (char-after (1- (match-end 0))) ?:)
(and action-button-prefix-flag
(eq (char-after (1- (match-end 0))) ?\>)))))
(when action-button-prefix-flag
(goto-char (1+ (point))))
(if no-flash
(if suffix-flag
(buffer-substring-no-properties (point) (1- (match-end 0)))
(buffer-substring-no-properties (point) (match-end 0)))
(if suffix-flag
(smart-flash-tag
(buffer-substring-no-properties (point) (1- (match-end 0)))
(point) (1- (match-end 0)))
(smart-flash-tag
(buffer-substring-no-properties (point) (match-end 0))
(point) (match-end 0))))))))))
;;;###autoload
(defun smart-lisp-mode-p ()
"Return t if in a mode which uses Lisp symbols."
(or (smart-emacs-lisp-mode-p)
(apply #'derived-mode-p '(lisp-mode scheme-mode help-mode))))
;;;###autoload
(defun smart-objc (&optional identifier next)
"Jump to the definition of optional Objective-C IDENTIFIER or the one at point.
Optional second arg NEXT means jump to next matching Objective-C tag.
It assumes that its caller has already checked that the key was pressed in an
appropriate buffer and has moved the cursor to the selected buffer.
See the documentation for `smart-objc-oo-browser' for the behavior of this
function when the OO-Browser has been loaded.
Otherwise:
(1) on a `#include' statement, the include file is displayed;
Look for include file in directory lists `objc-cpp-include-path' and
`objc-include-path';
(2) on an Objective-C identifier, the identifier definition is displayed,
assuming the identifier is found within an `etags' generated tag file
in the current directory or any of its ancestor directories;
(3) if `smart-c-use-lib-man' is non-nil, the Objective-C identifier is
recognized as a library symbol, and a man page is found for the
identifier, then the man page is displayed."
(interactive)
(if (fboundp 'objc-to-definition)
;; Only fboundp if the OO-Browser has been loaded.
(smart-objc-oo-browser)
(or (if identifier nil (smart-c-include-file))
(smart-objc-tag identifier next))))
;;;###autoload
(defun smart-objc-tag (&optional identifier next)
(let ((tag (or identifier (smart-objc-at-tag-p t))))
;; (message "Looking for `%s'..." tag)
(condition-case ()
(progn
(smart-tags-display tag next)
;; (message "Found definition for `%s'" tag)
t)
(error
(if (or (not smart-c-use-lib-man)
(not (file-readable-p "~/.CLIBS-LIST")))
(progn (message "`%s' definition not found in identifier lookup/tag tables" tag)
(beep))
(message
"Checking if `%s' is an Objective-C library function..." tag)
(if (smart-library-symbol tag)
(progn
(message
"Displaying Objective-C library man page for `%s'" tag)
(manual-entry tag))
(message "`%s' definition not found in identifier lookup/tag tables or Objective-C libraries"
tag)
(beep)))))))
;;; The following should be called only if the OO-Browser is available.
(defun smart-objc-oo-browser (&optional _junk)
"Jump to the definition of selected Objective-C construct via OO-Browser support.
Optional JUNK is ignored. Does nothing if the OO-Browser is not available.
It assumes that its caller has already checked that the key was pressed in an
appropriate buffer and has moved the cursor to the selected buffer.
If key is pressed:
(1) on a `#include' statement, the include file is displayed;
Look for include file in directory lists `smart-c-cpp-include-path'
and `smart-c-include-path';
(2) within a method declaration, its definition is displayed;
(3) on a class name, the class definition is shown;
(4) on a global variable or function identifier, its definition is shown.
(2) and (3) require that an OO-Browser Environment has been loaded with
the {\\`M-x' br-env-load RET} command."
(interactive)
(objc-to-definition t))
(defconst smart-objc-keywords
(append '("bycopy" "byref" "id" "in" "inout" "oneway" "out" "self" "super")
smart-c-keywords)
"Sorted list of Objective-C keywords, all in lowercase.")
(defun smart-objc-at-tag-p (&optional no-flash)
"Return Objective-C tag name that point is within, else nil.
When optional NO-FLASH, do not flash."
(let* ((identifier-chars "_a-zA-Z0-9")
(identifier
(concat "\\([-+][ \t]*\\)?\\([_a-zA-Z][" identifier-chars "]*\\)")))
(save-excursion
(skip-chars-backward identifier-chars)
(if (and (/= (preceding-char) ?@) (looking-at identifier)
(not (member (downcase (match-string 0)) smart-objc-keywords)))
(if no-flash
(buffer-substring-no-properties (match-beginning 2) (match-end 2))
(smart-flash-tag
(buffer-substring-no-properties (match-beginning 2) (match-end 2))
(match-beginning 2) (match-end 2)))))))
;; smart-prog language default support functions
;;;###autoload
(defun smart-prog-at-tag-p (&optional no-flash)
"Return programming language tag name that point is within, else nil.
When optional NO-FLASH, do not flash.
Uses `xref' for identifier recognition."
(when (derived-mode-p 'prog-mode)
(let ((identifier (hsys-xref-identifier-at-point)))
(when identifier
(setq identifier (substring-no-properties identifier))
(if no-flash
identifier
(smart-flash-tag identifier (point) (match-end 0)))
identifier))))
;;;###autoload
(defun smart-prog-tag (&optional identifier next)
"Jump to definition of optional programming IDENTIFIER or the one at point.
Optional second arg NEXT means jump to next matching tag."
(smart-tags-display (or identifier (hsys-xref-identifier-at-point)) next)
t)
(defun smart-jedi-find-file (file line column other-window)
"Function that read a source FILE for jedi navigation.
It takes these arguments: (file-to-read other-window-flag
line_number column_number)."
(hpath:display-buffer (find-file file) other-window)
(jedi:goto--line-column line column))
(defun smart-python-jedi-to-definition-p ()
"If Jedi Python identifier server is running, use it to jump to the definition.
See https://tkf.github.io/emacs-jedi/latest/."
;; Use functions from jedi-core.el only, not from jedi.el, since
;; company-jedi.el users will have loaded only jedi-core.el.
(when (and (featurep 'jedi-core) jedi-mode)
(let* ((servers (jedi:-get-servers-in-use))
(proc (epc:manager-server-process (car servers))))
(and servers (processp proc)