mirrored from git://git.sv.gnu.org/emacs.git
-
Notifications
You must be signed in to change notification settings - Fork 1.3k
/
elisp-mode.el
2351 lines (2176 loc) · 98.7 KB
/
elisp-mode.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
;;; elisp-mode.el --- Emacs Lisp mode -*- lexical-binding:t -*-
;; Copyright (C) 1985-1986, 1999-2024 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: lisp, languages
;; Package: emacs
;; This file is part of GNU Emacs.
;; GNU Emacs 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.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; The major mode for editing Emacs Lisp code.
;; This mode is documented in the Emacs manual.
;;; Code:
(require 'cl-generic)
(require 'lisp-mode)
(eval-when-compile (require 'cl-lib))
(eval-when-compile (require 'subr-x))
(define-abbrev-table 'emacs-lisp-mode-abbrev-table ()
"Abbrev table for Emacs Lisp mode.
It has `lisp-mode-abbrev-table' as its parent."
:parents (list lisp-mode-abbrev-table))
(defvar emacs-lisp-mode-syntax-table
(let ((table (make-syntax-table lisp-data-mode-syntax-table)))
;; Remove the "p" flag from the entry of `@' because we use instead
;; `syntax-propertize' to take care of `,@', which is more precise.
;; FIXME: We should maybe do the same in other Lisp modes? (bug#24542)
(modify-syntax-entry ?@ "_" table)
table)
"Syntax table used in `emacs-lisp-mode'.")
(defvar-keymap emacs-lisp-mode-map
:doc "Keymap for Emacs Lisp mode.
All commands in `lisp-mode-shared-map' are inherited by this map."
:parent lisp-mode-shared-map
"M-TAB" #'completion-at-point
"C-M-x" #'eval-defun
"C-c C-e" #'elisp-eval-region-or-buffer
"C-c C-f" #'elisp-byte-compile-file
"C-c C-b" #'elisp-byte-compile-buffer
"C-M-q" #'indent-pp-sexp)
(easy-menu-define emacs-lisp-mode-menu emacs-lisp-mode-map
"Menu for Emacs Lisp mode."
'("Emacs-Lisp"
["Indent Line" lisp-indent-line]
["Indent Region" indent-region
:help "Indent each nonblank line in the region"
:active mark-active]
["Comment Out Region" comment-region
:help "Comment or uncomment each line in the region"
:active mark-active]
"---"
["Evaluate Last S-expression" eval-last-sexp
:help "Evaluate sexp before point; print value in echo area"]
["Evaluate Region" eval-region
:help "Execute the region as Lisp code"
:active mark-active]
["Evaluate Buffer" eval-buffer
:help "Execute the current buffer as Lisp code"]
["Interactive Expression Evaluation" ielm
:help "Interactively evaluate Emacs Lisp expressions"]
"---"
["Byte-compile This File" emacs-lisp-byte-compile
:help "Byte compile the file containing the current buffer"]
["Byte-compile and Load" emacs-lisp-byte-compile-and-load
:help "Byte-compile the current file (if it has changed), then load compiled code"]
["Byte-recompile Directory..." byte-recompile-directory
:help "Recompile every `.el' file in DIRECTORY that needs recompilation"]
["Native-compile This File" emacs-lisp-native-compile
:help "Compile this buffer's file to native code"
:active (native-comp-available-p)]
["Native-compile and Load" emacs-lisp-native-compile-and-load
:help "Compile this buffer's file to native code, then load compiled native code"
:active (native-comp-available-p)]
["Disassemble Byte Compiled Object..." disassemble
:help "Print disassembled code for OBJECT in a buffer"]
"---"
["Instrument Function for Debugging" edebug-defun
:help "Evaluate the top level form point is in, stepping through with Edebug"
:keys "C-u C-M-x"]
("Navigation"
["Forward Sexp" forward-sexp
:help "Go to the next s-expression"]
["Backward Sexp" backward-sexp
:help "Go to the previous s-expression"]
["Beginning Of Defun" beginning-of-defun
:help "Go to the start of the current function definition"]
["Up List" up-list
:help "Go one level up and forward"])
("Linting"
["Lint Defun" elint-defun
:help "Lint the function at point"]
["Lint Buffer" elint-current-buffer
:help "Lint the current buffer"]
["Lint File..." elint-file
:help "Lint a file"]
["Lint Directory..." elint-directory
:help "Lint a directory"])
("Profiling"
;; Maybe this should be in a separate submenu from the ELP stuff?
["Start Native Profiler..." profiler-start
:help "Start recording profiling information"]
["Show Profiler Report" profiler-report
:help "Show the current profiler report"
:active (and (featurep 'profiler)
(profiler-running-p))]
["Stop Native Profiler" profiler-stop
:help "Stop recording profiling information"
:active (and (featurep 'profiler)
(profiler-running-p))]
"---"
["Instrument Function..." elp-instrument-function
:help "Instrument a function for profiling"]
["Instrument Package..." elp-instrument-package
:help "Instrument for profiling all function that start with a prefix"]
["Show Profiling Results" elp-results
:help "Display current profiling results"]
["Reset Counters for Function..." elp-reset-function
:help "Reset the profiling information for a function"]
["Reset Counters for All Functions" elp-reset-all
:help "Reset the profiling information for all functions being profiled"]
"---"
["Remove Instrumentation for All Functions" elp-restore-all
:help "Restore the original definitions of all functions being profiled"]
["Remove Instrumentation for Function..." elp-restore-function
:help "Restore an instrumented function to its original definition"])
("Tracing"
["Trace Function..." trace-function
:help "Trace the function given as an argument"]
["Trace Function Quietly..." trace-function-background
:help "Trace the function with trace output going quietly to a buffer"]
"---"
["Untrace All" untrace-all
:help "Untrace all currently traced functions"]
["Untrace Function..." untrace-function
:help "Untrace function, and possibly activate all remaining advice"])
["Construct Regexp" re-builder
:help "Construct a regexp interactively"]
["Check Documentation Strings" checkdoc
:help "Check documentation strings for style requirements"]
["Auto-Display Documentation Strings" eldoc-mode
:help "Display the documentation string for the item under cursor"
:style toggle
:selected (bound-and-true-p eldoc-mode)]))
(defun elisp-context-menu (menu click)
"Populate MENU with symbol help commands at CLICK."
(when (thing-at-mouse click 'symbol)
(define-key-after menu [elisp-separator] menu-bar-separator
'middle-separator)
(let* ((string (thing-at-mouse click 'symbol t))
(symbol (when (stringp string) (intern string)))
(title (cond
((not (symbolp symbol)) nil)
((and (facep symbol) (not (fboundp symbol)))
"Face")
((and (fboundp symbol)
(not (or (boundp symbol) (facep symbol))))
"Function")
((and (boundp symbol)
(not (or (fboundp symbol) (facep symbol))))
"Variable")
((or (fboundp symbol) (boundp symbol) (facep symbol))
"Symbol"))))
(when title
(define-key-after menu [info-lookup-symbol]
`(menu-item "Look up in Manual"
(lambda (_click) (interactive "e")
(info-lookup-symbol ',symbol))
:help ,(format "Find `%s' in relevant manual" symbol))
'elisp-separator)
(define-key-after menu [describe-symbol]
`(menu-item (format "Describe %s" ,title)
(lambda (_click) (interactive "e")
(describe-symbol ',symbol))
:help ,(format "Display the documentation of `%s'" symbol))
'elisp-separator))))
menu)
(defun emacs-lisp-byte-compile ()
"Byte-compile the current buffer's file."
(interactive nil emacs-lisp-mode)
(if buffer-file-name
(byte-compile-file buffer-file-name)
(error "The buffer must be saved in a file first")))
(defun emacs-lisp--before-compile-buffer ()
"Make sure the buffer is saved before compiling."
(or buffer-file-name
(error "The buffer must be saved in a file first"))
;; Recompile if file or buffer has changed since last compilation.
(if (and (buffer-modified-p)
(y-or-n-p (format "Save buffer %s first? " (buffer-name))))
(save-buffer)))
(defun emacs-lisp-byte-compile-and-load ()
"Byte-compile the current file (if it has changed), then load compiled code."
(interactive nil emacs-lisp-mode)
(emacs-lisp--before-compile-buffer)
(require 'bytecomp)
(byte-recompile-file buffer-file-name nil 0)
(load (byte-compile-dest-file buffer-file-name)))
(declare-function native-compile "comp")
(declare-function comp--write-bytecode-file "comp")
(defun emacs-lisp-native-compile ()
"Native-compile the current buffer's file (if it has changed).
This invokes a synchronous native-compilation of the file that is
visited by the current buffer."
(interactive nil emacs-lisp-mode)
(emacs-lisp--before-compile-buffer)
(let* ((byte+native-compile t)
(byte-to-native-output-buffer-file nil)
(eln (native-compile buffer-file-name)))
(when eln
(comp--write-bytecode-file eln))))
(defun emacs-lisp-native-compile-and-load ()
"Native-compile the current buffer's file (if it has changed), then load it.
This invokes a synchronous native-compilation of the file that is
visited by the current buffer, then loads the compiled native code
when the compilation is finished.
Use `emacs-lisp-byte-compile-and-load' in combination with
`native-comp-jit-compilation' set to t to achieve asynchronous
native compilation of the current buffer's file."
(interactive nil emacs-lisp-mode)
(when-let* ((byte-file (emacs-lisp-native-compile)))
(load (file-name-sans-extension byte-file))))
(defun emacs-lisp-macroexpand ()
"Macroexpand the form after point.
Comments in the form will be lost."
(interactive)
(let* ((start (point))
(exp (read (current-buffer)))
;; Compute it before, since it may signal errors.
(new (macroexpand-1 exp)))
(if (equal exp new)
(message "Not a macro call, nothing to expand")
(delete-region start (point))
(pp new (current-buffer))
(if (bolp) (delete-char -1))
(indent-region start (point)))))
(defun elisp-mode-syntax-propertize (start end)
(goto-char start)
(let ((case-fold-search nil))
(funcall
(syntax-propertize-rules
;; Empty symbol.
("##" (0 (unless (nth 8 (syntax-ppss))
(string-to-syntax "_"))))
;; Prevent the @ from becoming part of a following symbol.
(",@" (0 (unless (nth 8 (syntax-ppss))
(string-to-syntax "'"))))
;; Unicode character names. (The longest name is 88 characters
;; long.)
("\\?\\\\N{[-A-Za-z0-9 ]\\{,100\\}}"
(0 (unless (nth 8 (syntax-ppss))
(string-to-syntax "_"))))
((rx "#" (or (seq (group-n 1 "&" (+ digit)) ?\") ; Bool-vector.
(seq (group-n 1 "s") "(") ; Record.
(seq (group-n 1 (+ "^")) "["))) ; Char-table.
(1 (unless (save-excursion (nth 8 (syntax-ppss (match-beginning 0))))
(string-to-syntax "'")))))
start end)))
(defcustom emacs-lisp-mode-hook nil
"Hook run when entering Emacs Lisp mode."
:options '(eldoc-mode imenu-add-menubar-index checkdoc-minor-mode)
:type 'hook
:group 'lisp)
(defun emacs-lisp-set-electric-text-pairs ()
"Set `electric-pair-text-pairs' for all `emacs-lisp-mode' buffers."
(defvar electric-pair-text-pairs)
(let ((elisp-pairs (append '((?\` . ?\') (?‘ . ?’))
electric-pair-text-pairs)))
(save-current-buffer
(dolist (buf (buffer-list))
(set-buffer buf)
(when (derived-mode-p 'emacs-lisp-mode)
(setq-local electric-pair-text-pairs elisp-pairs)))))
(remove-hook 'electric-pair-mode-hook #'emacs-lisp-set-electric-text-pairs))
(defun elisp-enable-lexical-binding (&optional interactive)
"Make the current buffer use `lexical-binding'.
INTERACTIVE non-nil means ask the user for confirmation; this
happens in interactive invocations."
(interactive "p")
(if (and (local-variable-p 'lexical-binding) lexical-binding)
(when interactive
(message "lexical-binding already enabled!")
(ding))
(when (or (not interactive)
(y-or-n-p (format "Enable lexical-binding in this %s? "
(if buffer-file-name "file" "buffer"))))
(setq-local lexical-binding t)
(add-file-local-variable-prop-line 'lexical-binding t interactive))))
(defvar-keymap elisp--dynlex-modeline-map
"<mode-line> <mouse-1>" #'elisp-enable-lexical-binding)
;;;###autoload
(define-derived-mode emacs-lisp-mode lisp-data-mode
`("ELisp"
(lexical-binding (:propertize "/l"
help-echo "Using lexical-binding mode")
(:propertize "/d"
help-echo "Using old dynamic scoping mode\n\
mouse-1: Enable lexical-binding mode"
face warning
mouse-face mode-line-highlight
local-map ,elisp--dynlex-modeline-map)))
"Major mode for editing Lisp code to run in Emacs.
Commands:
Delete converts tabs to spaces as it moves back.
Blank lines separate paragraphs. Semicolons start comments.
When editing Lisp data (as opposed to code), `lisp-data-mode' can
be used instead.
\\{emacs-lisp-mode-map}"
:group 'lisp
(defvar project-vc-external-roots-function)
(setcar font-lock-defaults
'(lisp-el-font-lock-keywords
lisp-el-font-lock-keywords-1
lisp-el-font-lock-keywords-2))
(setf (nth 2 font-lock-defaults) nil)
(add-hook 'after-load-functions #'elisp--font-lock-flush-elisp-buffers)
(if (boundp 'electric-pair-text-pairs)
(setq-local electric-pair-text-pairs
(append '((?\` . ?\') (?\‘ . ?\’))
electric-pair-text-pairs))
(add-hook 'electric-pair-mode-hook #'emacs-lisp-set-electric-text-pairs))
(add-hook 'eldoc-documentation-functions
#'elisp-eldoc-funcall nil t)
(add-hook 'eldoc-documentation-functions
#'elisp-eldoc-var-docstring nil t)
(add-hook 'xref-backend-functions #'elisp--xref-backend nil t)
(setq-local project-vc-external-roots-function #'elisp-load-path-roots)
(setq-local syntax-propertize-function #'elisp-mode-syntax-propertize)
(add-hook 'completion-at-point-functions
#'elisp-completion-at-point nil 'local)
(add-hook 'flymake-diagnostic-functions #'elisp-flymake-checkdoc nil t)
(add-hook 'flymake-diagnostic-functions
#'elisp-flymake-byte-compile nil t)
(add-hook 'context-menu-functions #'elisp-context-menu 10 t))
;; Font-locking support.
(defun elisp--font-lock-shorthand (_limit)
;; Add faces on shorthands between point and LIMIT.
;; ...
;; Return nil to tell font-lock, that there's nothing left to do.
nil)
(defun elisp--font-lock-flush-elisp-buffers (&optional file)
;; We're only ever called from after-load-functions, load-in-progress can
;; still be t in case of nested loads.
(when (or (not load-in-progress) file)
;; FIXME: If the loaded file did not define any macros, there shouldn't
;; be any need to font-lock-flush all the Elisp buffers.
(dolist (buf (buffer-list))
(with-current-buffer buf
(when (derived-mode-p 'emacs-lisp-mode)
;; So as to take into account new macros that may have been defined
;; by the just-loaded file.
(font-lock-flush))))))
;;; Completion at point for Elisp
(defun elisp--local-variables-1 (vars sexp)
"Return VARS locally bound around the witness, or nil if not found."
(let (res)
(while
(unless
(setq res
(pcase sexp
(`(,(or 'let 'let*) ,bindings)
(let ((vars vars))
(when (eq 'let* (car sexp))
(dolist (binding (cdr (reverse bindings)))
(push (or (car-safe binding) binding) vars)))
(elisp--local-variables-1
vars (car (cdr-safe (car (last bindings)))))))
(`(,(or 'let 'let*) ,bindings . ,body)
(let ((vars vars))
(dolist (binding bindings)
(push (or (car-safe binding) binding) vars))
(elisp--local-variables-1 vars (car (last body)))))
(`(lambda ,_args)
;; FIXME: Look for the witness inside `args'.
(setq sexp nil))
(`(lambda ,args . ,body)
(elisp--local-variables-1
(let ((args (if (listp args) args)))
;; FIXME: Exit the loop if witness is in args.
(append (remq '&optional (remq '&rest args)) vars))
(car (last body))))
(`(condition-case ,_ ,e) (elisp--local-variables-1 vars e))
(`(condition-case ,v ,_ . ,catches)
(elisp--local-variables-1
(cons v vars) (cdr (car (last catches)))))
(`(quote . ,_)
;; FIXME: Look for the witness inside sexp.
(setq sexp nil))
;; FIXME: Handle `cond'.
(`(,_ . ,_)
(elisp--local-variables-1 vars (car (last sexp))))
('elisp--witness--lisp (or vars '(nil)))
(_ nil)))
;; We didn't find the witness in the last element so we try to
;; backtrack to the last-but-one.
(setq sexp (ignore-errors (butlast sexp)))))
res))
(defvar warning-minimum-log-level)
(defvar elisp--local-macroenv
`((cl-eval-when . ,(lambda (&rest args) `(progn . ,(cdr args))))
(eval-when-compile . ,(lambda (&rest args) `(progn . ,args)))
(eval-and-compile . ,(lambda (&rest args) `(progn . ,args))))
"Environment to use while tentatively expanding macros.
This is used to try and avoid the most egregious problems linked to the
use of `macroexpand-all' as a way to find the \"underlying raw code\".")
(defun elisp--local-variables ()
"Return a list of locally let-bound variables at point."
(save-excursion
(skip-syntax-backward "w_")
(let* ((ppss (syntax-ppss))
(txt (buffer-substring-no-properties (or (car (nth 9 ppss)) (point))
(or (nth 8 ppss) (point))))
(closer ()))
(dolist (p (nth 9 ppss))
(push (cdr (syntax-after p)) closer))
(setq closer (apply #'string closer))
(let* ((sexp (condition-case nil
(car (read-from-string
(concat txt "elisp--witness--lisp" closer)))
((invalid-read-syntax end-of-file) nil)))
(macroexpand-advice
(lambda (expander form &rest args)
(condition-case err
(apply expander form args)
(error
(message "Ignoring macroexpansion error: %S" err) form))))
(sexp
(unwind-protect
;; Silence any macro expansion errors when
;; attempting completion at point (bug#58148).
(let ((inhibit-message t)
(macroexp-inhibit-compiler-macros t)
(warning-minimum-log-level :emergency))
(advice-add 'macroexpand-1 :around macroexpand-advice)
(macroexpand-all sexp elisp--local-macroenv))
(advice-remove 'macroexpand-1 macroexpand-advice)))
(vars (elisp--local-variables-1 nil sexp)))
(delq nil
(mapcar (lambda (var)
(and (symbolp var)
(not (string-match (symbol-name var) "\\`[&_]"))
;; Eliminate uninterned vars.
(intern-soft var)
var))
vars))))))
(defvar elisp--local-variables-completion-table
;; Use `defvar' rather than `defconst' since defconst would purecopy this
;; value, which would doubly fail: it would fail because purecopy can't
;; handle the recursive bytecode object, and it would fail because it would
;; move `lastpos' and `lastvars' to pure space where they'd be immutable!
(let ((lastpos nil) (lastvars nil))
(letrec ((hookfun (lambda ()
(setq lastpos nil)
(remove-hook 'post-command-hook hookfun))))
(completion-table-dynamic
(lambda (_string)
(save-excursion
(skip-syntax-backward "_w")
(let ((newpos (cons (point) (current-buffer))))
(unless (equal lastpos newpos)
(add-hook 'post-command-hook hookfun)
(setq lastpos newpos)
(setq lastvars
(mapcar #'symbol-name (elisp--local-variables))))))
lastvars)))))
(defun elisp--expect-function-p (pos)
"Return non-nil if the symbol at position POS is expected to be a function."
(or
(and (eq (char-before pos) ?')
(eq (char-before (1- pos)) ?#))
(save-excursion
(let ((parent (nth 1 (syntax-ppss pos))))
(when parent
(goto-char parent)
(and
(looking-at (concat "(\\(cl-\\)?"
(regexp-opt '("declare-function"
"function" "defadvice"
"callf" "callf2"
"defsetf"))
"[ \t\r\n]+"))
(eq (match-end 0) pos)))))))
(defun elisp--form-quoted-p (pos)
"Return non-nil if the form at POS is not evaluated.
It can be quoted, or be inside a quoted form."
;; FIXME: Do some macro expansion maybe.
(save-excursion
(let ((state (syntax-ppss pos)))
(or (nth 8 state) ; Code inside strings usually isn't evaluated.
;; FIXME: The 9th element is undocumented.
(let ((nesting (cons (point) (reverse (nth 9 state))))
res)
(while (and nesting (not res))
(goto-char (pop nesting))
(cond
((or (eq (char-after) ?\[)
(progn
(skip-chars-backward " ")
(memq (char-before) '(?' ?` ?‘))))
(setq res t))
((eq (char-before) ?,)
(setq nesting nil))))
res)))))
;; FIXME: Support for Company brings in features which straddle eldoc.
;; We should consolidate this, so that major modes can provide all that
;; data all at once:
;; - a function to extract "the reference at point" (may be more complex
;; than a mere string, to distinguish various namespaces).
;; - a function to jump to such a reference.
;; - a function to show the signature/interface of such a reference.
;; - a function to build a help-buffer about that reference.
;; FIXME: Those functions should also be used by the normal completion code in
;; the *Completions* buffer.
(defun elisp--company-doc-buffer (str)
(let ((symbol (intern-soft str)))
;; FIXME: we really don't want to "display-buffer and then undo it".
(save-window-excursion
;; Make sure we don't display it in another frame, otherwise
;; save-window-excursion won't be able to undo it.
(let ((display-buffer-overriding-action
'(nil . ((inhibit-switch-frame . t)))))
(ignore-errors
(cond
((fboundp symbol) (describe-function symbol))
((boundp symbol) (describe-variable symbol))
((featurep symbol) (describe-package symbol))
((facep symbol) (describe-face symbol))
(t (signal 'user-error nil)))
(help-buffer))))))
(defun elisp--company-doc-string (str)
(let* ((symbol (intern-soft str))
(doc (if (fboundp symbol)
(documentation symbol t)
(documentation-property symbol 'variable-documentation t))))
(and (stringp doc)
(string-match ".*$" doc)
(match-string 0 doc))))
;; can't (require 'find-func) in a preloaded file
(declare-function find-library-name "find-func" (library))
(declare-function find-function-library "find-func" (function &optional l-o v))
(defun elisp--company-location (str)
(let ((sym (intern-soft str)))
(cond
((fboundp sym) (find-definition-noselect sym nil))
((boundp sym) (find-definition-noselect sym 'defvar))
((featurep sym)
(require 'find-func)
(cons (find-file-noselect (find-library-name
(symbol-name sym)))
0))
((facep sym) (find-definition-noselect sym 'defface)))))
(defvar obarray-cache nil
"If non-nil, a hash table of cached obarray-related information.
The cache holds information specific to the current state of the
Elisp obarray. If the obarray is modified by any means (such as
interning or uninterning a symbol), this variable is set to nil.")
(defun elisp--completion-local-symbols ()
"Compute collections of all Elisp symbols for completion purposes.
The return value is compatible with the COLLECTION form described
in `completion-at-point-functions' (which see)."
(cl-flet ((obarray-plus-shorthands ()
(let (retval)
(mapatoms
(lambda (s)
(push s retval)
(cl-loop
for (shorthand . longhand) in read-symbol-shorthands
for full-name = (symbol-name s)
when (string-prefix-p longhand full-name)
do (let ((sym (make-symbol
(concat shorthand
(substring full-name
(length longhand))))))
(put sym 'shorthand t)
(push sym retval)
retval))))
retval)))
(cond ((null read-symbol-shorthands) obarray)
((and obarray-cache
(gethash (cons (current-buffer) read-symbol-shorthands)
obarray-cache)))
(obarray-cache
(puthash (cons (current-buffer) read-symbol-shorthands)
(obarray-plus-shorthands)
obarray-cache))
(t
(setq obarray-cache (make-hash-table :test #'equal))
(puthash (cons (current-buffer) read-symbol-shorthands)
(obarray-plus-shorthands)
obarray-cache)))))
(defun elisp--shorthand-aware-fboundp (sym)
(fboundp (intern-soft (symbol-name sym))))
(defun elisp--shorthand-aware-boundp (sym)
(boundp (intern-soft (symbol-name sym))))
(defun elisp-completion-at-point ()
"Function used for `completion-at-point-functions' in `emacs-lisp-mode'.
If the context at point allows only a certain category of
symbols (e.g. functions, or variables) then the returned
completions are restricted to that category. In contexts where
any symbol is possible (following a quote, for example),
functions are annotated with \"<f>\" via the
`:annotation-function' property."
(with-syntax-table emacs-lisp-mode-syntax-table
(let* ((pos (point))
(beg (condition-case nil
(save-excursion
(backward-sexp 1)
(skip-chars-forward "`',‘#")
(min (point) pos))
(scan-error pos)))
(end
(cond
((and (< beg (point-max))
(memq (char-syntax (char-after beg))
'(?w ?\\ ?_)))
(condition-case nil
(save-excursion
(goto-char beg)
(forward-sexp 1)
(skip-chars-backward "'’")
(when (>= (point) pos)
(point)))
(scan-error pos)))
((or (>= beg (point-max))
(memq (char-syntax (char-after beg))
'(?\) ?\s)))
beg)))
;; t if in function position.
(funpos (eq (char-before beg) ?\())
(quoted (elisp--form-quoted-p beg))
(is-ignore-error
(condition-case nil
(save-excursion
(up-list -1)
(forward-char 1)
(looking-at-p "ignore-error\\>"))
(error nil))))
(when (and end (or (not (nth 8 (syntax-ppss)))
(memq (char-before beg) '(?` ?‘))))
(let ((table-etc
(if (or (not funpos) quoted)
(cond
;; FIXME: We could look at the first element of
;; the current form and use it to provide a more
;; specific completion table in more cases.
(is-ignore-error
(list t (elisp--completion-local-symbols)
:predicate (lambda (sym)
(get sym 'error-conditions))))
((elisp--expect-function-p beg)
(list nil (elisp--completion-local-symbols)
:predicate
#'elisp--shorthand-aware-fboundp
:company-kind #'elisp--company-kind
:company-doc-buffer #'elisp--company-doc-buffer
:company-docsig #'elisp--company-doc-string
:company-location #'elisp--company-location
:company-deprecated #'elisp--company-deprecated))
(quoted
(list nil (elisp--completion-local-symbols)
;; Don't include all symbols (bug#16646).
:predicate (lambda (sym)
;; shorthand-aware
(let ((sym (intern-soft (symbol-name sym))))
(or (boundp sym)
(fboundp sym)
(featurep sym)
(symbol-plist sym))))
:annotation-function
(lambda (str) (if (fboundp (intern-soft str)) " <f>"))
:company-kind #'elisp--company-kind
:company-doc-buffer #'elisp--company-doc-buffer
:company-docsig #'elisp--company-doc-string
:company-location #'elisp--company-location
:company-deprecated #'elisp--company-deprecated))
(t
(list nil (completion-table-merge
elisp--local-variables-completion-table
(apply-partially #'completion-table-with-predicate
(elisp--completion-local-symbols)
#'elisp--shorthand-aware-boundp
'strict))
:company-kind
(lambda (s)
(if (test-completion s elisp--local-variables-completion-table)
'value
'variable))
:company-doc-buffer #'elisp--company-doc-buffer
:company-docsig #'elisp--company-doc-string
:company-location #'elisp--company-location
:company-deprecated #'elisp--company-deprecated)))
;; Looks like a funcall position. Let's double check.
(save-excursion
(goto-char (1- beg))
(let ((parent
(condition-case nil
(progn (up-list -1) (forward-char 1)
(let ((c (char-after)))
(if (eq c ?\() ?\(
(if (memq (char-syntax c) '(?w ?_))
(let ((pt (point)))
(forward-sexp)
(intern-soft
(buffer-substring pt (point))))))))
(error nil))))
(pcase parent
;; FIXME: Rather than hardcode special cases here,
;; we should use something like a symbol-property.
('declare
(list t (mapcar (lambda (x) (symbol-name (car x)))
(delete-dups
;; FIXME: We should include some
;; docstring with each entry.
(append macro-declarations-alist
defun-declarations-alist
nil))))) ; Copy both alists.
((and (or 'condition-case 'condition-case-unless-debug)
(guard (save-excursion
(ignore-errors
(forward-sexp 2)
(< (point) beg)))))
(list t (elisp--completion-local-symbols)
:predicate (lambda (sym) (get sym 'error-conditions))))
;; `ignore-error' with a list CONDITION parameter.
('ignore-error
(list t (elisp--completion-local-symbols)
:predicate (lambda (sym)
(get sym 'error-conditions))))
((and (or ?\( 'let 'let* 'cond 'cond* 'bind*)
(guard (save-excursion
(goto-char (1- beg))
(when (eq parent ?\()
(up-list -1))
(skip-syntax-backward " w_")
(or
(looking-at
"\\_<\\(let\\*?\\|bind\\*\\)\\_>")
(and (not (eq parent ?\())
(looking-at
"\\_<cond\\*?\\_>"))))))
(list t (elisp--completion-local-symbols)
:predicate #'elisp--shorthand-aware-boundp
:company-kind (lambda (_) 'variable)
:company-doc-buffer #'elisp--company-doc-buffer
:company-docsig #'elisp--company-doc-string
:company-location #'elisp--company-location
:company-deprecated #'elisp--company-deprecated))
(_ (list nil (elisp--completion-local-symbols)
:predicate #'elisp--shorthand-aware-fboundp
:company-kind #'elisp--company-kind
:company-doc-buffer #'elisp--company-doc-buffer
:company-docsig #'elisp--company-doc-string
:company-location #'elisp--company-location
:company-deprecated #'elisp--company-deprecated
))))))))
(nconc (list beg end)
(if (null (car table-etc))
(cdr table-etc)
(cons
(if (memq (char-syntax (or (char-after end) ?\s))
'(?\s ?>))
(cadr table-etc)
(apply-partially 'completion-table-with-terminator
" " (cadr table-etc)))
(cddr table-etc)))))))))
(defun elisp--company-kind (str)
(let ((sym (intern-soft str)))
(cond
((or (macrop sym) (special-form-p sym)) 'keyword)
((fboundp sym) 'function)
((boundp sym) 'variable)
((featurep sym) 'module)
((facep sym) 'color)
(t 'text))))
(defun elisp--company-deprecated (str)
(let ((sym (intern-soft str)))
(or (get sym 'byte-obsolete-variable)
(get sym 'byte-obsolete-info))))
(defun lisp-completion-at-point (&optional _predicate)
(declare (obsolete elisp-completion-at-point "25.1"))
(elisp-completion-at-point))
;;; Xref backend
(declare-function xref-make "progmodes/xref" (summary location))
(declare-function xref-item-location "progmodes/xref" (this))
(defun elisp--xref-backend () 'elisp)
;; WORKAROUND: This is nominally a constant, but the text properties
;; are not preserved thru dump if use defconst. See bug#21237.
(defvar elisp--xref-format
#("(%s %s)"
1 3 (face font-lock-keyword-face)
4 6 (face font-lock-function-name-face)))
;; WORKAROUND: This is nominally a constant, but the text properties
;; are not preserved thru dump if use defconst. See bug#21237.
(defvar elisp--xref-format-extra
#("(%s %s %s)"
1 3 (face font-lock-keyword-face)
4 6 (face font-lock-function-name-face)))
(defvar find-feature-regexp);; in find-func.el
(defun elisp--xref-make-xref (type symbol file &optional summary)
"Return an xref for TYPE SYMBOL in FILE.
TYPE must be a type in `find-function-regexp-alist' (use nil for
`defun'). If SUMMARY is non-nil, use it for the summary;
otherwise build the summary from TYPE and SYMBOL."
(xref-make (or summary
(format elisp--xref-format (or type 'defun) symbol))
(xref-make-elisp-location symbol type file)))
(defvar elisp-xref-find-def-functions nil
"List of functions run from `elisp--xref-find-definitions' to add more xrefs.
Called with one arg; the symbol whose definition is desired.
Each function should return a list of xrefs, or nil; the first
non-nil result supersedes the xrefs produced by
`elisp--xref-find-definitions'.")
(defun elisp--xref-list-index ()
"Return the list index of the form at point, moving to the start.
If the buffer start was reached, return nil."
(let ((i 0))
(while (condition-case nil
(let ((pt (point)))
(backward-sexp)
(< (point) pt))
(scan-error nil))
(setq i (1+ i)))
(and (not (bobp)) i)))
(defun elisp--xref-infer-namespace (pos)
"Find the likely namespace of the identifier at POS.
Return one of `function', `variable' `maybe-variable', `feature', `face', or
`any' (indicating any namespace). `maybe-variable' indicates a variable
namespace but with lower confidence."
(save-excursion
(goto-char pos)
(cl-flet ((looking-at-sym ()
(let ((val (save-excursion
(ignore-errors (read (current-buffer))))))
(and (symbolp val) val))))
(cond
((and (eq (char-before pos) ?\')
(eq (char-before (1- pos)) ?#))
;; #'IDENT
'function)
((memq (char-before pos) '(?\' ?`))
;; 'IDENT or `IDENT -- try to disambiguate.
(backward-char) ; Step over '
(let ((i (elisp--xref-list-index))
(sym (looking-at-sym)))
(cond
((eql i 1)
(cond
((memq sym '( featurep require provide))
'feature)
((memq sym
'(
;; We are mostly interested in functions that take a
;; function symbol as argument:
fboundp symbol-function fset
;; ... but we include some common higher-order functions
;; as well, even though the argument really should
;; be #'-quoted:
function-get function-put
func-arity functionp
funcall funcall-interactively
apply mapcar mapc mapcan mapconcat
apply-partially
substitute-key-definition))
'function)
((memq sym
'(
;; Functions taking a variable symbol as first argument.
;; More of these could be added for greater precision.
boundp set symbol-value
special-variable-p local-variable-p
local-variable-if-set-p
make-variable-buffer-local
default-value set-default make-local-variable
buffer-local-value))
'variable)
((memq sym
'(
;; FIXME: Add more functions taking a face
;; symbol for greater precision.
facep face-name face-id))
'face)
(t 'any)))
((and (eql i 2)
(memq sym '( global-set-key local-set-key
substitute-key-definition
add-hook)))
'function)
((and (eql i 3)
(memq sym '( define-key add-function)))
'function)
(t 'any))))
((or (and (eq (char-before (1- pos)) ?,)
(eq (char-before pos) ?@))
(eq (char-before pos) ?,))
;; ,IDENT or ,@IDENT
'variable)
(t
;; Unquoted name -- look at the context. General scheme:
;; (K-HEAD ... (J-HEAD ... (I-HEAD ... IDENT
;; ^ index K ^ index J ^ index I
(let* ((i (elisp--xref-list-index))
(i-head (looking-at-sym))
(i-paren (and i (eq (char-before) ?\()
(progn (backward-char) t)))
(i-quoted (and i-paren (memq (char-before) '(?\' ?`))))
(j (and i-paren (elisp--xref-list-index)))
(j-head (and j (looking-at-sym)))
(j-paren (and j (eq (char-before) ?\()
(progn (backward-char) t)))
(j-quoted (and j-paren (memq (char-before) '(?\' ?`))))
(k (and j-paren (elisp--xref-list-index)))
(k-head (and k (looking-at-sym)))
(k-paren (and k (eq (char-before) ?\()
(progn (backward-char) t)))
(k-quoted (and k-paren (memq (char-before) '(?\' ?`)))))
(cond
((or i-quoted j-quoted k-quoted)
;; '(... IDENT or '(... (... IDENT or '(... (... (... IDENT
'any)
((and (eql j 1)
(memq j-head '( let let* letrec dlet lambda)))
;; (let (... IDENT
'variable)
((and (eql j 2)
(memq j-head '( defun defmacro defsubst
define-inline declare-function
defadvice
cl-defmethod cl-defgeneric)))
;; (defun FUNC (... IDENT