1 ;;; elisp-mode.el --- Emacs Lisp mode -*- lexical-binding:t -*-
3 ;; Copyright (C) 1985-1986, 1999-2017 Free Software Foundation, Inc.
5 ;; Maintainer: emacs-devel@gnu.org
6 ;; Keywords: lisp, languages
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
26 ;; The major mode for editing Emacs Lisp code.
27 ;; This mode is documented in the Emacs manual.
33 (eval-when-compile (require 'cl-lib
))
35 (define-abbrev-table 'emacs-lisp-mode-abbrev-table
()
36 "Abbrev table for Emacs Lisp mode.
37 It has `lisp-mode-abbrev-table' as its parent."
38 :parents
(list lisp-mode-abbrev-table
))
40 (defvar emacs-lisp-mode-syntax-table
41 (let ((table (make-syntax-table lisp--mode-syntax-table
)))
42 (modify-syntax-entry ?\
[ "(] " table
)
43 (modify-syntax-entry ?\
] ")[ " table
)
45 "Syntax table used in `emacs-lisp-mode'.")
47 (defvar emacs-lisp-mode-map
48 (let ((map (make-sparse-keymap "Emacs-Lisp"))
49 (menu-map (make-sparse-keymap "Emacs-Lisp"))
50 (lint-map (make-sparse-keymap))
51 (prof-map (make-sparse-keymap))
52 (tracing-map (make-sparse-keymap)))
53 (set-keymap-parent map lisp-mode-shared-map
)
54 (define-key map
"\e\t" 'completion-at-point
)
55 (define-key map
"\e\C-x" 'eval-defun
)
56 (define-key map
"\e\C-q" 'indent-pp-sexp
)
57 (bindings--define-key map
[menu-bar emacs-lisp
]
58 (cons "Emacs-Lisp" menu-map
))
59 (bindings--define-key menu-map
[eldoc]
60 '(menu-item "Auto-Display Documentation Strings" eldoc-mode
61 :button (:toggle . (bound-and-true-p eldoc-mode))
62 :help "Display the documentation string for the item under cursor"))
63 (bindings--define-key menu-map [checkdoc]
64 '(menu-item "Check Documentation Strings" checkdoc
65 :help "Check documentation strings for style requirements"))
66 (bindings--define-key menu-map [re-builder]
67 '(menu-item "Construct Regexp" re-builder
68 :help "Construct a regexp interactively"))
69 (bindings--define-key menu-map [tracing] (cons "Tracing" tracing-map))
70 (bindings--define-key tracing-map [tr-a]
71 '(menu-item "Untrace All" untrace-all
72 :help "Untrace all currently traced functions"))
73 (bindings--define-key tracing-map [tr-uf]
74 '(menu-item "Untrace Function..." untrace-function
75 :help "Untrace function, and possibly activate all remaining advice"))
76 (bindings--define-key tracing-map [tr-sep] menu-bar-separator)
77 (bindings--define-key tracing-map [tr-q]
78 '(menu-item "Trace Function Quietly..." trace-function-background
79 :help "Trace the function with trace output going quietly to a buffer"))
80 (bindings--define-key tracing-map [tr-f]
81 '(menu-item "Trace Function..." trace-function
82 :help "Trace the function given as an argument"))
83 (bindings--define-key menu-map [profiling] (cons "Profiling" prof-map))
84 (bindings--define-key prof-map [prof-restall]
85 '(menu-item "Remove Instrumentation for All Functions" elp-restore-all
86 :help "Restore the original definitions of all functions being profiled"))
87 (bindings--define-key prof-map [prof-restfunc]
88 '(menu-item "Remove Instrumentation for Function..." elp-restore-function
89 :help "Restore an instrumented function to its original definition"))
91 (bindings--define-key prof-map [sep-rem] menu-bar-separator)
92 (bindings--define-key prof-map [prof-resall]
93 '(menu-item "Reset Counters for All Functions" elp-reset-all
94 :help "Reset the profiling information for all functions being profiled"))
95 (bindings--define-key prof-map [prof-resfunc]
96 '(menu-item "Reset Counters for Function..." elp-reset-function
97 :help "Reset the profiling information for a function"))
98 (bindings--define-key prof-map [prof-res]
99 '(menu-item "Show Profiling Results" elp-results
100 :help "Display current profiling results"))
101 (bindings--define-key prof-map [prof-pack]
102 '(menu-item "Instrument Package..." elp-instrument-package
103 :help "Instrument for profiling all function that start with a prefix"))
104 (bindings--define-key prof-map [prof-func]
105 '(menu-item "Instrument Function..." elp-instrument-function
106 :help "Instrument a function for profiling"))
107 ;; Maybe this should be in a separate submenu from the ELP stuff?
108 (bindings--define-key prof-map [sep-natprof] menu-bar-separator)
109 (bindings--define-key prof-map [prof-natprof-stop]
110 '(menu-item "Stop Native Profiler" profiler-stop
111 :help "Stop recording profiling information"
112 :enable (and (featurep 'profiler)
113 (profiler-running-p))))
114 (bindings--define-key prof-map [prof-natprof-report]
115 '(menu-item "Show Profiler Report" profiler-report
116 :help "Show the current profiler report"
117 :enable (and (featurep 'profiler)
118 (profiler-running-p))))
119 (bindings--define-key prof-map [prof-natprof-start]
120 '(menu-item "Start Native Profiler..." profiler-start
121 :help "Start recording profiling information"))
123 (bindings--define-key menu-map [lint] (cons "Linting" lint-map))
124 (bindings--define-key lint-map [lint-di]
125 '(menu-item "Lint Directory..." elint-directory
126 :help "Lint a directory"))
127 (bindings--define-key lint-map [lint-f]
128 '(menu-item "Lint File..." elint-file
129 :help "Lint a file"))
130 (bindings--define-key lint-map [lint-b]
131 '(menu-item "Lint Buffer" elint-current-buffer
132 :help "Lint the current buffer"))
133 (bindings--define-key lint-map [lint-d]
134 '(menu-item "Lint Defun" elint-defun
135 :help "Lint the function at point"))
136 (bindings--define-key menu-map [edebug-defun]
137 '(menu-item "Instrument Function for Debugging" edebug-defun
138 :help "Evaluate the top level form point is in, stepping through with Edebug"
140 (bindings--define-key menu-map [separator-byte] menu-bar-separator)
141 (bindings--define-key menu-map [disas]
142 '(menu-item "Disassemble Byte Compiled Object..." disassemble
143 :help "Print disassembled code for OBJECT in a buffer"))
144 (bindings--define-key menu-map [byte-recompile]
145 '(menu-item "Byte-recompile Directory..." byte-recompile-directory
146 :help "Recompile every `.el' file in DIRECTORY that needs recompilation"))
147 (bindings--define-key menu-map [emacs-byte-compile-and-load]
148 '(menu-item "Byte-compile and Load" emacs-lisp-byte-compile-and-load
149 :help "Byte-compile the current file (if it has changed), then load compiled code"))
150 (bindings--define-key menu-map [byte-compile]
151 '(menu-item "Byte-compile This File" emacs-lisp-byte-compile
152 :help "Byte compile the file containing the current buffer"))
153 (bindings--define-key menu-map [separator-eval] menu-bar-separator)
154 (bindings--define-key menu-map [ielm]
155 '(menu-item "Interactive Expression Evaluation" ielm
156 :help "Interactively evaluate Emacs Lisp expressions"))
157 (bindings--define-key menu-map [eval-buffer]
158 '(menu-item "Evaluate Buffer" eval-buffer
159 :help "Execute the current buffer as Lisp code"))
160 (bindings--define-key menu-map [eval-region]
161 '(menu-item "Evaluate Region" eval-region
162 :help "Execute the region as Lisp code"
163 :enable mark-active))
164 (bindings--define-key menu-map [eval-sexp]
165 '(menu-item "Evaluate Last S-expression" eval-last-sexp
166 :help "Evaluate sexp before point; print value in echo area"))
167 (bindings--define-key menu-map [separator-format] menu-bar-separator)
168 (bindings--define-key menu-map [comment-region]
169 '(menu-item "Comment Out Region" comment-region
170 :help "Comment or uncomment each line in the region"
171 :enable mark-active))
172 (bindings--define-key menu-map [indent-region]
173 '(menu-item "Indent Region" indent-region
174 :help "Indent each nonblank line in the region"
175 :enable mark-active))
176 (bindings--define-key menu-map [indent-line]
177 '(menu-item "Indent Line" lisp-indent-line))
179 "Keymap for Emacs Lisp mode.
180 All commands in `lisp-mode-shared-map' are inherited by this map.")
182 (defun emacs-lisp-byte-compile ()
183 "Byte compile the file containing the current buffer."
186 (byte-compile-file buffer-file-name)
187 (error "The buffer must be saved in a file first")))
189 (defun emacs-lisp-byte-compile-and-load ()
190 "Byte-compile the current file (if it has changed), then load compiled code."
193 (error "The buffer must be saved in a file first"))
195 ;; Recompile if file or buffer has changed since last compilation.
196 (if (and (buffer-modified-p)
197 (y-or-n-p (format "Save buffer %s first? " (buffer-name))))
199 (byte-recompile-file buffer-file-name nil 0 t))
201 (defun emacs-lisp-macroexpand ()
202 "Macroexpand the form after point.
203 Comments in the form will be lost."
205 (let* ((start (point))
206 (exp (read (current-buffer)))
207 ;; Compute it before, since it may signal errors.
208 (new (macroexpand-1 exp)))
210 (message "Not a macro call, nothing to expand")
211 (delete-region start (point))
212 (pp new (current-buffer))
213 (if (bolp) (delete-char -1))
214 (indent-region start (point)))))
216 (defcustom emacs-lisp-mode-hook nil
217 "Hook run when entering Emacs Lisp mode."
218 :options '(eldoc-mode imenu-add-menubar-index checkdoc-minor-mode)
223 (define-derived-mode emacs-lisp-mode prog-mode "Emacs-Lisp"
224 "Major mode for editing Lisp code to run in Emacs.
226 Delete converts tabs to spaces as it moves back.
227 Blank lines separate paragraphs. Semicolons start comments.
229 \\{emacs-lisp-mode-map}"
231 (defvar project-vc-external-roots-function)
232 (lisp-mode-variables nil nil 'elisp)
233 (add-hook 'after-load-functions #'elisp--font-lock-flush-elisp-buffers)
234 (unless noninteractive
236 (defvar electric-pair-text-pairs)
237 (setq-local electric-pair-text-pairs
238 (append '((?\` . ?\') (?‘ . ?’)) electric-pair-text-pairs))
239 (setq-local electric-quote-string t))
240 (setq imenu-case-fold-search nil)
241 (add-function :before-until (local 'eldoc-documentation-function)
242 #'elisp-eldoc-documentation-function)
243 (add-hook 'xref-backend-functions #'elisp--xref-backend nil t)
244 (setq-local project-vc-external-roots-function #'elisp-load-path-roots)
245 (add-hook 'completion-at-point-functions
246 #'elisp-completion-at-point nil 'local)
247 (add-hook 'flymake-diagnostic-functions #'elisp-flymake-checkdoc nil t)
248 (add-hook 'flymake-diagnostic-functions #'elisp-flymake-byte-compile nil t))
250 ;; Font-locking support.
252 (defun elisp--font-lock-flush-elisp-buffers (&optional file)
253 ;; We're only ever called from after-load-functions, load-in-progress can
254 ;; still be t in case of nested loads.
255 (when (or (not load-in-progress) file)
256 ;; FIXME: If the loaded file did not define any macros, there shouldn't
257 ;; be any need to font-lock-flush all the Elisp buffers.
258 (dolist (buf (buffer-list))
259 (with-current-buffer buf
260 (when (derived-mode-p 'emacs-lisp-mode)
261 ;; So as to take into account new macros that may have been defined
262 ;; by the just-loaded file.
263 (font-lock-flush))))))
265 ;;; Completion at point for Elisp
267 (defun elisp--local-variables-1 (vars sexp)
268 "Return the vars locally bound around the witness, or nil if not found."
274 (`(,(or `let `let*) ,bindings)
276 (when (eq 'let* (car sexp))
277 (dolist (binding (cdr (reverse bindings)))
278 (push (or (car-safe binding) binding) vars)))
279 (elisp--local-variables-1
280 vars (car (cdr-safe (car (last bindings)))))))
281 (`(,(or `let `let*) ,bindings . ,body)
283 (dolist (binding bindings)
284 (push (or (car-safe binding) binding) vars))
285 (elisp--local-variables-1 vars (car (last body)))))
287 ;; FIXME: Look for the witness inside `args'.
289 (`(lambda ,args . ,body)
290 (elisp--local-variables-1
291 (append (remq '&optional (remq '&rest args)) vars)
293 (`(condition-case ,_ ,e) (elisp--local-variables-1 vars e))
294 (`(condition-case ,v ,_ . ,catches)
295 (elisp--local-variables-1
296 (cons v vars) (cdr (car (last catches)))))
298 ;; FIXME: Look for the witness inside sexp.
300 ;; FIXME: Handle `cond'.
302 (elisp--local-variables-1 vars (car (last sexp))))
303 (`elisp--witness--lisp (or vars '(nil)))
305 ;; We didn't find the witness in the last element so we try to
306 ;; backtrack to the last-but-one.
307 (setq sexp (ignore-errors (butlast sexp)))))
310 (defvar warning-minimum-log-level)
312 (defun elisp--local-variables ()
313 "Return a list of locally let-bound variables at point."
315 (skip-syntax-backward "w_")
316 (let* ((ppss (syntax-ppss))
317 (txt (buffer-substring-no-properties (or (car (nth 9 ppss)) (point))
318 (or (nth 8 ppss) (point))))
320 (dolist (p (nth 9 ppss))
321 (push (cdr (syntax-after p)) closer))
322 (setq closer (apply #'string closer))
323 (let* ((sexp (condition-case nil
324 (car (read-from-string
325 (concat txt "elisp--witness--lisp" closer)))
326 ((invalid-read-syntax end-of-file) nil)))
327 (macroexpand-advice (lambda (expander form &rest args)
329 (apply expander form args)
333 (let ((warning-minimum-log-level :emergency))
334 (advice-add 'macroexpand :around macroexpand-advice)
335 (macroexpand-all sexp))
336 (advice-remove 'macroexpand macroexpand-advice)))
337 (vars (elisp--local-variables-1 nil sexp)))
339 (mapcar (lambda (var)
341 (not (string-match (symbol-name var) "\\`[&_]"))
342 ;; Eliminate uninterned vars.
347 (defvar elisp--local-variables-completion-table
348 ;; Use `defvar' rather than `defconst' since defconst would purecopy this
349 ;; value, which would doubly fail: it would fail because purecopy can't
350 ;; handle the recursive bytecode object, and it would fail because it would
351 ;; move `lastpos' and `lastvars' to pure space where they'd be immutable!
352 (let ((lastpos nil) (lastvars nil))
353 (letrec ((hookfun (lambda ()
355 (remove-hook 'post-command-hook hookfun))))
356 (completion-table-dynamic
359 (skip-syntax-backward "_w")
360 (let ((newpos (cons (point) (current-buffer))))
361 (unless (equal lastpos newpos)
362 (add-hook 'post-command-hook hookfun)
363 (setq lastpos newpos)
365 (mapcar #'symbol-name (elisp--local-variables))))))
368 (defun elisp--expect-function-p (pos)
369 "Return non-nil if the symbol at point is expected to be a function."
371 (and (eq (char-before pos) ?')
372 (eq (char-before (1- pos)) ?#))
374 (let ((parent (nth 1 (syntax-ppss pos))))
378 (looking-at (concat "(\\(cl-\\)?"
379 (regexp-opt '("declare-function"
380 "function" "defadvice"
384 (eq (match-end 0) pos)))))))
386 (defun elisp--form-quoted-p (pos)
387 "Return non-nil if the form at POS is not evaluated.
388 It can be quoted, or be inside a quoted form."
389 ;; FIXME: Do some macro expansion maybe.
391 (let ((state (syntax-ppss pos)))
392 (or (nth 8 state) ; Code inside strings usually isn't evaluated.
393 ;; FIXME: The 9th element is undocumented.
394 (let ((nesting (cons (point) (reverse (nth 9 state))))
396 (while (and nesting (not res))
397 (goto-char (pop nesting))
399 ((or (eq (char-after) ?\[)
401 (skip-chars-backward " ")
402 (memq (char-before) '(?' ?` ?‘))))
404 ((eq (char-before) ?,)
405 (setq nesting nil))))
408 ;; FIXME: Support for Company brings in features which straddle eldoc.
409 ;; We should consolidate this, so that major modes can provide all that
411 ;; - a function to extract "the reference at point" (may be more complex
412 ;; than a mere string, to distinguish various namespaces).
413 ;; - a function to jump to such a reference.
414 ;; - a function to show the signature/interface of such a reference.
415 ;; - a function to build a help-buffer about that reference.
416 ;; FIXME: Those functions should also be used by the normal completion code in
417 ;; the *Completions* buffer.
419 (defun elisp--company-doc-buffer (str)
420 (let ((symbol (intern-soft str)))
421 ;; FIXME: we really don't want to "display-buffer and then undo it".
422 (save-window-excursion
423 ;; Make sure we don't display it in another frame, otherwise
424 ;; save-window-excursion won't be able to undo it.
425 (let ((display-buffer-overriding-action
426 '(nil . ((inhibit-switch-frame . t)))))
429 ((fboundp symbol) (describe-function symbol))
430 ((boundp symbol) (describe-variable symbol))
431 ((featurep symbol) (describe-package symbol))
432 ((facep symbol) (describe-face symbol))
433 (t (signal 'user-error nil)))
436 (defun elisp--company-doc-string (str)
437 (let* ((symbol (intern-soft str))
438 (doc (if (fboundp symbol)
439 (documentation symbol t)
440 (documentation-property symbol 'variable-documentation t))))
442 (string-match ".*$" doc)
443 (match-string 0 doc))))
445 ;; can't (require 'find-func) in a preloaded file
446 (declare-function find-library-name "find-func" (library))
447 (declare-function find-function-library "find-func" (function &optional l-o v))
449 (defun elisp--company-location (str)
450 (let ((sym (intern-soft str)))
452 ((fboundp sym) (find-definition-noselect sym nil))
453 ((boundp sym) (find-definition-noselect sym 'defvar))
456 (cons (find-file-noselect (find-library-name
459 ((facep sym) (find-definition-noselect sym 'defface)))))
461 (defun elisp-completion-at-point ()
462 "Function used for `completion-at-point-functions' in `emacs-lisp-mode'.
463 If the context at point allows only a certain category of
464 symbols (e.g. functions, or variables) then the returned
465 completions are restricted to that category. In contexts where
466 any symbol is possible (following a quote, for example),
467 functions are annotated with \"<f>\" via the
468 `:annotation-function' property."
469 (with-syntax-table emacs-lisp-mode-syntax-table
471 (beg (condition-case nil
474 (skip-chars-forward "`',‘#")
478 (unless (or (eq beg (point-max))
479 (member (char-syntax (char-after beg))
485 (skip-chars-backward "'’")
486 (when (>= (point) pos)
489 ;; t if in function position.
490 (funpos (eq (char-before beg) ?\())
491 (quoted (elisp--form-quoted-p beg)))
492 (when (and end (or (not (nth 8 (syntax-ppss)))
493 (memq (char-before beg) '(?` ?‘))))
495 (if (or (not funpos) quoted)
496 ;; FIXME: We could look at the first element of the list and
497 ;; use it to provide a more specific completion table in some
498 ;; cases. E.g. filter out keywords that are not understood by
499 ;; the macro/function being called.
501 ((elisp--expect-function-p beg)
504 :company-doc-buffer #'elisp--company-doc-buffer
505 :company-docsig #'elisp--company-doc-string
506 :company-location #'elisp--company-location))
509 ;; Don't include all symbols (bug#16646).
510 :predicate (lambda (sym)
516 (lambda (str) (if (fboundp (intern-soft str)) " <f>"))
517 :company-doc-buffer #'elisp--company-doc-buffer
518 :company-docsig #'elisp--company-doc-string
519 :company-location #'elisp--company-location))
521 (list nil (completion-table-merge
522 elisp--local-variables-completion-table
523 (apply-partially #'completion-table-with-predicate
527 :company-doc-buffer #'elisp--company-doc-buffer
528 :company-docsig #'elisp--company-doc-string
529 :company-location #'elisp--company-location)))
530 ;; Looks like a funcall position. Let's double check.
535 (progn (up-list -1) (forward-char 1)
536 (let ((c (char-after)))
538 (if (memq (char-syntax c) '(?w ?_))
539 (read (current-buffer))))))
542 ;; FIXME: Rather than hardcode special cases here,
543 ;; we should use something like a symbol-property.
545 (list t (mapcar (lambda (x) (symbol-name (car x)))
547 ;; FIXME: We should include some
548 ;; docstring with each entry.
549 (append macro-declarations-alist
550 defun-declarations-alist
551 nil))))) ; Copy both alists.
552 ((and (or `condition-case `condition-case-unless-debug)
553 (guard (save-excursion
558 :predicate (lambda (sym) (get sym 'error-conditions))))
559 ((and (or ?\( `let `let*)
560 (guard (save-excursion
562 (when (eq parent ?\()
565 (looking-at "\\_<let\\*?\\_>"))))
568 :company-doc-buffer #'elisp--company-doc-buffer
569 :company-docsig #'elisp--company-doc-string
570 :company-location #'elisp--company-location))
573 :company-doc-buffer #'elisp--company-doc-buffer
574 :company-docsig #'elisp--company-doc-string
575 :company-location #'elisp--company-location
577 (nconc (list beg end)
578 (if (null (car table-etc))
581 (if (memq (char-syntax (or (char-after end) ?\s))
584 (apply-partially 'completion-table-with-terminator
585 " " (cadr table-etc)))
586 (cddr table-etc)))))))))
588 (defun lisp-completion-at-point (&optional _predicate)
589 (declare (obsolete elisp-completion-at-point "25.1"))
590 (elisp-completion-at-point))
594 (declare-function xref-make-bogus-location "xref" (message))
595 (declare-function xref-make "xref" (summary location))
596 (declare-function xref-collect-references "xref" (symbol dir))
598 (defun elisp--xref-backend () 'elisp)
600 ;; WORKAROUND: This is nominally a constant, but the text properties
601 ;; are not preserved thru dump if use defconst. See bug#21237.
602 (defvar elisp--xref-format
603 (let ((str "(%s %s)"))
604 (put-text-property 1 3 'face 'font-lock-keyword-face str)
605 (put-text-property 4 6 'face 'font-lock-function-name-face str)
608 ;; WORKAROUND: This is nominally a constant, but the text properties
609 ;; are not preserved thru dump if use defconst. See bug#21237.
610 (defvar elisp--xref-format-extra
611 (let ((str "(%s %s %s)"))
612 (put-text-property 1 3 'face 'font-lock-keyword-face str)
613 (put-text-property 4 6 'face 'font-lock-function-name-face str)
616 (defvar find-feature-regexp);; in find-func.el
618 (defun elisp--xref-make-xref (type symbol file &optional summary)
619 "Return an xref for TYPE SYMBOL in FILE.
620 TYPE must be a type in `find-function-regexp-alist' (use nil for
621 'defun). If SUMMARY is non-nil, use it for the summary;
622 otherwise build the summary from TYPE and SYMBOL."
623 (xref-make (or summary
624 (format elisp--xref-format (or type 'defun) symbol))
625 (xref-make-elisp-location symbol type file)))
627 (defvar elisp-xref-find-def-functions nil
628 "List of functions to be run from `elisp--xref-find-definitions' to add additional xrefs.
629 Called with one arg; the symbol whose definition is desired.
630 Each function should return a list of xrefs, or nil; the first
631 non-nil result supercedes the xrefs produced by
632 `elisp--xref-find-definitions'.")
634 (cl-defmethod xref-backend-definitions ((_backend (eql elisp)) identifier)
636 ;; FIXME: use information in source near point to filter results:
637 ;; (dvc-log-edit ...) - exclude 'feature
638 ;; (require 'dvc-log-edit) - only 'feature
639 ;; Semantic may provide additional information
641 (let ((sym (intern-soft identifier)))
643 (elisp--xref-find-definitions sym))))
645 (defun elisp--xref-find-definitions (symbol)
646 ;; The file name is not known when `symbol' is defined via interactive eval.
649 (let ((temp elisp-xref-find-def-functions))
650 (while (and (null xrefs)
652 (setq xrefs (append xrefs (funcall (pop temp) symbol)))))
655 ;; alphabetical by result type symbol
657 ;; FIXME: advised function; list of advice functions
658 ;; FIXME: aliased variable
660 ;; Coding system symbols do not appear in ‘load-history’,
661 ;; so we can’t get a location for them.
663 (when (and (symbolp symbol)
664 (symbol-function symbol)
665 (symbolp (symbol-function symbol)))
667 (let* ((alias-symbol symbol)
668 (alias-file (symbol-file alias-symbol))
669 (real-symbol (symbol-function symbol))
670 (real-file (find-lisp-object-file-name real-symbol 'defun)))
673 (push (elisp--xref-make-xref nil real-symbol real-file) xrefs))
676 (push (elisp--xref-make-xref 'defalias alias-symbol alias-file) xrefs))))
679 (let ((file (find-lisp-object-file-name symbol 'defface)))
681 (push (elisp--xref-make-xref 'defface symbol file) xrefs))))
683 (when (fboundp symbol)
684 (let ((file (find-lisp-object-file-name symbol (symbol-function symbol)))
689 ;; First call to find-lisp-object-file-name for an object
690 ;; defined in C; the doc strings from the C source have
691 ;; not been loaded yet. Second call will return "src/*.c"
692 ;; in file; handled by 't' case below.
693 (push (elisp--xref-make-xref nil symbol (help-C-file-name (symbol-function symbol) 'subr)) xrefs))
695 ((and (setq doc (documentation symbol t))
696 ;; This doc string is defined in cl-macs.el cl-defstruct
697 (string-match "Constructor for objects of type `\\(.*\\)'" doc))
698 ;; `symbol' is a name for the default constructor created by
699 ;; cl-defstruct, so return the location of the cl-defstruct.
700 (let* ((type-name (match-string 1 doc))
701 (type-symbol (intern type-name))
702 (file (find-lisp-object-file-name type-symbol 'define-type))
703 (summary (format elisp--xref-format-extra
705 (concat "(" type-name)
706 (concat "(:constructor " (symbol-name symbol) "))"))))
707 (push (elisp--xref-make-xref 'define-type type-symbol file summary) xrefs)
710 ((setq generic (cl--generic symbol))
711 ;; FIXME: move this to elisp-xref-find-def-functions, in cl-generic.el
713 ;; A generic function. If there is a default method, it
714 ;; will appear in the method table, with no
717 ;; If the default method is declared by the cl-defgeneric
718 ;; declaration, it will have the same location as the
719 ;; cl-defgeneric, so we want to exclude it from the
720 ;; result. In this case, it will have a null doc
721 ;; string. User declarations of default methods may also
722 ;; have null doc strings, but we hope that is
723 ;; rare. Perhaps this heuristic will discourage that.
724 (dolist (method (cl--generic-method-table generic))
725 (let* ((info (cl--generic-method-info method));; qual-string combined-args doconly
726 (specializers (cl--generic-method-specializers method))
728 (met-name (cl--generic-load-hist-format
730 (cl--generic-method-qualifiers method)
732 (file (find-lisp-object-file-name met-name 'cl-defmethod)))
733 (dolist (item specializers)
734 ;; default method has all 't' in specializers
735 (setq non-default (or non-default (not (equal t item)))))
739 (nth 2 info))) ;; assuming only co-located default has null doc string
741 (let ((summary (format elisp--xref-format-extra 'cl-defmethod symbol (nth 1 info))))
742 (push (elisp--xref-make-xref 'cl-defmethod met-name file summary) xrefs))
744 (let ((summary (format elisp--xref-format-extra 'cl-defmethod symbol "()")))
745 (push (elisp--xref-make-xref 'cl-defmethod met-name file summary) xrefs))))
748 (if (and (setq doc (documentation symbol t))
749 ;; This doc string is created somewhere in
750 ;; cl--generic-make-function for an implicit
752 (string-match "\n\n(fn ARG &rest ARGS)" doc))
753 ;; This symbol is an implicitly defined defgeneric, so
756 (push (elisp--xref-make-xref 'cl-defgeneric symbol file) xrefs))
760 (push (elisp--xref-make-xref nil symbol file) xrefs))
763 (when (boundp symbol)
765 (let ((file (find-lisp-object-file-name symbol 'defvar)))
769 ;; The doc strings from the C source have not been loaded
770 ;; yet; help-C-file-name does that. Second call will
771 ;; return "src/*.c" in file; handled below.
772 (push (elisp--xref-make-xref 'defvar symbol (help-C-file-name symbol 'var)) xrefs))
774 ((string= "src/" (substring file 0 4))
775 ;; The variable is defined in a C source file; don't check
776 ;; for define-minor-mode.
777 (push (elisp--xref-make-xref 'defvar symbol file) xrefs))
779 ((memq symbol minor-mode-list)
780 ;; The symbol is a minor mode. These should be defined by
781 ;; "define-minor-mode", which means the variable and the
782 ;; function are declared in the same place. So we return only
783 ;; the function, arbitrarily.
785 ;; There is an exception, when the variable is defined in C
786 ;; code, as for abbrev-mode.
788 ;; IMPROVEME: If the user is searching for the identifier at
789 ;; point, we can determine whether it is a variable or
790 ;; function by looking at the source code near point.
792 ;; IMPROVEME: The user may actually be asking "do any
793 ;; variables by this name exist"; we need a way to specify
798 (push (elisp--xref-make-xref 'defvar symbol file) xrefs))
802 (when (featurep symbol)
803 (let ((file (ignore-errors
804 (find-library-name (symbol-name symbol)))))
806 (push (elisp--xref-make-xref 'feature symbol file) xrefs))))
811 (declare-function project-external-roots "project")
813 (cl-defmethod xref-backend-apropos ((_backend (eql elisp)) regexp)
816 (dolist (sym (apropos-internal regexp))
817 (push (elisp--xref-find-definitions sym) lst))
820 (defvar elisp--xref-identifier-completion-table
821 (apply-partially #'completion-table-with-predicate
830 (cl-defmethod xref-backend-identifier-completion-table ((_backend (eql elisp)))
831 elisp--xref-identifier-completion-table)
833 (cl-defstruct (xref-elisp-location
834 (:constructor xref-make-elisp-location (symbol type file)))
835 "Location of an Emacs Lisp symbol definition."
838 (cl-defmethod xref-location-marker ((l xref-elisp-location))
839 (pcase-let (((cl-struct xref-elisp-location symbol type file) l))
840 (let ((buffer-point (find-function-search-for-symbol symbol type file)))
841 (with-current-buffer (car buffer-point)
843 (goto-char (or (cdr buffer-point) (point-min)))
846 (cl-defmethod xref-location-group ((l xref-elisp-location))
847 (xref-elisp-location-file l))
849 (defun elisp-load-path-roots ()
850 (if (boundp 'package-user-dir)
851 (cons package-user-dir load-path)
854 ;;; Elisp Interaction mode
856 (defvar lisp-interaction-mode-map
857 (let ((map (make-sparse-keymap))
858 (menu-map (make-sparse-keymap "Lisp-Interaction")))
859 (set-keymap-parent map lisp-mode-shared-map)
860 (define-key map "\e\C-x" 'eval-defun)
861 (define-key map "\e\C-q" 'indent-pp-sexp)
862 (define-key map "\e\t" 'completion-at-point)
863 (define-key map "\n" 'eval-print-last-sexp)
864 (bindings--define-key map [menu-bar lisp-interaction]
865 (cons "Lisp-Interaction" menu-map))
866 (bindings--define-key menu-map [eval-defun]
867 '(menu-item "Evaluate Defun" eval-defun
868 :help "Evaluate the top-level form containing point, or after point"))
869 (bindings--define-key menu-map [eval-print-last-sexp]
870 '(menu-item "Evaluate and Print" eval-print-last-sexp
871 :help "Evaluate sexp before point; print value into current buffer"))
872 (bindings--define-key menu-map [edebug-defun-lisp-interaction]
873 '(menu-item "Instrument Function for Debugging" edebug-defun
874 :help "Evaluate the top level form point is in, stepping through with Edebug"
876 (bindings--define-key menu-map [indent-pp-sexp]
877 '(menu-item "Indent or Pretty-Print" indent-pp-sexp
878 :help "Indent each line of the list starting just after point, or prettyprint it"))
879 (bindings--define-key menu-map [complete-symbol]
880 '(menu-item "Complete Lisp Symbol" completion-at-point
881 :help "Perform completion on Lisp symbol preceding point"))
883 "Keymap for Lisp Interaction mode.
884 All commands in `lisp-mode-shared-map' are inherited by this map.")
886 (define-derived-mode lisp-interaction-mode emacs-lisp-mode "Lisp Interaction"
887 "Major mode for typing and evaluating Lisp forms.
888 Like Lisp mode except that \\[eval-print-last-sexp] evals the Lisp expression
889 before point, and prints its value into the buffer, advancing point.
890 Note that printing is controlled by `eval-expression-print-length'
891 and `eval-expression-print-level'.
894 Delete converts tabs to spaces as it moves back.
895 Paragraphs are separated only by blank lines.
896 Semicolons start comments.
898 \\{lisp-interaction-mode-map}"
901 ;;; Emacs Lisp Byte-Code mode
904 (defconst emacs-list-byte-code-comment-re
905 (concat "\\(#\\)@\\([0-9]+\\) "
906 ;; Make sure it's a docstring and not a lazy-loaded byte-code.
907 "\\(?:[^(]\\|([^\"]\\)")))
909 (defun elisp--byte-code-comment (end &optional _point)
910 "Try to syntactically mark the #@NNN ....^_ docstrings in byte-code files."
911 (let ((ppss (syntax-ppss)))
912 (when (and (nth 4 ppss)
913 (eq (char-after (nth 8 ppss)) ?#))
914 (let* ((n (save-excursion
915 (goto-char (nth 8 ppss))
916 (when (looking-at emacs-list-byte-code-comment-re)
917 (string-to-number (match-string 2)))))
918 ;; `maxdiff' tries to make sure the loop below terminates.
921 (let* ((bchar (match-end 2))
922 (b (position-bytes bchar)))
924 (while (let ((diff (- (position-bytes (point)) b n)))
926 (when (> diff maxdiff) (setq diff maxdiff))
927 (forward-char (- diff))
928 (setq maxdiff (if (> diff 0) diff
929 (max (1- maxdiff) 1)))
932 (put-text-property (1- (point)) (point)
934 (string-to-syntax "> b"))
935 (goto-char end)))))))
937 (defun elisp-byte-code-syntax-propertize (start end)
939 (elisp--byte-code-comment end (point))
941 (syntax-propertize-rules
942 (emacs-list-byte-code-comment-re
943 (1 (prog1 "< b" (elisp--byte-code-comment end (point))))))
947 (add-to-list 'auto-mode-alist '("\\.elc\\'" . elisp-byte-code-mode))
949 (define-derived-mode elisp-byte-code-mode emacs-lisp-mode
951 "Major mode for *.elc files."
952 ;; TODO: Add way to disassemble byte-code under point.
953 (setq-local open-paren-in-column-0-is-defun-start nil)
954 (setq-local syntax-propertize-function
955 #'elisp-byte-code-syntax-propertize))
958 ;;; Globally accessible functionality
960 (defun eval-print-last-sexp (&optional eval-last-sexp-arg-internal)
961 "Evaluate sexp before point; print value into current buffer.
963 Normally, this function truncates long output according to the value
964 of the variables `eval-expression-print-length' and
965 `eval-expression-print-level'. With a prefix argument of zero,
966 however, there is no such truncation. Such a prefix argument
967 also causes integers to be printed in several additional formats
968 \(octal, hexadecimal, and character).
970 If `eval-expression-debug-on-error' is non-nil, which is the default,
971 this command arranges for all errors to enter the debugger."
973 (let ((standard-output (current-buffer)))
975 (eval-last-sexp (or eval-last-sexp-arg-internal t))
979 (defun last-sexp-setup-props (beg end value alt1 alt2)
980 "Set up text properties for the output of `elisp--eval-last-sexp'.
981 BEG and END are the start and end of the output in current-buffer.
982 VALUE is the Lisp value printed, ALT1 and ALT2 are strings for the
983 alternative printed representations that can be displayed."
984 (let ((map (make-sparse-keymap)))
985 (define-key map "\C-m" 'elisp-last-sexp-toggle-display)
986 (define-key map [down-mouse-2] 'mouse-set-point)
987 (define-key map [mouse-2] 'elisp-last-sexp-toggle-display)
990 `(printed-value (,value ,alt1 ,alt2)
993 help-echo "RET, mouse-2: toggle abbreviated display"
994 rear-nonsticky (mouse-face keymap help-echo
998 (defun elisp-last-sexp-toggle-display (&optional _arg)
999 "Toggle between abbreviated and unabbreviated printed representations."
1003 (let ((value (get-text-property (point) 'printed-value)))
1005 (let ((beg (or (previous-single-property-change (min (point-max) (1+ (point)))
1008 (end (or (next-single-char-property-change (point) 'printed-value) (point)))
1009 (standard-output (current-buffer))
1011 (delete-region beg end)
1012 (insert (nth 1 value))
1014 (setq point (1- (point))))
1015 (last-sexp-setup-props beg (point)
1019 (goto-char (min (point-max) point)))))))
1021 (defun prin1-char (char) ;FIXME: Move it, e.g. to simple.el.
1022 "Return a string representing CHAR as a character rather than as an integer.
1023 If CHAR is not a character, return nil."
1024 (and (integerp char)
1026 (let ((c (event-basic-type char))
1027 (mods (event-modifiers char))
1029 ;; Prevent ?A from turning into ?\S-a.
1030 (if (and (memq 'shift mods)
1031 (zerop (logand char ?\S-\^@))
1032 (not (let ((case-fold-search nil))
1033 (char-equal c (upcase c)))))
1034 (setq c (upcase c) mods nil))
1035 ;; What string are we considering using?
1042 (cond ((eq modif 'super) "\\s-")
1043 (t (string ?\\ (upcase (aref (symbol-name modif) 0)) ?-))))
1046 ((memq c '(?\; ?\( ?\) ?\{ ?\} ?\[ ?\] ?\" ?\' ?\\)) (string ?\\ c))
1047 ((eq c 127) "\\C-?")
1051 ;; Verify the string reads a CHAR, not to some other character.
1052 ;; If it doesn't, return nil instead.
1054 (= (car (read-from-string string)) char)
1057 (defun elisp--preceding-sexp ()
1058 "Return sexp before the point."
1059 (let ((opoint (point))
1063 (with-syntax-table emacs-lisp-mode-syntax-table
1064 ;; If this sexp appears to be enclosed in `...' or ‘...’
1065 ;; then ignore the surrounding quotes.
1066 (cond ((eq (preceding-char) ?’)
1067 (progn (forward-char -1) (setq opoint (point))))
1068 ((or (eq (following-char) ?\')
1069 (eq (preceding-char) ?\'))
1070 (setq left-quote ?\`)))
1072 ;; When after a named character literal, skip over the entire
1073 ;; literal, not only its last word.
1074 (when (= (preceding-char) ?})
1075 (let ((begin (save-excursion
1077 (skip-syntax-backward "w-")
1079 (when (looking-at-p "\\\\N{") (point)))))
1080 (when begin (goto-char begin))))
1083 ;; If we were after `?\e' (or similar case),
1084 ;; use the whole thing, not just the `e'.
1085 (when (eq (preceding-char) ?\\)
1087 (when (eq (preceding-char) ??)
1090 ;; Skip over hash table read syntax.
1091 (and (> (point) (1+ (point-min)))
1092 (looking-back "#s" (- (point) 2))
1095 ;; Skip over `#N='s.
1096 (when (eq (preceding-char) ?=)
1099 (skip-chars-backward "0-9#=")
1100 (setq labeled-p (looking-at "\\(#[0-9]+=\\)+")))
1102 (forward-sexp -1))))
1105 (if (eq (following-char) left-quote)
1106 ;; vladimir@cs.ualberta.ca 30-Jul-1997: Skip ` in `variable' so
1107 ;; that the value is returned, not the name.
1109 (when (looking-at ",@?") (goto-char (match-end 0)))
1110 (narrow-to-region (point-min) opoint)
1111 (setq expr (read (current-buffer)))
1112 ;; If it's an (interactive ...) form, it's more useful to show how an
1113 ;; interactive call would use it.
1114 ;; FIXME: Is it really the right place for this?
1115 (when (eq (car-safe expr) 'interactive)
1117 `(call-interactively
1118 (lambda (&rest args) ,expr args))))
1120 (define-obsolete-function-alias 'preceding-sexp 'elisp--preceding-sexp "25.1")
1122 (defun elisp--eval-last-sexp (eval-last-sexp-arg-internal)
1123 "Evaluate sexp before point; print value in the echo area.
1124 If EVAL-LAST-SEXP-ARG-INTERNAL is non-nil, print output into
1125 current buffer. If EVAL-LAST-SEXP-ARG-INTERNAL is `0', print
1126 output with no limit on the length and level of lists, and
1127 include additional formats for integers \(octal, hexadecimal, and
1130 ((`(,insert-value ,no-truncate ,char-print-limit)
1131 (eval-expression-get-print-arguments eval-last-sexp-arg-internal)))
1132 ;; Setup the lexical environment if lexical-binding is enabled.
1133 (elisp--eval-last-sexp-print-value
1134 (eval (eval-sexp-add-defvars (elisp--preceding-sexp)) lexical-binding)
1135 (if insert-value (current-buffer) t) no-truncate char-print-limit)))
1137 (defun elisp--eval-last-sexp-print-value
1138 (value output &optional no-truncate char-print-limit)
1139 (let* ((unabbreviated (let ((print-length nil) (print-level nil))
1140 (prin1-to-string value)))
1141 (eval-expression-print-maximum-character char-print-limit)
1142 (print-length (unless no-truncate eval-expression-print-length))
1143 (print-level (unless no-truncate eval-expression-print-level))
1147 (prin1 value output)
1148 (let ((str (and char-print-limit (eval-expression-print-format value))))
1149 (if str (princ str output)))
1151 (when (and (bufferp output)
1152 (or (not (null print-length))
1153 (not (null print-level)))
1154 (not (string= unabbreviated
1155 (buffer-substring-no-properties beg end))))
1156 (last-sexp-setup-props beg end value
1158 (buffer-substring-no-properties beg end))
1162 (defvar elisp--eval-last-sexp-fake-value (make-symbol "t"))
1164 (defun eval-sexp-add-defvars (exp &optional pos)
1165 "Prepend EXP with all the `defvar's that precede it in the buffer.
1166 POS specifies the starting position where EXP was found and defaults to point."
1167 (setq exp (macroexpand-all exp)) ;Eager macro-expansion.
1168 (if (not lexical-binding)
1171 (unless pos (setq pos (point)))
1173 (goto-char (point-min))
1174 (while (re-search-forward
1175 "(def\\(?:var\\|const\\|custom\\)[ \t\n]+\\([^; '()\n\t]+\\)"
1177 (let ((var (intern (match-string 1))))
1178 (and (not (special-variable-p var))
1180 (zerop (car (syntax-ppss (match-beginning 0)))))
1182 `(progn ,@(mapcar (lambda (v) `(defvar ,v)) vars) ,exp)))))
1184 (defun eval-last-sexp (eval-last-sexp-arg-internal)
1185 "Evaluate sexp before point; print value in the echo area.
1186 Interactively, with a non `-' prefix argument, print output into
1189 Normally, this function truncates long output according to the
1190 value of the variables `eval-expression-print-length' and
1191 `eval-expression-print-level'. With a prefix argument of zero,
1192 however, there is no such truncation. Such a prefix argument
1193 also causes integers to be printed in several additional formats
1194 \(octal, hexadecimal, and character when the prefix argument is
1195 -1 or the integer is `eval-expression-print-maximum-character' or
1198 If `eval-expression-debug-on-error' is non-nil, which is the default,
1199 this command arranges for all errors to enter the debugger."
1201 (if (null eval-expression-debug-on-error)
1202 (elisp--eval-last-sexp eval-last-sexp-arg-internal)
1204 (let ((debug-on-error elisp--eval-last-sexp-fake-value))
1205 (cons (elisp--eval-last-sexp eval-last-sexp-arg-internal)
1207 (unless (eq (cdr value) elisp--eval-last-sexp-fake-value)
1208 (setq debug-on-error (cdr value)))
1211 (defun elisp--eval-defun-1 (form)
1212 "Treat some expressions specially.
1213 Reset the `defvar' and `defcustom' variables to the initial value.
1214 \(For `defcustom', use the :set function if there is one.)
1215 Reinitialize the face according to the `defface' specification."
1216 ;; The code in edebug-defun should be consistent with this, but not
1217 ;; the same, since this gets a macroexpanded form.
1218 (cond ((not (listp form))
1220 ((and (eq (car form) 'defvar)
1221 (cdr-safe (cdr-safe form))
1222 (boundp (cadr form)))
1223 ;; Force variable to be re-set.
1224 `(progn (defvar ,(nth 1 form) nil ,@(nthcdr 3 form))
1225 (setq-default ,(nth 1 form) ,(nth 2 form))))
1226 ;; `defcustom' is now macroexpanded to
1227 ;; `custom-declare-variable' with a quoted value arg.
1228 ((and (eq (car form) 'custom-declare-variable)
1229 (default-boundp (eval (nth 1 form) lexical-binding)))
1230 ;; Force variable to be bound, using :set function if specified.
1231 (let ((setfunc (memq :set form)))
1233 (setq setfunc (car-safe (cdr-safe setfunc)))
1234 (or (functionp setfunc) (setq setfunc nil)))
1235 (funcall (or setfunc 'set-default)
1236 (eval (nth 1 form) lexical-binding)
1237 ;; The second arg is an expression that evaluates to
1238 ;; an expression. The second evaluation is the one
1239 ;; normally performed not by normal execution but by
1240 ;; custom-initialize-set (for example), which does not
1241 ;; use lexical-binding.
1242 (eval (eval (nth 2 form) lexical-binding))))
1244 ;; `defface' is macroexpanded to `custom-declare-face'.
1245 ((eq (car form) 'custom-declare-face)
1247 (let ((face-symbol (eval (nth 1 form) lexical-binding)))
1248 (setq face-new-frame-defaults
1249 (assq-delete-all face-symbol face-new-frame-defaults))
1250 (put face-symbol 'face-defface-spec nil)
1251 (put face-symbol 'face-override-spec nil))
1253 ((eq (car form) 'progn)
1254 (cons 'progn (mapcar #'elisp--eval-defun-1 (cdr form))))
1257 (defun elisp--eval-defun ()
1258 "Evaluate defun that point is in or before.
1259 The value is displayed in the echo area.
1260 If the current defun is actually a call to `defvar',
1261 then reset the variable using the initial value expression
1262 even if the variable already has some other value.
1263 \(Normally `defvar' does not change the variable's value
1264 if it already has a value.)
1266 Return the result of evaluation."
1267 ;; FIXME: the print-length/level bindings should only be applied while
1268 ;; printing, not while evaluating.
1269 (let ((debug-on-error eval-expression-debug-on-error)
1270 (print-length eval-expression-print-length)
1271 (print-level eval-expression-print-level))
1273 ;; Arrange for eval-region to "read" the (possibly) altered form.
1274 ;; eval-region handles recording which file defines a function or
1276 (let ((standard-output t)
1278 ;; Read the form from the buffer, and record where it ends.
1281 (beginning-of-defun)
1283 (setq form (read (current-buffer)))
1285 ;; Alter the form if necessary.
1286 (let ((form (eval-sexp-add-defvars
1287 (elisp--eval-defun-1 (macroexpand form)))))
1288 (eval-region beg end standard-output
1290 ;; Skipping to the end of the specified region
1291 ;; will make eval-region return.
1294 (let ((str (eval-expression-print-format (car values))))
1295 (if str (princ str)))
1296 ;; The result of evaluation has been put onto VALUES. So return it.
1299 (defun eval-defun (edebug-it)
1300 "Evaluate the top-level form containing point, or after point.
1302 If the current defun is actually a call to `defvar' or `defcustom',
1303 evaluating it this way resets the variable using its initial value
1304 expression (using the defcustom's :set function if there is one), even
1305 if the variable already has some other value. \(Normally `defvar' and
1306 `defcustom' do not alter the value if there already is one.) In an
1307 analogous way, evaluating a `defface' overrides any customizations of
1308 the face, so that it becomes defined exactly as the `defface' expression
1311 If `eval-expression-debug-on-error' is non-nil, which is the default,
1312 this command arranges for all errors to enter the debugger.
1314 With a prefix argument, instrument the code for Edebug.
1316 If acting on a `defun' for FUNCTION, and the function was
1317 instrumented, `Edebug: FUNCTION' is printed in the echo area. If not
1318 instrumented, just FUNCTION is printed.
1320 If not acting on a `defun', the result of evaluation is displayed in
1321 the echo area. This display is controlled by the variables
1322 `eval-expression-print-length' and `eval-expression-print-level',
1327 (eval-defun (not edebug-all-defs)))
1329 (if (null eval-expression-debug-on-error)
1331 (let (new-value value)
1332 (let ((debug-on-error elisp--eval-last-sexp-fake-value))
1333 (setq value (elisp--eval-defun))
1334 (setq new-value debug-on-error))
1335 (unless (eq elisp--eval-last-sexp-fake-value new-value)
1336 (setq debug-on-error new-value))
1341 (defvar elisp--eldoc-last-data (make-vector 3 nil)
1342 "Bookkeeping; elements are as follows:
1343 0 - contains the last symbol read from the buffer.
1344 1 - contains the string last displayed in the echo area for variables,
1345 or argument string for functions.
1346 2 - `function' if function args, `variable' if variable documentation.")
1348 (defun elisp-eldoc-documentation-function ()
1349 "`eldoc-documentation-function' (which see) for Emacs Lisp."
1350 (let ((current-symbol (elisp--current-symbol))
1351 (current-fnsym (elisp--fnsym-in-current-sexp)))
1352 (cond ((null current-fnsym)
1354 ((eq current-symbol (car current-fnsym))
1355 (or (apply #'elisp-get-fnsym-args-string current-fnsym)
1356 (elisp-get-var-docstring current-symbol)))
1358 (or (elisp-get-var-docstring current-symbol)
1359 (apply #'elisp-get-fnsym-args-string current-fnsym))))))
1361 (defun elisp-get-fnsym-args-string (sym &optional index prefix)
1362 "Return a string containing the parameter list of the function SYM.
1363 If SYM is a subr and no arglist is obtainable from the docstring
1364 or elsewhere, return a 1-line docstring."
1367 ((not (and sym (symbolp sym) (fboundp sym))) nil)
1368 ((and (eq sym (aref elisp--eldoc-last-data 0))
1369 (eq 'function (aref elisp--eldoc-last-data 2)))
1370 (aref elisp--eldoc-last-data 1))
1372 (let* ((advertised (gethash (indirect-function sym)
1373 advertised-signature-table t))
1377 ((listp advertised) advertised)
1378 ((setq doc (help-split-fundoc
1379 (condition-case nil (documentation sym t)
1380 (invalid-function nil))
1382 (substitute-command-keys (car doc)))
1383 (t (help-function-arglist sym)))))
1384 ;; Stringify, and store before highlighting, downcasing, etc.
1385 (elisp--last-data-store sym (elisp-function-argstring args)
1387 ;; Highlight, truncate.
1389 (elisp--highlight-function-argument
1392 (concat (propertize (symbol-name sym) 'face
1394 'font-lock-function-name-face
1395 'font-lock-keyword-face))
1398 (defun elisp--highlight-function-argument (sym args index prefix)
1399 "Highlight argument INDEX in ARGS list for function SYM.
1400 In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'."
1401 ;; FIXME: This should probably work on the list representation of `args'
1402 ;; rather than its string representation.
1403 ;; FIXME: This function is much too long, we need to split it up!
1406 (argument-face 'eldoc-highlight-function-argument)
1407 (args-lst (mapcar (lambda (x)
1408 (replace-regexp-in-string
1409 "\\`[(]\\|[)]\\'" "" x))
1410 (split-string args)))
1411 (args-lst-ak (cdr (member "&key" args-lst))))
1412 ;; Find the current argument in the argument string. We need to
1413 ;; handle `&rest' and informal `...' properly.
1415 ;; FIXME: What to do with optional arguments, like in
1416 ;; (defun NAME ARGLIST [DOCSTRING] BODY...) case?
1417 ;; The problem is there is no robust way to determine if
1418 ;; the current argument is indeed a docstring.
1420 ;; When `&key' is used finding position based on `index'
1421 ;; would be wrong, so find the arg at point and determine
1422 ;; position in ARGS based on this current arg.
1423 (when (and args-lst-ak
1424 (>= index (- (length args-lst) (length args-lst-ak))))
1425 (let* (case-fold-search
1427 (sym-name (symbol-name sym))
1428 (cur-w (current-word t))
1429 (limit (save-excursion
1430 (when (re-search-backward sym-name nil t)
1432 (cur-a (if (and cur-w (string-match ":\\([^ ()]*\\)" cur-w))
1436 (when (re-search-backward ":\\([^ ()\n]*\\)" limit t)
1437 (setq split (split-string (match-string 1) " " t))
1440 (setq key-have-value t))))))))
1441 ;; If `cur-a' is not one of `args-lst-ak'
1442 ;; assume user is entering an unknown key
1443 ;; referenced in last position in signature.
1444 (other-key-arg (and (stringp cur-a)
1446 (not (member (upcase cur-a) args-lst-ak))
1447 (upcase (car (last args-lst-ak))))))
1448 (unless (or (null cur-w) (string= cur-w sym-name))
1449 ;; The last keyword have already a value
1450 ;; i.e :foo a b and cursor is at b.
1451 ;; If signature have also `&rest'
1452 ;; (assume it is after the `&key' section)
1453 ;; go to the arg after `&rest'.
1454 (if (and key-have-value
1456 (not (re-search-forward ":.*" (point-at-eol) t)))
1457 (string-match "&rest \\([^ ()]*\\)" args))
1458 (setq index nil ; Skip next block based on positional args.
1459 start (match-beginning 1)
1461 ;; If `cur-a' is nil probably cursor is on a positional arg
1462 ;; before `&key', in this case, exit this block and determine
1463 ;; position with `index'.
1464 (when (and cur-a ; A keyword arg (dot removed) or nil.
1466 (concat "\\_<" (upcase cur-a) "\\_>") args)
1468 (concat "\\_<" other-key-arg "\\_>") args)))
1469 (setq index nil ; Skip next block based on positional args.
1470 start (match-beginning 0)
1471 end (match-end 0)))))))
1472 ;; Handle now positional arguments.
1473 (while (and index (>= index 1))
1474 (if (string-match "[^ ()]+" args end)
1476 (setq start (match-beginning 0)
1478 (let ((argument (match-string 0 args)))
1479 (cond ((string= argument "&rest")
1480 ;; All the rest arguments are the same.
1482 ((string= argument "&optional")) ; Skip.
1483 ((string= argument "&allow-other-keys")) ; Skip.
1484 ;; Back to index 0 in ARG1 ARG2 ARG2 ARG3 etc...
1486 ((or (and (string-match-p "\\.\\.\\.\\'" argument)
1487 (string= argument (car (last args-lst))))
1488 (and (string-match-p "\\.\\.\\.\\'"
1489 (substring args 1 (1- (length args))))
1490 (= (length (remove "..." args-lst)) 2)
1491 (> index 1) (eq (logand index 1) 1)))
1494 (setq index (1- index))))))
1495 (setq end (length args)
1497 argument-face 'font-lock-warning-face
1501 (setq doc (copy-sequence args))
1502 (add-text-properties start end (list 'face argument-face) doc))
1503 (setq doc (eldoc-docstring-format-sym-doc prefix doc))
1506 ;; Return a string containing a brief (one-line) documentation string for
1508 (defun elisp-get-var-docstring (sym)
1509 (cond ((not sym) nil)
1510 ((and (eq sym (aref elisp--eldoc-last-data 0))
1511 (eq 'variable (aref elisp--eldoc-last-data 2)))
1512 (aref elisp--eldoc-last-data 1))
1514 (let ((doc (documentation-property sym 'variable-documentation t)))
1516 (let ((doc (eldoc-docstring-format-sym-doc
1517 sym (elisp--docstring-first-line doc)
1518 'font-lock-variable-name-face)))
1519 (elisp--last-data-store sym doc 'variable)))))))
1521 (defun elisp--last-data-store (symbol doc type)
1522 (aset elisp--eldoc-last-data 0 symbol)
1523 (aset elisp--eldoc-last-data 1 doc)
1524 (aset elisp--eldoc-last-data 2 type)
1527 ;; Note that any leading `*' in the docstring (which indicates the variable
1528 ;; is a user option) is removed.
1529 (defun elisp--docstring-first-line (doc)
1531 (substitute-command-keys
1533 ;; Don't use "^" in the regexp below since it may match
1534 ;; anywhere in the doc-string.
1535 (let ((start (if (string-match "\\`\\*" doc) (match-end 0) 0)))
1536 (cond ((string-match "\n" doc)
1537 (substring doc start (match-beginning 0)))
1539 (t (substring doc start))))))))
1541 ;; Return a list of current function name and argument index.
1542 (defun elisp--fnsym-in-current-sexp ()
1544 (let ((argument-index (1- (elisp--beginning-of-sexp))))
1545 ;; If we are at the beginning of function name, this will be -1.
1546 (when (< argument-index 0)
1547 (setq argument-index 0))
1548 ;; Don't do anything if current word is inside a string.
1549 (if (= (or (char-after (1- (point))) 0) ?\")
1551 (list (elisp--current-symbol) argument-index)))))
1553 ;; Move to the beginning of current sexp. Return the number of nested
1554 ;; sexp the point was over or after.
1555 (defun elisp--beginning-of-sexp ()
1556 (let ((parse-sexp-ignore-comments t)
1557 (num-skipped-sexps 0))
1560 ;; First account for the case the point is directly over a
1561 ;; beginning of a nested sexp.
1567 (setq num-skipped-sexps 1)))
1573 (setq num-skipped-sexps (1+ num-skipped-sexps))))))
1577 ;; returns nil unless current word is an interned symbol.
1578 (defun elisp--current-symbol ()
1579 (let ((c (char-after (point))))
1581 (memq (char-syntax c) '(?w ?_))
1582 (intern-soft (current-word)))))
1584 (defun elisp-function-argstring (arglist)
1585 "Return ARGLIST as a string enclosed by ().
1586 ARGLIST is either a string, or a list of strings or symbols."
1587 (let ((str (cond ((stringp arglist) arglist)
1588 ((not (listp arglist)) nil)
1589 (t (substitute-command-keys
1590 (help--make-usage-docstring 'toto arglist))))))
1591 (if (and str (string-match "\\`([^ )]+ ?" str))
1592 (replace-match "(" t t str)
1597 ;; Don't require checkdoc, but forward declare these checkdoc special
1598 ;; variables. Autoloading them on `checkdoc-current-buffer' is too
1599 ;; late, they won't be bound dynamically.
1600 (defvar checkdoc-create-error-function)
1601 (defvar checkdoc-autofix-flag)
1602 (defvar checkdoc-generate-compile-warnings-flag)
1603 (defvar checkdoc-diagnostic-buffer)
1606 (defun elisp-flymake-checkdoc (report-fn &rest _args)
1607 "A Flymake backend for `checkdoc'.
1608 Calls REPORT-FN directly."
1610 (let* ((checkdoc-create-error-function
1611 (lambda (text start end &optional unfixable)
1612 (push (list text start end unfixable) collected)
1614 (checkdoc-autofix-flag nil)
1615 (checkdoc-generate-compile-warnings-flag nil)
1616 (checkdoc-diagnostic-buffer
1617 (generate-new-buffer " *checkdoc-temp*")))
1620 ;; checkdoc-current-buffer can error if there are
1621 ;; unbalanced parens, for example, but this shouldn't
1622 ;; disable the backend (bug#29176).
1624 (checkdoc-current-buffer t)))
1625 (kill-buffer checkdoc-diagnostic-buffer)))
1627 (cl-loop for (text start end _unfixable) in
1630 (flymake-make-diagnostic
1632 start end :note text)))
1635 (defun elisp-flymake--byte-compile-done (report-fn
1638 (with-current-buffer
1645 (cl-loop with data =
1646 (with-current-buffer output-buffer
1647 (goto-char (point-min))
1648 (search-forward ":elisp-flymake-output-start")
1649 (read (point-marker)))
1650 for (string pos _fill level) in data
1652 for beg = (if (< (point) (point-max))
1654 (line-beginning-position))
1658 (bounds-of-thing-at-point 'sexp))
1660 collect (flymake-make-diagnostic
1662 (if (= beg end) (1- beg) beg)
1667 (defvar-local elisp-flymake--byte-compile-process nil
1668 "Buffer-local process started for byte-compiling the buffer.")
1671 (defun elisp-flymake-byte-compile (report-fn &rest _args)
1672 "A Flymake backend for elisp byte compilation.
1673 Spawn an Emacs process that byte-compiles a file representing the
1674 current buffer state and calls REPORT-FN when done."
1675 (when elisp-flymake--byte-compile-process
1676 (when (process-live-p elisp-flymake--byte-compile-process)
1677 (kill-process elisp-flymake--byte-compile-process)))
1678 (let ((temp-file (make-temp-file "elisp-flymake-byte-compile"))
1679 (source-buffer (current-buffer)))
1682 (write-region (point-min) (point-max) temp-file nil 'nomessage))
1683 (let* ((output-buffer (generate-new-buffer " *elisp-flymake-byte-compile*")))
1685 elisp-flymake--byte-compile-process
1687 :name "elisp-flymake-byte-compile"
1688 :buffer output-buffer
1689 :command (list (expand-file-name invocation-name invocation-directory)
1692 ;; "--eval" "(setq load-prefer-newer t)" ; for testing
1693 "-L" default-directory
1694 "-f" "elisp-flymake--batch-compile-for-flymake"
1696 :connection-type 'pipe
1698 (lambda (proc _event)
1699 (when (eq (process-status proc) 'exit)
1702 ((not (eq proc (with-current-buffer source-buffer
1703 elisp-flymake--byte-compile-process)))
1704 (flymake-log :warning "byte-compile process %s obsolete" proc))
1705 ((zerop (process-exit-status proc))
1706 (elisp-flymake--byte-compile-done report-fn
1713 (format "byte-compile process %s died" proc))))
1714 (ignore-errors (delete-file temp-file))
1715 (kill-buffer output-buffer))))))
1719 (defun elisp-flymake--batch-compile-for-flymake (&optional file)
1720 "Helper for `elisp-flymake-byte-compile'.
1721 Runs in a batch-mode Emacs. Interactively use variable
1722 `buffer-file-name' for FILE."
1723 (interactive (list buffer-file-name))
1724 (let* ((file (or file
1725 (car command-line-args-left)))
1727 (byte-compile-log-buffer
1728 (generate-new-buffer " *dummy-byte-compile-log-buffer*"))
1729 (byte-compile-dest-file-function
1731 (setq dummy-elc-file (make-temp-file (file-name-nondirectory source)))))
1733 (byte-compile-log-warning-function
1734 (lambda (string &optional position fill level)
1735 (push (list string position fill level)
1739 (byte-compile-file file)
1741 (delete-file dummy-elc-file)
1742 (kill-buffer byte-compile-log-buffer)))
1743 (prin1 :elisp-flymake-output-start)
1747 (provide 'elisp-mode)
1748 ;;; elisp-mode.el ends here