Don't show both feature and function with the same name
[emacs.git] / lisp / progmodes / elisp-mode.el
blobad35c48a101015ccf7d0da7b93edb7de2a60d251
1 ;;; elisp-mode.el --- Emacs Lisp mode -*- lexical-binding:t -*-
3 ;; Copyright (C) 1985-1986, 1999-2015 Free Software Foundation, Inc.
5 ;; Maintainer: emacs-devel@gnu.org
6 ;; Keywords: lisp, languages
7 ;; Package: emacs
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 <http://www.gnu.org/licenses/>.
24 ;;; Commentary:
26 ;; The major mode for editing Emacs Lisp code.
27 ;; This mode is documented in the Emacs manual.
29 ;;; Code:
31 (require 'lisp-mode)
33 (defvar emacs-lisp-mode-abbrev-table nil)
34 (define-abbrev-table 'emacs-lisp-mode-abbrev-table ()
35 "Abbrev table for Emacs Lisp mode.
36 It has `lisp-mode-abbrev-table' as its parent."
37 :parents (list lisp-mode-abbrev-table))
39 (defvar emacs-lisp-mode-syntax-table
40 (let ((table (make-syntax-table lisp--mode-syntax-table)))
41 (modify-syntax-entry ?\[ "(] " table)
42 (modify-syntax-entry ?\] ")[ " table)
43 table)
44 "Syntax table used in `emacs-lisp-mode'.")
46 (defvar emacs-lisp-mode-map
47 (let ((map (make-sparse-keymap "Emacs-Lisp"))
48 (menu-map (make-sparse-keymap "Emacs-Lisp"))
49 (lint-map (make-sparse-keymap))
50 (prof-map (make-sparse-keymap))
51 (tracing-map (make-sparse-keymap)))
52 (set-keymap-parent map lisp-mode-shared-map)
53 (define-key map "\e\t" 'completion-at-point)
54 (define-key map "\e\C-x" 'eval-defun)
55 (define-key map "\e\C-q" 'indent-pp-sexp)
56 (bindings--define-key map [menu-bar emacs-lisp]
57 (cons "Emacs-Lisp" menu-map))
58 (bindings--define-key menu-map [eldoc]
59 '(menu-item "Auto-Display Documentation Strings" eldoc-mode
60 :button (:toggle . (bound-and-true-p eldoc-mode))
61 :help "Display the documentation string for the item under cursor"))
62 (bindings--define-key menu-map [checkdoc]
63 '(menu-item "Check Documentation Strings" checkdoc
64 :help "Check documentation strings for style requirements"))
65 (bindings--define-key menu-map [re-builder]
66 '(menu-item "Construct Regexp" re-builder
67 :help "Construct a regexp interactively"))
68 (bindings--define-key menu-map [tracing] (cons "Tracing" tracing-map))
69 (bindings--define-key tracing-map [tr-a]
70 '(menu-item "Untrace All" untrace-all
71 :help "Untrace all currently traced functions"))
72 (bindings--define-key tracing-map [tr-uf]
73 '(menu-item "Untrace Function..." untrace-function
74 :help "Untrace function, and possibly activate all remaining advice"))
75 (bindings--define-key tracing-map [tr-sep] menu-bar-separator)
76 (bindings--define-key tracing-map [tr-q]
77 '(menu-item "Trace Function Quietly..." trace-function-background
78 :help "Trace the function with trace output going quietly to a buffer"))
79 (bindings--define-key tracing-map [tr-f]
80 '(menu-item "Trace Function..." trace-function
81 :help "Trace the function given as an argument"))
82 (bindings--define-key menu-map [profiling] (cons "Profiling" prof-map))
83 (bindings--define-key prof-map [prof-restall]
84 '(menu-item "Remove Instrumentation for All Functions" elp-restore-all
85 :help "Restore the original definitions of all functions being profiled"))
86 (bindings--define-key prof-map [prof-restfunc]
87 '(menu-item "Remove Instrumentation for Function..." elp-restore-function
88 :help "Restore an instrumented function to its original definition"))
90 (bindings--define-key prof-map [sep-rem] menu-bar-separator)
91 (bindings--define-key prof-map [prof-resall]
92 '(menu-item "Reset Counters for All Functions" elp-reset-all
93 :help "Reset the profiling information for all functions being profiled"))
94 (bindings--define-key prof-map [prof-resfunc]
95 '(menu-item "Reset Counters for Function..." elp-reset-function
96 :help "Reset the profiling information for a function"))
97 (bindings--define-key prof-map [prof-res]
98 '(menu-item "Show Profiling Results" elp-results
99 :help "Display current profiling results"))
100 (bindings--define-key prof-map [prof-pack]
101 '(menu-item "Instrument Package..." elp-instrument-package
102 :help "Instrument for profiling all function that start with a prefix"))
103 (bindings--define-key prof-map [prof-func]
104 '(menu-item "Instrument Function..." elp-instrument-function
105 :help "Instrument a function for profiling"))
106 ;; Maybe this should be in a separate submenu from the ELP stuff?
107 (bindings--define-key prof-map [sep-natprof] menu-bar-separator)
108 (bindings--define-key prof-map [prof-natprof-stop]
109 '(menu-item "Stop Native Profiler" profiler-stop
110 :help "Stop recording profiling information"
111 :enable (and (featurep 'profiler)
112 (profiler-running-p))))
113 (bindings--define-key prof-map [prof-natprof-report]
114 '(menu-item "Show Profiler Report" profiler-report
115 :help "Show the current profiler report"
116 :enable (and (featurep 'profiler)
117 (profiler-running-p))))
118 (bindings--define-key prof-map [prof-natprof-start]
119 '(menu-item "Start Native Profiler..." profiler-start
120 :help "Start recording profiling information"))
122 (bindings--define-key menu-map [lint] (cons "Linting" lint-map))
123 (bindings--define-key lint-map [lint-di]
124 '(menu-item "Lint Directory..." elint-directory
125 :help "Lint a directory"))
126 (bindings--define-key lint-map [lint-f]
127 '(menu-item "Lint File..." elint-file
128 :help "Lint a file"))
129 (bindings--define-key lint-map [lint-b]
130 '(menu-item "Lint Buffer" elint-current-buffer
131 :help "Lint the current buffer"))
132 (bindings--define-key lint-map [lint-d]
133 '(menu-item "Lint Defun" elint-defun
134 :help "Lint the function at point"))
135 (bindings--define-key menu-map [edebug-defun]
136 '(menu-item "Instrument Function for Debugging" edebug-defun
137 :help "Evaluate the top level form point is in, stepping through with Edebug"
138 :keys "C-u C-M-x"))
139 (bindings--define-key menu-map [separator-byte] menu-bar-separator)
140 (bindings--define-key menu-map [disas]
141 '(menu-item "Disassemble Byte Compiled Object..." disassemble
142 :help "Print disassembled code for OBJECT in a buffer"))
143 (bindings--define-key menu-map [byte-recompile]
144 '(menu-item "Byte-recompile Directory..." byte-recompile-directory
145 :help "Recompile every `.el' file in DIRECTORY that needs recompilation"))
146 (bindings--define-key menu-map [emacs-byte-compile-and-load]
147 '(menu-item "Byte-compile and Load" emacs-lisp-byte-compile-and-load
148 :help "Byte-compile the current file (if it has changed), then load compiled code"))
149 (bindings--define-key menu-map [byte-compile]
150 '(menu-item "Byte-compile This File" emacs-lisp-byte-compile
151 :help "Byte compile the file containing the current buffer"))
152 (bindings--define-key menu-map [separator-eval] menu-bar-separator)
153 (bindings--define-key menu-map [ielm]
154 '(menu-item "Interactive Expression Evaluation" ielm
155 :help "Interactively evaluate Emacs Lisp expressions"))
156 (bindings--define-key menu-map [eval-buffer]
157 '(menu-item "Evaluate Buffer" eval-buffer
158 :help "Execute the current buffer as Lisp code"))
159 (bindings--define-key menu-map [eval-region]
160 '(menu-item "Evaluate Region" eval-region
161 :help "Execute the region as Lisp code"
162 :enable mark-active))
163 (bindings--define-key menu-map [eval-sexp]
164 '(menu-item "Evaluate Last S-expression" eval-last-sexp
165 :help "Evaluate sexp before point; print value in echo area"))
166 (bindings--define-key menu-map [separator-format] menu-bar-separator)
167 (bindings--define-key menu-map [comment-region]
168 '(menu-item "Comment Out Region" comment-region
169 :help "Comment or uncomment each line in the region"
170 :enable mark-active))
171 (bindings--define-key menu-map [indent-region]
172 '(menu-item "Indent Region" indent-region
173 :help "Indent each nonblank line in the region"
174 :enable mark-active))
175 (bindings--define-key menu-map [indent-line]
176 '(menu-item "Indent Line" lisp-indent-line))
177 map)
178 "Keymap for Emacs Lisp mode.
179 All commands in `lisp-mode-shared-map' are inherited by this map.")
181 (defun emacs-lisp-byte-compile ()
182 "Byte compile the file containing the current buffer."
183 (interactive)
184 (if buffer-file-name
185 (byte-compile-file buffer-file-name)
186 (error "The buffer must be saved in a file first")))
188 (defun emacs-lisp-byte-compile-and-load ()
189 "Byte-compile the current file (if it has changed), then load compiled code."
190 (interactive)
191 (or buffer-file-name
192 (error "The buffer must be saved in a file first"))
193 (require 'bytecomp)
194 ;; Recompile if file or buffer has changed since last compilation.
195 (if (and (buffer-modified-p)
196 (y-or-n-p (format "Save buffer %s first? " (buffer-name))))
197 (save-buffer))
198 (byte-recompile-file buffer-file-name nil 0 t))
200 (defun emacs-lisp-macroexpand ()
201 "Macroexpand the form after point.
202 Comments in the form will be lost."
203 (interactive)
204 (let* ((start (point))
205 (exp (read (current-buffer)))
206 ;; Compute it before, since it may signal errors.
207 (new (macroexpand-1 exp)))
208 (if (equal exp new)
209 (message "Not a macro call, nothing to expand")
210 (delete-region start (point))
211 (pp new (current-buffer))
212 (if (bolp) (delete-char -1))
213 (indent-region start (point)))))
215 (defcustom emacs-lisp-mode-hook nil
216 "Hook run when entering Emacs Lisp mode."
217 :options '(eldoc-mode imenu-add-menubar-index checkdoc-minor-mode)
218 :type 'hook
219 :group 'lisp)
221 ;;;###autoload
222 (define-derived-mode emacs-lisp-mode prog-mode "Emacs-Lisp"
223 "Major mode for editing Lisp code to run in Emacs.
224 Commands:
225 Delete converts tabs to spaces as it moves back.
226 Blank lines separate paragraphs. Semicolons start comments.
228 \\{emacs-lisp-mode-map}"
229 :group 'lisp
230 (defvar xref-find-function)
231 (defvar xref-identifier-completion-table-function)
232 (lisp-mode-variables nil nil 'elisp)
233 (add-hook 'after-load-functions #'elisp--font-lock-flush-elisp-buffers)
234 (setq-local electric-pair-text-pairs
235 (cons '(?\` . ?\') electric-pair-text-pairs))
236 (setq imenu-case-fold-search nil)
237 (add-function :before-until (local 'eldoc-documentation-function)
238 #'elisp-eldoc-documentation-function)
239 (setq-local xref-find-function #'elisp-xref-find)
240 (setq-local xref-identifier-completion-table-function
241 #'elisp--xref-identifier-completion-table)
242 (add-hook 'completion-at-point-functions
243 #'elisp-completion-at-point nil 'local))
245 ;; Font-locking support.
247 (defun elisp--font-lock-flush-elisp-buffers (&optional file)
248 ;; FIXME: Aren't we only ever called from after-load-functions?
249 ;; Don't flush during load unless called from after-load-functions.
250 ;; In that case, FILE is non-nil. It's somehow strange that
251 ;; load-in-progress is t when an after-load-function is called since
252 ;; that should run *after* the load...
253 (when (or (not load-in-progress) file)
254 ;; FIXME: If the loaded file did not define any macros, there shouldn't
255 ;; be any need to font-lock-flush all the Elisp buffers.
256 (dolist (buf (buffer-list))
257 (with-current-buffer buf
258 (when (derived-mode-p 'emacs-lisp-mode)
259 ;; So as to take into account new macros that may have been defined
260 ;; by the just-loaded file.
261 (font-lock-flush))))))
263 ;;; Completion at point for Elisp
265 (defun elisp--local-variables-1 (vars sexp)
266 "Return the vars locally bound around the witness, or nil if not found."
267 (let (res)
268 (while
269 (unless
270 (setq res
271 (pcase sexp
272 (`(,(or `let `let*) ,bindings)
273 (let ((vars vars))
274 (when (eq 'let* (car sexp))
275 (dolist (binding (cdr (reverse bindings)))
276 (push (or (car-safe binding) binding) vars)))
277 (elisp--local-variables-1
278 vars (car (cdr-safe (car (last bindings)))))))
279 (`(,(or `let `let*) ,bindings . ,body)
280 (let ((vars vars))
281 (dolist (binding bindings)
282 (push (or (car-safe binding) binding) vars))
283 (elisp--local-variables-1 vars (car (last body)))))
284 (`(lambda ,_args)
285 ;; FIXME: Look for the witness inside `args'.
286 (setq sexp nil))
287 (`(lambda ,args . ,body)
288 (elisp--local-variables-1
289 (append (remq '&optional (remq '&rest args)) vars)
290 (car (last body))))
291 (`(condition-case ,_ ,e) (elisp--local-variables-1 vars e))
292 (`(condition-case ,v ,_ . ,catches)
293 (elisp--local-variables-1
294 (cons v vars) (cdr (car (last catches)))))
295 (`(quote . ,_)
296 ;; FIXME: Look for the witness inside sexp.
297 (setq sexp nil))
298 ;; FIXME: Handle `cond'.
299 (`(,_ . ,_)
300 (elisp--local-variables-1 vars (car (last sexp))))
301 (`elisp--witness--lisp (or vars '(nil)))
302 (_ nil)))
303 ;; We didn't find the witness in the last element so we try to
304 ;; backtrack to the last-but-one.
305 (setq sexp (ignore-errors (butlast sexp)))))
306 res))
308 (defun elisp--local-variables ()
309 "Return a list of locally let-bound variables at point."
310 (save-excursion
311 (skip-syntax-backward "w_")
312 (let* ((ppss (syntax-ppss))
313 (txt (buffer-substring-no-properties (or (car (nth 9 ppss)) (point))
314 (or (nth 8 ppss) (point))))
315 (closer ()))
316 (dolist (p (nth 9 ppss))
317 (push (cdr (syntax-after p)) closer))
318 (setq closer (apply #'string closer))
319 (let* ((sexp (condition-case nil
320 (car (read-from-string
321 (concat txt "elisp--witness--lisp" closer)))
322 ((invalid-read-syntax end-of-file) nil)))
323 (macroexpand-advice (lambda (expander form &rest args)
324 (condition-case nil
325 (apply expander form args)
326 (error form))))
327 (sexp
328 (unwind-protect
329 (progn
330 (advice-add 'macroexpand :around macroexpand-advice)
331 (macroexpand-all sexp))
332 (advice-remove 'macroexpand macroexpand-advice)))
333 (vars (elisp--local-variables-1 nil sexp)))
334 (delq nil
335 (mapcar (lambda (var)
336 (and (symbolp var)
337 (not (string-match (symbol-name var) "\\`[&_]"))
338 ;; Eliminate uninterned vars.
339 (intern-soft var)
340 var))
341 vars))))))
343 (defvar elisp--local-variables-completion-table
344 ;; Use `defvar' rather than `defconst' since defconst would purecopy this
345 ;; value, which would doubly fail: it would fail because purecopy can't
346 ;; handle the recursive bytecode object, and it would fail because it would
347 ;; move `lastpos' and `lastvars' to pure space where they'd be immutable!
348 (let ((lastpos nil) (lastvars nil))
349 (letrec ((hookfun (lambda ()
350 (setq lastpos nil)
351 (remove-hook 'post-command-hook hookfun))))
352 (completion-table-dynamic
353 (lambda (_string)
354 (save-excursion
355 (skip-syntax-backward "_w")
356 (let ((newpos (cons (point) (current-buffer))))
357 (unless (equal lastpos newpos)
358 (add-hook 'post-command-hook hookfun)
359 (setq lastpos newpos)
360 (setq lastvars
361 (mapcar #'symbol-name (elisp--local-variables))))))
362 lastvars)))))
364 (defun elisp--expect-function-p (pos)
365 "Return non-nil if the symbol at point is expected to be a function."
367 (and (eq (char-before pos) ?')
368 (eq (char-before (1- pos)) ?#))
369 (save-excursion
370 (let ((parent (nth 1 (syntax-ppss pos))))
371 (when parent
372 (goto-char parent)
373 (and
374 (looking-at (concat "(\\(cl-\\)?"
375 (regexp-opt '("declare-function"
376 "function" "defadvice"
377 "callf" "callf2"
378 "defsetf"))
379 "[ \t\r\n]+"))
380 (eq (match-end 0) pos)))))))
382 (defun elisp--form-quoted-p (pos)
383 "Return non-nil if the form at POS is not evaluated.
384 It can be quoted, or be inside a quoted form."
385 ;; FIXME: Do some macro expansion maybe.
386 (save-excursion
387 (let ((state (syntax-ppss pos)))
388 (or (nth 8 state) ; Code inside strings usually isn't evaluated.
389 ;; FIXME: The 9th element is undocumented.
390 (let ((nesting (cons (point) (reverse (nth 9 state))))
391 res)
392 (while (and nesting (not res))
393 (goto-char (pop nesting))
394 (cond
395 ((or (eq (char-after) ?\[)
396 (progn
397 (skip-chars-backward " ")
398 (memq (char-before) '(?' ?`))))
399 (setq res t))
400 ((eq (char-before) ?,)
401 (setq nesting nil))))
402 res)))))
404 ;; FIXME: Support for Company brings in features which straddle eldoc.
405 ;; We should consolidate this, so that major modes can provide all that
406 ;; data all at once:
407 ;; - a function to extract "the reference at point" (may be more complex
408 ;; than a mere string, to distinguish various namespaces).
409 ;; - a function to jump to such a reference.
410 ;; - a function to show the signature/interface of such a reference.
411 ;; - a function to build a help-buffer about that reference.
412 ;; FIXME: Those functions should also be used by the normal completion code in
413 ;; the *Completions* buffer.
415 (defun elisp--company-doc-buffer (str)
416 (let ((symbol (intern-soft str)))
417 ;; FIXME: we really don't want to "display-buffer and then undo it".
418 (save-window-excursion
419 ;; Make sure we don't display it in another frame, otherwise
420 ;; save-window-excursion won't be able to undo it.
421 (let ((display-buffer-overriding-action
422 '(nil . ((inhibit-switch-frame . t)))))
423 (ignore-errors
424 (cond
425 ((fboundp symbol) (describe-function symbol))
426 ((boundp symbol) (describe-variable symbol))
427 ((featurep symbol) (describe-package symbol))
428 ((facep symbol) (describe-face symbol))
429 (t (signal 'user-error nil)))
430 (help-buffer))))))
432 (defun elisp--company-doc-string (str)
433 (let* ((symbol (intern-soft str))
434 (doc (if (fboundp symbol)
435 (documentation symbol t)
436 (documentation-property symbol 'variable-documentation t))))
437 (and (stringp doc)
438 (string-match ".*$" doc)
439 (match-string 0 doc))))
441 (declare-function find-library-name "find-func" (library))
442 (declare-function find-function-library "find-func" (function &optional l-o v))
444 (defun elisp--company-location (str)
445 (let ((sym (intern-soft str)))
446 (cond
447 ((fboundp sym) (find-definition-noselect sym nil))
448 ((boundp sym) (find-definition-noselect sym 'defvar))
449 ((featurep sym)
450 (require 'find-func)
451 (cons (find-file-noselect (find-library-name
452 (symbol-name sym)))
454 ((facep sym) (find-definition-noselect sym 'defface)))))
456 (defun elisp-completion-at-point ()
457 "Function used for `completion-at-point-functions' in `emacs-lisp-mode'."
458 (with-syntax-table emacs-lisp-mode-syntax-table
459 (let* ((pos (point))
460 (beg (condition-case nil
461 (save-excursion
462 (backward-sexp 1)
463 (skip-syntax-forward "'")
464 (point))
465 (scan-error pos)))
466 (end
467 (unless (or (eq beg (point-max))
468 (member (char-syntax (char-after beg))
469 '(?\s ?\" ?\( ?\))))
470 (condition-case nil
471 (save-excursion
472 (goto-char beg)
473 (forward-sexp 1)
474 (skip-chars-backward "'")
475 (when (>= (point) pos)
476 (point)))
477 (scan-error pos))))
478 ;; t if in function position.
479 (funpos (eq (char-before beg) ?\()))
480 (when (and end (or (not (nth 8 (syntax-ppss)))
481 (eq (char-before beg) ?`)))
482 (let ((table-etc
483 (if (not funpos)
484 ;; FIXME: We could look at the first element of the list and
485 ;; use it to provide a more specific completion table in some
486 ;; cases. E.g. filter out keywords that are not understood by
487 ;; the macro/function being called.
488 (cond
489 ((elisp--expect-function-p beg)
490 (list nil obarray
491 :predicate #'fboundp
492 :company-doc-buffer #'elisp--company-doc-buffer
493 :company-docsig #'elisp--company-doc-string
494 :company-location #'elisp--company-location))
495 ((elisp--form-quoted-p beg)
496 (list nil obarray
497 ;; Don't include all symbols (bug#16646).
498 :predicate (lambda (sym)
499 (or (boundp sym)
500 (fboundp sym)
501 (featurep sym)
502 (symbol-plist sym)))
503 :annotation-function
504 (lambda (str) (if (fboundp (intern-soft str)) " <f>"))
505 :company-doc-buffer #'elisp--company-doc-buffer
506 :company-docsig #'elisp--company-doc-string
507 :company-location #'elisp--company-location))
509 (list nil (completion-table-merge
510 elisp--local-variables-completion-table
511 (apply-partially #'completion-table-with-predicate
512 obarray
513 #'boundp
514 'strict))
515 :company-doc-buffer #'elisp--company-doc-buffer
516 :company-docsig #'elisp--company-doc-string
517 :company-location #'elisp--company-location)))
518 ;; Looks like a funcall position. Let's double check.
519 (save-excursion
520 (goto-char (1- beg))
521 (let ((parent
522 (condition-case nil
523 (progn (up-list -1) (forward-char 1)
524 (let ((c (char-after)))
525 (if (eq c ?\() ?\(
526 (if (memq (char-syntax c) '(?w ?_))
527 (read (current-buffer))))))
528 (error nil))))
529 (pcase parent
530 ;; FIXME: Rather than hardcode special cases here,
531 ;; we should use something like a symbol-property.
532 (`declare
533 (list t (mapcar (lambda (x) (symbol-name (car x)))
534 (delete-dups
535 ;; FIXME: We should include some
536 ;; docstring with each entry.
537 (append
538 macro-declarations-alist
539 defun-declarations-alist)))))
540 ((and (or `condition-case `condition-case-unless-debug)
541 (guard (save-excursion
542 (ignore-errors
543 (forward-sexp 2)
544 (< (point) beg)))))
545 (list t obarray
546 :predicate (lambda (sym) (get sym 'error-conditions))))
547 ((and ?\(
548 (guard (save-excursion
549 (goto-char (1- beg))
550 (up-list -1)
551 (forward-symbol -1)
552 (looking-at "\\_<let\\*?\\_>"))))
553 (list t obarray
554 :predicate #'boundp
555 :company-doc-buffer #'elisp--company-doc-buffer
556 :company-docsig #'elisp--company-doc-string
557 :company-location #'elisp--company-location))
558 (_ (list nil obarray
559 :predicate #'fboundp
560 :company-doc-buffer #'elisp--company-doc-buffer
561 :company-docsig #'elisp--company-doc-string
562 :company-location #'elisp--company-location
563 ))))))))
564 (nconc (list beg end)
565 (if (null (car table-etc))
566 (cdr table-etc)
567 (cons
568 (if (memq (char-syntax (or (char-after end) ?\s))
569 '(?\s ?>))
570 (cadr table-etc)
571 (apply-partially 'completion-table-with-terminator
572 " " (cadr table-etc)))
573 (cddr table-etc)))))))))
575 (define-obsolete-function-alias
576 'lisp-completion-at-point 'elisp-completion-at-point "25.1")
578 ;;; Xref backend
580 (declare-function xref-make-elisp-location "xref" (symbol type file))
581 (declare-function xref-make-bogus-location "xref" (message))
582 (declare-function xref-make "xref" (description location))
584 (defun elisp-xref-find (action id)
585 (require 'find-func)
586 (pcase action
587 (`definitions
588 (let ((sym (intern-soft id)))
589 (when sym
590 (elisp--xref-find-definitions sym))))
591 (`apropos
592 (elisp--xref-find-apropos id))))
594 (defun elisp--xref-identifier-location (type sym)
595 (let ((file
596 (pcase type
597 (`defun (when (fboundp sym)
598 (let ((fun-lib
599 (find-function-library sym)))
600 (setq sym (car fun-lib))
601 (cdr fun-lib))))
602 (`defvar (and (boundp sym)
603 ;; Don't show minor modes twice.
604 ;; TODO: If TYPE ever becomes dependent on the
605 ;; context, move this check outside.
606 (not (fboundp sym))
607 (or (symbol-file sym 'defvar)
608 (help-C-file-name sym 'var))))
609 (`feature (and (featurep sym)
610 ;; Skip when a function with the same name
611 ;; is defined, because it's probably in the
612 ;; same file.
613 (not (fboundp sym))
614 (ignore-errors
615 (find-library-name (symbol-name sym)))))
616 (`defface (when (facep sym)
617 (symbol-file sym 'defface))))))
618 (when file
619 (when (string-match-p "\\.elc\\'" file)
620 (setq file (substring file 0 -1)))
621 (xref-make-elisp-location sym type file))))
623 (defun elisp--xref-find-definitions (symbol)
624 (save-excursion
625 (let (lst)
626 (dolist (type '(feature defface defvar defun))
627 (let ((loc
628 (condition-case err
629 (elisp--xref-identifier-location type symbol)
630 (error
631 (xref-make-bogus-location (error-message-string err))))))
632 (when loc
633 (push
634 (xref-make (format "(%s %s)" type symbol)
635 loc)
636 lst))))
637 lst)))
639 (defun elisp--xref-find-apropos (regexp)
640 (apply #'nconc
641 (let (lst)
642 (dolist (sym (apropos-internal regexp))
643 (push (elisp--xref-find-definitions sym) lst))
644 (nreverse lst))))
646 (defvar elisp--xref-identifier-completion-table
647 (apply-partially #'completion-table-with-predicate
648 obarray
649 (lambda (sym)
650 (or (boundp sym)
651 (fboundp sym)
652 (featurep sym)
653 (facep sym)))
654 'strict))
656 (defun elisp--xref-identifier-completion-table ()
657 elisp--xref-identifier-completion-table)
659 ;;; Elisp Interaction mode
661 (defvar lisp-interaction-mode-map
662 (let ((map (make-sparse-keymap))
663 (menu-map (make-sparse-keymap "Lisp-Interaction")))
664 (set-keymap-parent map lisp-mode-shared-map)
665 (define-key map "\e\C-x" 'eval-defun)
666 (define-key map "\e\C-q" 'indent-pp-sexp)
667 (define-key map "\e\t" 'completion-at-point)
668 (define-key map "\n" 'eval-print-last-sexp)
669 (bindings--define-key map [menu-bar lisp-interaction]
670 (cons "Lisp-Interaction" menu-map))
671 (bindings--define-key menu-map [eval-defun]
672 '(menu-item "Evaluate Defun" eval-defun
673 :help "Evaluate the top-level form containing point, or after point"))
674 (bindings--define-key menu-map [eval-print-last-sexp]
675 '(menu-item "Evaluate and Print" eval-print-last-sexp
676 :help "Evaluate sexp before point; print value into current buffer"))
677 (bindings--define-key menu-map [edebug-defun-lisp-interaction]
678 '(menu-item "Instrument Function for Debugging" edebug-defun
679 :help "Evaluate the top level form point is in, stepping through with Edebug"
680 :keys "C-u C-M-x"))
681 (bindings--define-key menu-map [indent-pp-sexp]
682 '(menu-item "Indent or Pretty-Print" indent-pp-sexp
683 :help "Indent each line of the list starting just after point, or prettyprint it"))
684 (bindings--define-key menu-map [complete-symbol]
685 '(menu-item "Complete Lisp Symbol" completion-at-point
686 :help "Perform completion on Lisp symbol preceding point"))
687 map)
688 "Keymap for Lisp Interaction mode.
689 All commands in `lisp-mode-shared-map' are inherited by this map.")
691 (define-derived-mode lisp-interaction-mode emacs-lisp-mode "Lisp Interaction"
692 "Major mode for typing and evaluating Lisp forms.
693 Like Lisp mode except that \\[eval-print-last-sexp] evals the Lisp expression
694 before point, and prints its value into the buffer, advancing point.
695 Note that printing is controlled by `eval-expression-print-length'
696 and `eval-expression-print-level'.
698 Commands:
699 Delete converts tabs to spaces as it moves back.
700 Paragraphs are separated only by blank lines.
701 Semicolons start comments.
703 \\{lisp-interaction-mode-map}"
704 :abbrev-table nil)
706 ;;; Emacs Lisp Byte-Code mode
708 (eval-and-compile
709 (defconst emacs-list-byte-code-comment-re
710 (concat "\\(#\\)@\\([0-9]+\\) "
711 ;; Make sure it's a docstring and not a lazy-loaded byte-code.
712 "\\(?:[^(]\\|([^\"]\\)")))
714 (defun elisp--byte-code-comment (end &optional _point)
715 "Try to syntactically mark the #@NNN ....^_ docstrings in byte-code files."
716 (let ((ppss (syntax-ppss)))
717 (when (and (nth 4 ppss)
718 (eq (char-after (nth 8 ppss)) ?#))
719 (let* ((n (save-excursion
720 (goto-char (nth 8 ppss))
721 (when (looking-at emacs-list-byte-code-comment-re)
722 (string-to-number (match-string 2)))))
723 ;; `maxdiff' tries to make sure the loop below terminates.
724 (maxdiff n))
725 (when n
726 (let* ((bchar (match-end 2))
727 (b (position-bytes bchar)))
728 (goto-char (+ b n))
729 (while (let ((diff (- (position-bytes (point)) b n)))
730 (unless (zerop diff)
731 (when (> diff maxdiff) (setq diff maxdiff))
732 (forward-char (- diff))
733 (setq maxdiff (if (> diff 0) diff
734 (max (1- maxdiff) 1)))
735 t))))
736 (if (<= (point) end)
737 (put-text-property (1- (point)) (point)
738 'syntax-table
739 (string-to-syntax "> b"))
740 (goto-char end)))))))
742 (defun elisp-byte-code-syntax-propertize (start end)
743 (elisp--byte-code-comment end (point))
744 (funcall
745 (syntax-propertize-rules
746 (emacs-list-byte-code-comment-re
747 (1 (prog1 "< b" (elisp--byte-code-comment end (point))))))
748 start end))
750 ;;;###autoload
751 (add-to-list 'auto-mode-alist '("\\.elc\\'" . elisp-byte-code-mode))
752 ;;;###autoload
753 (define-derived-mode elisp-byte-code-mode emacs-lisp-mode
754 "Elisp-Byte-Code"
755 "Major mode for *.elc files."
756 ;; TODO: Add way to disassemble byte-code under point.
757 (setq-local open-paren-in-column-0-is-defun-start nil)
758 (setq-local syntax-propertize-function
759 #'elisp-byte-code-syntax-propertize))
762 ;;; Globally accessible functionality
764 (defun eval-print-last-sexp (&optional eval-last-sexp-arg-internal)
765 "Evaluate sexp before point; print value into current buffer.
767 Normally, this function truncates long output according to the value
768 of the variables `eval-expression-print-length' and
769 `eval-expression-print-level'. With a prefix argument of zero,
770 however, there is no such truncation. Such a prefix argument
771 also causes integers to be printed in several additional formats
772 \(octal, hexadecimal, and character).
774 If `eval-expression-debug-on-error' is non-nil, which is the default,
775 this command arranges for all errors to enter the debugger."
776 (interactive "P")
777 (let ((standard-output (current-buffer)))
778 (terpri)
779 (eval-last-sexp (or eval-last-sexp-arg-internal t))
780 (terpri)))
783 (defun last-sexp-setup-props (beg end value alt1 alt2)
784 "Set up text properties for the output of `elisp--eval-last-sexp'.
785 BEG and END are the start and end of the output in current-buffer.
786 VALUE is the Lisp value printed, ALT1 and ALT2 are strings for the
787 alternative printed representations that can be displayed."
788 (let ((map (make-sparse-keymap)))
789 (define-key map "\C-m" 'elisp-last-sexp-toggle-display)
790 (define-key map [down-mouse-2] 'mouse-set-point)
791 (define-key map [mouse-2] 'elisp-last-sexp-toggle-display)
792 (add-text-properties
793 beg end
794 `(printed-value (,value ,alt1 ,alt2)
795 mouse-face highlight
796 keymap ,map
797 help-echo "RET, mouse-2: toggle abbreviated display"
798 rear-nonsticky (mouse-face keymap help-echo
799 printed-value)))))
802 (defun elisp-last-sexp-toggle-display (&optional _arg)
803 "Toggle between abbreviated and unabbreviated printed representations."
804 (interactive "P")
805 (save-restriction
806 (widen)
807 (let ((value (get-text-property (point) 'printed-value)))
808 (when value
809 (let ((beg (or (previous-single-property-change (min (point-max) (1+ (point)))
810 'printed-value)
811 (point)))
812 (end (or (next-single-char-property-change (point) 'printed-value) (point)))
813 (standard-output (current-buffer))
814 (point (point)))
815 (delete-region beg end)
816 (insert (nth 1 value))
817 (or (= beg point)
818 (setq point (1- (point))))
819 (last-sexp-setup-props beg (point)
820 (nth 0 value)
821 (nth 2 value)
822 (nth 1 value))
823 (goto-char (min (point-max) point)))))))
825 (defun prin1-char (char) ;FIXME: Move it, e.g. to simple.el.
826 "Return a string representing CHAR as a character rather than as an integer.
827 If CHAR is not a character, return nil."
828 (and (integerp char)
829 (eventp char)
830 (let ((c (event-basic-type char))
831 (mods (event-modifiers char))
832 string)
833 ;; Prevent ?A from turning into ?\S-a.
834 (if (and (memq 'shift mods)
835 (zerop (logand char ?\S-\^@))
836 (not (let ((case-fold-search nil))
837 (char-equal c (upcase c)))))
838 (setq c (upcase c) mods nil))
839 ;; What string are we considering using?
840 (condition-case nil
841 (setq string
842 (concat
844 (mapconcat
845 (lambda (modif)
846 (cond ((eq modif 'super) "\\s-")
847 (t (string ?\\ (upcase (aref (symbol-name modif) 0)) ?-))))
848 mods "")
849 (cond
850 ((memq c '(?\; ?\( ?\) ?\{ ?\} ?\[ ?\] ?\" ?\' ?\\)) (string ?\\ c))
851 ((eq c 127) "\\C-?")
853 (string c)))))
854 (error nil))
855 ;; Verify the string reads a CHAR, not to some other character.
856 ;; If it doesn't, return nil instead.
857 (and string
858 (= (car (read-from-string string)) char)
859 string))))
861 (defun elisp--preceding-sexp ()
862 "Return sexp before the point."
863 (let ((opoint (point))
864 ignore-quotes
865 expr)
866 (save-excursion
867 (with-syntax-table emacs-lisp-mode-syntax-table
868 ;; If this sexp appears to be enclosed in `...'
869 ;; then ignore the surrounding quotes.
870 (setq ignore-quotes
871 (or (eq (following-char) ?\')
872 (eq (preceding-char) ?\')))
873 (forward-sexp -1)
874 ;; If we were after `?\e' (or similar case),
875 ;; use the whole thing, not just the `e'.
876 (when (eq (preceding-char) ?\\)
877 (forward-char -1)
878 (when (eq (preceding-char) ??)
879 (forward-char -1)))
881 ;; Skip over hash table read syntax.
882 (and (> (point) (1+ (point-min)))
883 (looking-back "#s" (- (point) 2))
884 (forward-char -2))
886 ;; Skip over `#N='s.
887 (when (eq (preceding-char) ?=)
888 (let (labeled-p)
889 (save-excursion
890 (skip-chars-backward "0-9#=")
891 (setq labeled-p (looking-at "\\(#[0-9]+=\\)+")))
892 (when labeled-p
893 (forward-sexp -1))))
895 (save-restriction
896 (if (and ignore-quotes (eq (following-char) ?`))
897 ;; vladimir@cs.ualberta.ca 30-Jul-1997: Skip ` in `variable' so
898 ;; that the value is returned, not the name.
899 (forward-char))
900 (when (looking-at ",@?") (goto-char (match-end 0)))
901 (narrow-to-region (point-min) opoint)
902 (setq expr (read (current-buffer)))
903 ;; If it's an (interactive ...) form, it's more useful to show how an
904 ;; interactive call would use it.
905 ;; FIXME: Is it really the right place for this?
906 (when (eq (car-safe expr) 'interactive)
907 (setq expr
908 `(call-interactively
909 (lambda (&rest args) ,expr args))))
910 expr)))))
911 (define-obsolete-function-alias 'preceding-sexp 'elisp--preceding-sexp "25.1")
913 (defun elisp--eval-last-sexp (eval-last-sexp-arg-internal)
914 "Evaluate sexp before point; print value in the echo area.
915 If EVAL-LAST-SEXP-ARG-INTERNAL is non-nil, print output into
916 current buffer. If EVAL-LAST-SEXP-ARG-INTERNAL is `0', print
917 output with no limit on the length and level of lists, and
918 include additional formats for integers \(octal, hexadecimal, and
919 character)."
920 (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t)))
921 ;; Setup the lexical environment if lexical-binding is enabled.
922 (elisp--eval-last-sexp-print-value
923 (eval (eval-sexp-add-defvars (elisp--preceding-sexp)) lexical-binding)
924 eval-last-sexp-arg-internal)))
927 (defun elisp--eval-last-sexp-print-value (value &optional eval-last-sexp-arg-internal)
928 (let ((unabbreviated (let ((print-length nil) (print-level nil))
929 (prin1-to-string value)))
930 (print-length (and (not (zerop (prefix-numeric-value
931 eval-last-sexp-arg-internal)))
932 eval-expression-print-length))
933 (print-level (and (not (zerop (prefix-numeric-value
934 eval-last-sexp-arg-internal)))
935 eval-expression-print-level))
936 (beg (point))
937 end)
938 (prog1
939 (prin1 value)
940 (let ((str (eval-expression-print-format value)))
941 (if str (princ str)))
942 (setq end (point))
943 (when (and (bufferp standard-output)
944 (or (not (null print-length))
945 (not (null print-level)))
946 (not (string= unabbreviated
947 (buffer-substring-no-properties beg end))))
948 (last-sexp-setup-props beg end value
949 unabbreviated
950 (buffer-substring-no-properties beg end))
951 ))))
954 (defvar elisp--eval-last-sexp-fake-value (make-symbol "t"))
956 (defun eval-sexp-add-defvars (exp &optional pos)
957 "Prepend EXP with all the `defvar's that precede it in the buffer.
958 POS specifies the starting position where EXP was found and defaults to point."
959 (setq exp (macroexpand-all exp)) ;Eager macro-expansion.
960 (if (not lexical-binding)
962 (save-excursion
963 (unless pos (setq pos (point)))
964 (let ((vars ()))
965 (goto-char (point-min))
966 (while (re-search-forward
967 "(def\\(?:var\\|const\\|custom\\)[ \t\n]+\\([^; '()\n\t]+\\)"
968 pos t)
969 (let ((var (intern (match-string 1))))
970 (and (not (special-variable-p var))
971 (save-excursion
972 (zerop (car (syntax-ppss (match-beginning 0)))))
973 (push var vars))))
974 `(progn ,@(mapcar (lambda (v) `(defvar ,v)) vars) ,exp)))))
976 (defun eval-last-sexp (eval-last-sexp-arg-internal)
977 "Evaluate sexp before point; print value in the echo area.
978 Interactively, with prefix argument, print output into current buffer.
980 Normally, this function truncates long output according to the value
981 of the variables `eval-expression-print-length' and
982 `eval-expression-print-level'. With a prefix argument of zero,
983 however, there is no such truncation. Such a prefix argument
984 also causes integers to be printed in several additional formats
985 \(octal, hexadecimal, and character).
987 If `eval-expression-debug-on-error' is non-nil, which is the default,
988 this command arranges for all errors to enter the debugger."
989 (interactive "P")
990 (if (null eval-expression-debug-on-error)
991 (elisp--eval-last-sexp eval-last-sexp-arg-internal)
992 (let ((value
993 (let ((debug-on-error elisp--eval-last-sexp-fake-value))
994 (cons (elisp--eval-last-sexp eval-last-sexp-arg-internal)
995 debug-on-error))))
996 (unless (eq (cdr value) elisp--eval-last-sexp-fake-value)
997 (setq debug-on-error (cdr value)))
998 (car value))))
1000 (defun elisp--eval-defun-1 (form)
1001 "Treat some expressions specially.
1002 Reset the `defvar' and `defcustom' variables to the initial value.
1003 \(For `defcustom', use the :set function if there is one.)
1004 Reinitialize the face according to the `defface' specification."
1005 ;; The code in edebug-defun should be consistent with this, but not
1006 ;; the same, since this gets a macroexpanded form.
1007 (cond ((not (listp form))
1008 form)
1009 ((and (eq (car form) 'defvar)
1010 (cdr-safe (cdr-safe form))
1011 (boundp (cadr form)))
1012 ;; Force variable to be re-set.
1013 `(progn (defvar ,(nth 1 form) nil ,@(nthcdr 3 form))
1014 (setq-default ,(nth 1 form) ,(nth 2 form))))
1015 ;; `defcustom' is now macroexpanded to
1016 ;; `custom-declare-variable' with a quoted value arg.
1017 ((and (eq (car form) 'custom-declare-variable)
1018 (default-boundp (eval (nth 1 form) lexical-binding)))
1019 ;; Force variable to be bound, using :set function if specified.
1020 (let ((setfunc (memq :set form)))
1021 (when setfunc
1022 (setq setfunc (car-safe (cdr-safe setfunc)))
1023 (or (functionp setfunc) (setq setfunc nil)))
1024 (funcall (or setfunc 'set-default)
1025 (eval (nth 1 form) lexical-binding)
1026 ;; The second arg is an expression that evaluates to
1027 ;; an expression. The second evaluation is the one
1028 ;; normally performed not by normal execution but by
1029 ;; custom-initialize-set (for example), which does not
1030 ;; use lexical-binding.
1031 (eval (eval (nth 2 form) lexical-binding))))
1032 form)
1033 ;; `defface' is macroexpanded to `custom-declare-face'.
1034 ((eq (car form) 'custom-declare-face)
1035 ;; Reset the face.
1036 (let ((face-symbol (eval (nth 1 form) lexical-binding)))
1037 (setq face-new-frame-defaults
1038 (assq-delete-all face-symbol face-new-frame-defaults))
1039 (put face-symbol 'face-defface-spec nil)
1040 (put face-symbol 'face-override-spec nil))
1041 form)
1042 ((eq (car form) 'progn)
1043 (cons 'progn (mapcar #'elisp--eval-defun-1 (cdr form))))
1044 (t form)))
1046 (defun elisp--eval-defun ()
1047 "Evaluate defun that point is in or before.
1048 The value is displayed in the echo area.
1049 If the current defun is actually a call to `defvar',
1050 then reset the variable using the initial value expression
1051 even if the variable already has some other value.
1052 \(Normally `defvar' does not change the variable's value
1053 if it already has a value.\)
1055 Return the result of evaluation."
1056 ;; FIXME: the print-length/level bindings should only be applied while
1057 ;; printing, not while evaluating.
1058 (let ((debug-on-error eval-expression-debug-on-error)
1059 (print-length eval-expression-print-length)
1060 (print-level eval-expression-print-level))
1061 (save-excursion
1062 ;; Arrange for eval-region to "read" the (possibly) altered form.
1063 ;; eval-region handles recording which file defines a function or
1064 ;; variable.
1065 (let ((standard-output t)
1066 beg end form)
1067 ;; Read the form from the buffer, and record where it ends.
1068 (save-excursion
1069 (end-of-defun)
1070 (beginning-of-defun)
1071 (setq beg (point))
1072 (setq form (read (current-buffer)))
1073 (setq end (point)))
1074 ;; Alter the form if necessary.
1075 (let ((form (eval-sexp-add-defvars
1076 (elisp--eval-defun-1 (macroexpand form)))))
1077 (eval-region beg end standard-output
1078 (lambda (_ignore)
1079 ;; Skipping to the end of the specified region
1080 ;; will make eval-region return.
1081 (goto-char end)
1082 form))))))
1083 (let ((str (eval-expression-print-format (car values))))
1084 (if str (princ str)))
1085 ;; The result of evaluation has been put onto VALUES. So return it.
1086 (car values))
1088 (defun eval-defun (edebug-it)
1089 "Evaluate the top-level form containing point, or after point.
1091 If the current defun is actually a call to `defvar' or `defcustom',
1092 evaluating it this way resets the variable using its initial value
1093 expression (using the defcustom's :set function if there is one), even
1094 if the variable already has some other value. \(Normally `defvar' and
1095 `defcustom' do not alter the value if there already is one.) In an
1096 analogous way, evaluating a `defface' overrides any customizations of
1097 the face, so that it becomes defined exactly as the `defface' expression
1098 says.
1100 If `eval-expression-debug-on-error' is non-nil, which is the default,
1101 this command arranges for all errors to enter the debugger.
1103 With a prefix argument, instrument the code for Edebug.
1105 If acting on a `defun' for FUNCTION, and the function was
1106 instrumented, `Edebug: FUNCTION' is printed in the echo area. If not
1107 instrumented, just FUNCTION is printed.
1109 If not acting on a `defun', the result of evaluation is displayed in
1110 the echo area. This display is controlled by the variables
1111 `eval-expression-print-length' and `eval-expression-print-level',
1112 which see."
1113 (interactive "P")
1114 (cond (edebug-it
1115 (require 'edebug)
1116 (eval-defun (not edebug-all-defs)))
1118 (if (null eval-expression-debug-on-error)
1119 (elisp--eval-defun)
1120 (let (new-value value)
1121 (let ((debug-on-error elisp--eval-last-sexp-fake-value))
1122 (setq value (elisp--eval-defun))
1123 (setq new-value debug-on-error))
1124 (unless (eq elisp--eval-last-sexp-fake-value new-value)
1125 (setq debug-on-error new-value))
1126 value)))))
1128 ;;; ElDoc Support
1130 (defvar elisp--eldoc-last-data (make-vector 3 nil)
1131 "Bookkeeping; elements are as follows:
1132 0 - contains the last symbol read from the buffer.
1133 1 - contains the string last displayed in the echo area for variables,
1134 or argument string for functions.
1135 2 - 'function if function args, 'variable if variable documentation.")
1137 (defun elisp-eldoc-documentation-function ()
1138 "`eldoc-documentation-function' (which see) for Emacs Lisp."
1139 (let ((current-symbol (elisp--current-symbol))
1140 (current-fnsym (elisp--fnsym-in-current-sexp)))
1141 (cond ((null current-fnsym)
1142 nil)
1143 ((eq current-symbol (car current-fnsym))
1144 (or (apply #'elisp--get-fnsym-args-string current-fnsym)
1145 (elisp--get-var-docstring current-symbol)))
1147 (or (elisp--get-var-docstring current-symbol)
1148 (apply #'elisp--get-fnsym-args-string current-fnsym))))))
1150 (defun elisp--get-fnsym-args-string (sym &optional index)
1151 "Return a string containing the parameter list of the function SYM.
1152 If SYM is a subr and no arglist is obtainable from the docstring
1153 or elsewhere, return a 1-line docstring."
1154 (let ((argstring
1155 (cond
1156 ((not (and sym (symbolp sym) (fboundp sym))) nil)
1157 ((and (eq sym (aref elisp--eldoc-last-data 0))
1158 (eq 'function (aref elisp--eldoc-last-data 2)))
1159 (aref elisp--eldoc-last-data 1))
1161 (let* ((advertised (gethash (indirect-function sym)
1162 advertised-signature-table t))
1164 (args
1165 (cond
1166 ((listp advertised) advertised)
1167 ((setq doc (help-split-fundoc (documentation sym t) sym))
1168 (car doc))
1169 (t (help-function-arglist sym)))))
1170 ;; Stringify, and store before highlighting, downcasing, etc.
1171 ;; FIXME should truncate before storing.
1172 (elisp--last-data-store sym (elisp--function-argstring args)
1173 'function))))))
1174 ;; Highlight, truncate.
1175 (if argstring
1176 (elisp--highlight-function-argument sym argstring index))))
1178 (defun elisp--highlight-function-argument (sym args index)
1179 "Highlight argument INDEX in ARGS list for function SYM.
1180 In the absence of INDEX, just call `elisp--docstring-format-sym-doc'."
1181 ;; FIXME: This should probably work on the list representation of `args'
1182 ;; rather than its string representation.
1183 ;; FIXME: This function is much too long, we need to split it up!
1184 (let ((start nil)
1185 (end 0)
1186 (argument-face 'eldoc-highlight-function-argument)
1187 (args-lst (mapcar (lambda (x)
1188 (replace-regexp-in-string
1189 "\\`[(]\\|[)]\\'" "" x))
1190 (split-string args))))
1191 ;; Find the current argument in the argument string. We need to
1192 ;; handle `&rest' and informal `...' properly.
1194 ;; FIXME: What to do with optional arguments, like in
1195 ;; (defun NAME ARGLIST [DOCSTRING] BODY...) case?
1196 ;; The problem is there is no robust way to determine if
1197 ;; the current argument is indeed a docstring.
1199 ;; When `&key' is used finding position based on `index'
1200 ;; would be wrong, so find the arg at point and determine
1201 ;; position in ARGS based on this current arg.
1202 (when (string-match "&key" args)
1203 (let* (case-fold-search
1204 key-have-value
1205 (sym-name (symbol-name sym))
1206 (cur-w (current-word))
1207 (args-lst-ak (cdr (member "&key" args-lst)))
1208 (limit (save-excursion
1209 (when (re-search-backward sym-name nil t)
1210 (match-end 0))))
1211 (cur-a (if (and cur-w (string-match ":\\([^ ()]*\\)" cur-w))
1212 (substring cur-w 1)
1213 (save-excursion
1214 (let (split)
1215 (when (re-search-backward ":\\([^()\n]*\\)" limit t)
1216 (setq split (split-string (match-string 1) " " t))
1217 (prog1 (car split)
1218 (when (cdr split)
1219 (setq key-have-value t))))))))
1220 ;; If `cur-a' is not one of `args-lst-ak'
1221 ;; assume user is entering an unknown key
1222 ;; referenced in last position in signature.
1223 (other-key-arg (and (stringp cur-a)
1224 args-lst-ak
1225 (not (member (upcase cur-a) args-lst-ak))
1226 (upcase (car (last args-lst-ak))))))
1227 (unless (string= cur-w sym-name)
1228 ;; The last keyword have already a value
1229 ;; i.e :foo a b and cursor is at b.
1230 ;; If signature have also `&rest'
1231 ;; (assume it is after the `&key' section)
1232 ;; go to the arg after `&rest'.
1233 (if (and key-have-value
1234 (save-excursion
1235 (not (re-search-forward ":.*" (point-at-eol) t)))
1236 (string-match "&rest \\([^ ()]*\\)" args))
1237 (setq index nil ; Skip next block based on positional args.
1238 start (match-beginning 1)
1239 end (match-end 1))
1240 ;; If `cur-a' is nil probably cursor is on a positional arg
1241 ;; before `&key', in this case, exit this block and determine
1242 ;; position with `index'.
1243 (when (and cur-a ; A keyword arg (dot removed) or nil.
1244 (or (string-match
1245 (concat "\\_<" (upcase cur-a) "\\_>") args)
1246 (string-match
1247 (concat "\\_<" other-key-arg "\\_>") args)))
1248 (setq index nil ; Skip next block based on positional args.
1249 start (match-beginning 0)
1250 end (match-end 0)))))))
1251 ;; Handle now positional arguments.
1252 (while (and index (>= index 1))
1253 (if (string-match "[^ ()]+" args end)
1254 (progn
1255 (setq start (match-beginning 0)
1256 end (match-end 0))
1257 (let ((argument (match-string 0 args)))
1258 (cond ((string= argument "&rest")
1259 ;; All the rest arguments are the same.
1260 (setq index 1))
1261 ((string= argument "&optional")) ; Skip.
1262 ((string= argument "&allow-other-keys")) ; Skip.
1263 ;; Back to index 0 in ARG1 ARG2 ARG2 ARG3 etc...
1264 ;; like in `setq'.
1265 ((or (and (string-match-p "\\.\\.\\.$" argument)
1266 (string= argument (car (last args-lst))))
1267 (and (string-match-p "\\.\\.\\.$"
1268 (substring args 1 (1- (length args))))
1269 (= (length (remove "..." args-lst)) 2)
1270 (> index 1) (eq (logand index 1) 1)))
1271 (setq index 0))
1273 (setq index (1- index))))))
1274 (setq end (length args)
1275 start (1- end)
1276 argument-face 'font-lock-warning-face
1277 index 0)))
1278 (let ((doc args))
1279 (when start
1280 (setq doc (copy-sequence args))
1281 (add-text-properties start end (list 'face argument-face) doc))
1282 (setq doc (elisp--docstring-format-sym-doc
1283 sym doc (if (functionp sym) 'font-lock-function-name-face
1284 'font-lock-keyword-face)))
1285 doc)))
1287 ;; Return a string containing a brief (one-line) documentation string for
1288 ;; the variable.
1289 (defun elisp--get-var-docstring (sym)
1290 (cond ((not sym) nil)
1291 ((and (eq sym (aref elisp--eldoc-last-data 0))
1292 (eq 'variable (aref elisp--eldoc-last-data 2)))
1293 (aref elisp--eldoc-last-data 1))
1295 (let ((doc (documentation-property sym 'variable-documentation t)))
1296 (when doc
1297 (let ((doc (elisp--docstring-format-sym-doc
1298 sym (elisp--docstring-first-line doc)
1299 'font-lock-variable-name-face)))
1300 (elisp--last-data-store sym doc 'variable)))))))
1302 (defun elisp--last-data-store (symbol doc type)
1303 (aset elisp--eldoc-last-data 0 symbol)
1304 (aset elisp--eldoc-last-data 1 doc)
1305 (aset elisp--eldoc-last-data 2 type)
1306 doc)
1308 ;; Note that any leading `*' in the docstring (which indicates the variable
1309 ;; is a user option) is removed.
1310 (defun elisp--docstring-first-line (doc)
1311 (and (stringp doc)
1312 (substitute-command-keys
1313 (save-match-data
1314 ;; Don't use "^" in the regexp below since it may match
1315 ;; anywhere in the doc-string.
1316 (let ((start (if (string-match "\\`\\*" doc) (match-end 0) 0)))
1317 (cond ((string-match "\n" doc)
1318 (substring doc start (match-beginning 0)))
1319 ((zerop start) doc)
1320 (t (substring doc start))))))))
1322 (defvar eldoc-echo-area-use-multiline-p)
1324 ;; If the entire line cannot fit in the echo area, the symbol name may be
1325 ;; truncated or eliminated entirely from the output to make room for the
1326 ;; description.
1327 (defun elisp--docstring-format-sym-doc (sym doc face)
1328 (save-match-data
1329 (let* ((name (symbol-name sym))
1330 (ea-multi eldoc-echo-area-use-multiline-p)
1331 ;; Subtract 1 from window width since emacs will not write
1332 ;; any chars to the last column, or in later versions, will
1333 ;; cause a wraparound and resize of the echo area.
1334 (ea-width (1- (window-width (minibuffer-window))))
1335 (strip (- (+ (length name) (length ": ") (length doc)) ea-width)))
1336 (cond ((or (<= strip 0)
1337 (eq ea-multi t)
1338 (and ea-multi (> (length doc) ea-width)))
1339 (format "%s: %s" (propertize name 'face face) doc))
1340 ((> (length doc) ea-width)
1341 (substring (format "%s" doc) 0 ea-width))
1342 ((>= strip (length name))
1343 (format "%s" doc))
1345 ;; Show the end of the partial symbol name, rather
1346 ;; than the beginning, since the former is more likely
1347 ;; to be unique given package namespace conventions.
1348 (setq name (substring name strip))
1349 (format "%s: %s" (propertize name 'face face) doc))))))
1352 ;; Return a list of current function name and argument index.
1353 (defun elisp--fnsym-in-current-sexp ()
1354 (save-excursion
1355 (let ((argument-index (1- (elisp--beginning-of-sexp))))
1356 ;; If we are at the beginning of function name, this will be -1.
1357 (when (< argument-index 0)
1358 (setq argument-index 0))
1359 ;; Don't do anything if current word is inside a string.
1360 (if (= (or (char-after (1- (point))) 0) ?\")
1362 (list (elisp--current-symbol) argument-index)))))
1364 ;; Move to the beginning of current sexp. Return the number of nested
1365 ;; sexp the point was over or after.
1366 (defun elisp--beginning-of-sexp ()
1367 (let ((parse-sexp-ignore-comments t)
1368 (num-skipped-sexps 0))
1369 (condition-case _
1370 (progn
1371 ;; First account for the case the point is directly over a
1372 ;; beginning of a nested sexp.
1373 (condition-case _
1374 (let ((p (point)))
1375 (forward-sexp -1)
1376 (forward-sexp 1)
1377 (when (< (point) p)
1378 (setq num-skipped-sexps 1)))
1379 (error))
1380 (while
1381 (let ((p (point)))
1382 (forward-sexp -1)
1383 (when (< (point) p)
1384 (setq num-skipped-sexps (1+ num-skipped-sexps))))))
1385 (error))
1386 num-skipped-sexps))
1388 ;; returns nil unless current word is an interned symbol.
1389 (defun elisp--current-symbol ()
1390 (let ((c (char-after (point))))
1391 (and c
1392 (memq (char-syntax c) '(?w ?_))
1393 (intern-soft (current-word)))))
1395 (defun elisp--function-argstring (arglist)
1396 "Return ARGLIST as a string enclosed by ().
1397 ARGLIST is either a string, or a list of strings or symbols."
1398 (let ((str (cond ((stringp arglist) arglist)
1399 ((not (listp arglist)) nil)
1400 (t (format "%S" (help-make-usage 'toto arglist))))))
1401 (if (and str (string-match "\\`([^ )]+ ?" str))
1402 (replace-match "(" t t str)
1403 str)))
1405 (provide 'elisp-mode)
1406 ;;; elisp-mode.el ends here