aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2014-09-26 23:57:41 -0400
committerStefan Monnier2014-09-26 23:57:41 -0400
commite6cfa098ae23e34c5415642e2f848a92982924ef (patch)
tree99f569a54971a64e06420953928fb3bfcb803125
parent6a19cde634d233f44c8db61ae4f6d54c07e277fb (diff)
downloademacs-e6cfa098ae23e34c5415642e2f848a92982924ef.tar.gz
emacs-e6cfa098ae23e34c5415642e2f848a92982924ef.zip
Introduce global-eldoc-mode. Move Elisp-specific code to elisp-mode.el.
* lisp/emacs-lisp/eldoc.el (global-eldoc-mode): New minor mode. (eldoc-schedule-timer): Obey it. (eldoc-documentation-function): Default to nil. (eldoc-mode): Don't enable if eldoc-documentation-function is not set. (eldoc-documentation-function-default, eldoc-get-fnsym-args-string) (eldoc-highlight-function-argument, eldoc-get-var-docstring) (eldoc-last-data-store, eldoc-docstring-first-line) (eldoc-docstring-format-sym-doc, eldoc-fnsym-in-current-sexp) (eldoc-beginning-of-sexp, eldoc-current-symbol) (eldoc-function-argstring): Move to elisp-mode.el. (eldoc-symbol-function): Remove, unused. * lisp/progmodes/elisp-mode.el: New file. Rename all "eldoc-*" to "elisp--*". (elisp-completion-at-point): Rename from lisp-completion-at-point. (elisp--preceding-sexp): Rename from preceding-sexp. * lisp/loadup.el: Load new file progmodes/elisp-mode. * lisp/ielm.el (inferior-emacs-lisp-mode): Set eldoc-documentation-function. * lisp/emacs-lisp/lisp.el (lisp--local-variables-1, lisp--local-variables) (lisp--local-variables-completion-table, lisp--expect-function-p) (lisp--form-quoted-p, lisp--company-doc-buffer) (lisp--company-doc-string, lisp--company-location) (lisp-completion-at-point): Move to elisp-mode.el. * lisp/emacs-lisp/lisp-mode.el (lisp--mode-syntax-table): New syntax-table, extracted from emacs-lisp-mode-syntax-table. (emacs-lisp-mode-abbrev-table, emacs-lisp-mode-syntax-table): Move to elisp-mode.el. (lisp-imenu-generic-expression): Add comments to document what comes from which Lisp dialect. (emacs-lisp-mode-map, emacs-lisp-byte-compile) (emacs-lisp-byte-compile-and-load, emacs-lisp-mode-hook) (emacs-lisp-mode, emacs-list-byte-code-comment-re) (emacs-lisp-byte-code-comment) (emacs-lisp-byte-code-syntax-propertize, emacs-lisp-byte-code-mode) (lisp-interaction-mode-map, lisp-interaction-mode) (eval-print-last-sexp, last-sexp-setup-props) (last-sexp-toggle-display, prin1-char, preceding-sexp) (eval-last-sexp-1, eval-last-sexp-print-value) (eval-last-sexp-fake-value, eval-sexp-add-defvars, eval-last-sexp) (eval-defun-1, eval-defun-2, eval-defun): Move to elisp-mode.el. * src/lisp.mk (lisp): Add elisp-mode.elc.
-rw-r--r--etc/NEWS4
-rw-r--r--lisp/ChangeLog46
-rw-r--r--lisp/emacs-lisp/eldoc.el324
-rw-r--r--lisp/emacs-lisp/lisp-mode.el695
-rw-r--r--lisp/emacs-lisp/lisp.el300
-rw-r--r--lisp/ielm.el4
-rw-r--r--lisp/loadup.el1
-rw-r--r--lisp/progmodes/elisp-mode.el1288
-rw-r--r--lisp/simple.el5
-rw-r--r--src/ChangeLog4
-rw-r--r--src/lisp.mk1
11 files changed, 1418 insertions, 1254 deletions
diff --git a/etc/NEWS b/etc/NEWS
index b40fb789532..f8f7887b4df 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -102,6 +102,10 @@ performance improvements when pasting large amounts of text.
102 102
103* Changes in Specialized Modes and Packages in Emacs 24.5 103* Changes in Specialized Modes and Packages in Emacs 24.5
104 104
105** ElDoc
106*** New minor mode global-eldoc-mode
107*** eldoc-documentation-function now defaults to nil
108
105** pcase 109** pcase
106*** New UPatterns `quote' and `app'. 110*** New UPatterns `quote' and `app'.
107*** New UPatterns can be defined with `pcase-defmacro'. 111*** New UPatterns can be defined with `pcase-defmacro'.
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 8586d59b3ad..e43bace2a66 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,45 @@
12014-09-27 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 Introduce global-eldoc-mode. Move Elisp-specific code to elisp-mode.el.
4 * emacs-lisp/eldoc.el (global-eldoc-mode): New minor mode.
5 (eldoc-schedule-timer): Obey it.
6 (eldoc-documentation-function): Default to nil.
7 (eldoc-mode): Don't enable if eldoc-documentation-function is not set.
8 (eldoc-documentation-function-default, eldoc-get-fnsym-args-string)
9 (eldoc-highlight-function-argument, eldoc-get-var-docstring)
10 (eldoc-last-data-store, eldoc-docstring-first-line)
11 (eldoc-docstring-format-sym-doc, eldoc-fnsym-in-current-sexp)
12 (eldoc-beginning-of-sexp, eldoc-current-symbol)
13 (eldoc-function-argstring): Move to elisp-mode.el.
14 (eldoc-symbol-function): Remove, unused.
15 * progmodes/elisp-mode.el: New file. Rename all "eldoc-*" to "elisp--*".
16 (elisp-completion-at-point): Rename from lisp-completion-at-point.
17 (elisp--preceding-sexp): Rename from preceding-sexp.
18 * loadup.el: Load new file progmodes/elisp-mode.
19 * ielm.el (inferior-emacs-lisp-mode): Set eldoc-documentation-function.
20 * emacs-lisp/lisp.el (lisp--local-variables-1, lisp--local-variables)
21 (lisp--local-variables-completion-table, lisp--expect-function-p)
22 (lisp--form-quoted-p, lisp--company-doc-buffer)
23 (lisp--company-doc-string, lisp--company-location)
24 (lisp-completion-at-point): Move to elisp-mode.el.
25 * emacs-lisp/lisp-mode.el (lisp--mode-syntax-table): New syntax-table,
26 extracted from emacs-lisp-mode-syntax-table.
27 (emacs-lisp-mode-abbrev-table, emacs-lisp-mode-syntax-table): Move to
28 elisp-mode.el.
29 (lisp-imenu-generic-expression): Add comments to document what comes
30 from which Lisp dialect.
31 (emacs-lisp-mode-map, emacs-lisp-byte-compile)
32 (emacs-lisp-byte-compile-and-load, emacs-lisp-mode-hook)
33 (emacs-lisp-mode, emacs-list-byte-code-comment-re)
34 (emacs-lisp-byte-code-comment)
35 (emacs-lisp-byte-code-syntax-propertize, emacs-lisp-byte-code-mode)
36 (lisp-interaction-mode-map, lisp-interaction-mode)
37 (eval-print-last-sexp, last-sexp-setup-props)
38 (last-sexp-toggle-display, prin1-char, preceding-sexp)
39 (eval-last-sexp-1, eval-last-sexp-print-value)
40 (eval-last-sexp-fake-value, eval-sexp-add-defvars, eval-last-sexp)
41 (eval-defun-1, eval-defun-2, eval-defun): Move to elisp-mode.el.
42
12014-09-26 Paul Eggert <eggert@cs.ucla.edu> 432014-09-26 Paul Eggert <eggert@cs.ucla.edu>
2 44
3 * progmodes/grep.el (grep-regexp-alist): Use more-accurate regexp. 45 * progmodes/grep.el (grep-regexp-alist): Use more-accurate regexp.
@@ -13,8 +55,8 @@
13 Add cl-parse-integer based on parse-integer (Bug#18557) 55 Add cl-parse-integer based on parse-integer (Bug#18557)
14 * calendar/parse-time.el (parse-time-digits): Remove. 56 * calendar/parse-time.el (parse-time-digits): Remove.
15 (digit-char-p, parse-integer) Moved to cl-lib.el. 57 (digit-char-p, parse-integer) Moved to cl-lib.el.
16 (parse-time-tokenize, parse-time-rules, parse-time-string): Use 58 (parse-time-tokenize, parse-time-rules, parse-time-string):
17 cl-parse-integer. 59 Use cl-parse-integer.
18 60
19 * emacs-lisp/cl-extra.el (cl-parse-integer): New function. 61 * emacs-lisp/cl-extra.el (cl-parse-integer): New function.
20 62
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 50c78162862..c190e2745ef 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -116,8 +116,8 @@ has no effect, unless the function handles it explicitly."
116(defface eldoc-highlight-function-argument 116(defface eldoc-highlight-function-argument
117 '((t (:inherit bold))) 117 '((t (:inherit bold)))
118 "Face used for the argument at point in a function's argument list. 118 "Face used for the argument at point in a function's argument list.
119Note that if `eldoc-documentation-function' is non-nil, this face 119Note that this face has no effect unless the `eldoc-documentation-function'
120has no effect, unless the function handles it explicitly." 120handles it explicitly."
121 :group 'eldoc) 121 :group 'eldoc)
122 122
123;;; No user options below here. 123;;; No user options below here.
@@ -185,15 +185,34 @@ it displays the argument list of the function called in the
185expression point is on." 185expression point is on."
186 :group 'eldoc :lighter eldoc-minor-mode-string 186 :group 'eldoc :lighter eldoc-minor-mode-string
187 (setq eldoc-last-message nil) 187 (setq eldoc-last-message nil)
188 (if eldoc-mode 188 (cond
189 (eldoc-documentation-function
190 (message "There is no ElDoc support in this buffer")
191 (setq eldoc-mode nil))
192 (eldoc-mode
193 (when eldoc-print-after-edit
194 (setq-local eldoc-message-commands (eldoc-edit-message-commands)))
195 (add-hook 'post-command-hook 'eldoc-schedule-timer nil t)
196 (add-hook 'pre-command-hook 'eldoc-pre-command-refresh-echo-area nil t))
197 (t
198 (kill-local-variable 'eldoc-message-commands)
199 (remove-hook 'post-command-hook 'eldoc-schedule-timer t)
200 (remove-hook 'pre-command-hook 'eldoc-pre-command-refresh-echo-area t))))
201
202;;;###autoload
203(define-minor-mode global-eldoc-mode
204 "Enable `eldoc-mode' in all buffers where it's applicable."
205 :group 'eldoc :global t
206 (setq eldoc-last-message nil)
207 (if global-eldoc-mode
189 (progn 208 (progn
190 (when eldoc-print-after-edit 209 (when eldoc-print-after-edit
191 (setq-local eldoc-message-commands (eldoc-edit-message-commands))) 210 (setq-local eldoc-message-commands (eldoc-edit-message-commands)))
192 (add-hook 'post-command-hook 'eldoc-schedule-timer nil t) 211 (add-hook 'post-command-hook #'eldoc-schedule-timer)
193 (add-hook 'pre-command-hook 'eldoc-pre-command-refresh-echo-area nil t)) 212 (add-hook 'pre-command-hook #'eldoc-pre-command-refresh-echo-area))
194 (kill-local-variable 'eldoc-message-commands) 213 (kill-local-variable 'eldoc-message-commands)
195 (remove-hook 'post-command-hook 'eldoc-schedule-timer t) 214 (remove-hook 'post-command-hook #'eldoc-schedule-timer)
196 (remove-hook 'pre-command-hook 'eldoc-pre-command-refresh-echo-area t))) 215 (remove-hook 'pre-command-hook #'eldoc-pre-command-refresh-echo-area)))
197 216
198;;;###autoload 217;;;###autoload
199(define-obsolete-function-alias 'turn-on-eldoc-mode 'eldoc-mode "24.4") 218(define-obsolete-function-alias 'turn-on-eldoc-mode 'eldoc-mode "24.4")
@@ -201,11 +220,14 @@ expression point is on."
201 220
202(defun eldoc-schedule-timer () 221(defun eldoc-schedule-timer ()
203 (or (and eldoc-timer 222 (or (and eldoc-timer
204 (memq eldoc-timer timer-idle-list)) 223 (memq eldoc-timer timer-idle-list)) ;FIXME: Why?
205 (setq eldoc-timer 224 (setq eldoc-timer
206 (run-with-idle-timer 225 (run-with-idle-timer
207 eldoc-idle-delay t 226 eldoc-idle-delay t
208 (lambda () (and eldoc-mode (eldoc-print-current-symbol-info)))))) 227 (lambda ()
228 (when (or eldoc-mode
229 (and global-eldoc-mode eldoc-documentation-function))
230 (eldoc-print-current-symbol-info))))))
209 231
210 ;; If user has changed the idle delay, update the timer. 232 ;; If user has changed the idle delay, update the timer.
211 (cond ((not (= eldoc-idle-delay eldoc-current-idle-delay)) 233 (cond ((not (= eldoc-idle-delay eldoc-current-idle-delay))
@@ -300,7 +322,7 @@ Otherwise work like `message'."
300 322
301 323
302;;;###autoload 324;;;###autoload
303(defvar eldoc-documentation-function #'eldoc-documentation-function-default 325(defvar eldoc-documentation-function nil
304 "Function to call to return doc string. 326 "Function to call to return doc string.
305The function of no args should return a one-line string for displaying 327The function of no args should return a one-line string for displaying
306doc about a function etc. appropriate to the context around point. 328doc about a function etc. appropriate to the context around point.
@@ -313,8 +335,7 @@ the variables `eldoc-argument-case' and `eldoc-echo-area-use-multiline-p',
313and the face `eldoc-highlight-function-argument', if they are to have any 335and the face `eldoc-highlight-function-argument', if they are to have any
314effect. 336effect.
315 337
316This variable is expected to be made buffer-local by modes (other than 338This variable is expected to be set buffer-locally by modes that support ElDoc.")
317Emacs Lisp mode) that support ElDoc.")
318 339
319(defun eldoc-print-current-symbol-info () 340(defun eldoc-print-current-symbol-info ()
320 ;; This is run from post-command-hook or some idle timer thing, 341 ;; This is run from post-command-hook or some idle timer thing,
@@ -327,281 +348,6 @@ Emacs Lisp mode) that support ElDoc.")
327 nil)) 348 nil))
328 (eldoc-message (funcall eldoc-documentation-function))))) 349 (eldoc-message (funcall eldoc-documentation-function)))))
329 350
330(defun eldoc-documentation-function-default ()
331 "Default value for `eldoc-documentation-function' (which see)."
332 (let ((current-symbol (eldoc-current-symbol))
333 (current-fnsym (eldoc-fnsym-in-current-sexp)))
334 (cond ((null current-fnsym)
335 nil)
336 ((eq current-symbol (car current-fnsym))
337 (or (apply #'eldoc-get-fnsym-args-string current-fnsym)
338 (eldoc-get-var-docstring current-symbol)))
339 (t
340 (or (eldoc-get-var-docstring current-symbol)
341 (apply #'eldoc-get-fnsym-args-string current-fnsym))))))
342
343(defun eldoc-get-fnsym-args-string (sym &optional index)
344 "Return a string containing the parameter list of the function SYM.
345If SYM is a subr and no arglist is obtainable from the docstring
346or elsewhere, return a 1-line docstring."
347 (let ((argstring
348 (cond
349 ((not (and sym (symbolp sym) (fboundp sym))) nil)
350 ((and (eq sym (aref eldoc-last-data 0))
351 (eq 'function (aref eldoc-last-data 2)))
352 (aref eldoc-last-data 1))
353 (t
354 (let* ((advertised (gethash (indirect-function sym)
355 advertised-signature-table t))
356 doc
357 (args
358 (cond
359 ((listp advertised) advertised)
360 ((setq doc (help-split-fundoc (documentation sym t) sym))
361 (car doc))
362 (t (help-function-arglist sym)))))
363 ;; Stringify, and store before highlighting, downcasing, etc.
364 ;; FIXME should truncate before storing.
365 (eldoc-last-data-store sym (eldoc-function-argstring args)
366 'function))))))
367 ;; Highlight, truncate.
368 (if argstring
369 (eldoc-highlight-function-argument sym argstring index))))
370
371(defun eldoc-highlight-function-argument (sym args index)
372 "Highlight argument INDEX in ARGS list for function SYM.
373In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'."
374 ;; FIXME: This should probably work on the list representation of `args'
375 ;; rather than its string representation.
376 ;; FIXME: This function is much too long, we need to split it up!
377 (let ((start nil)
378 (end 0)
379 (argument-face 'eldoc-highlight-function-argument)
380 (args-lst (mapcar (lambda (x)
381 (replace-regexp-in-string
382 "\\`[(]\\|[)]\\'" "" x))
383 (split-string args))))
384 ;; Find the current argument in the argument string. We need to
385 ;; handle `&rest' and informal `...' properly.
386 ;;
387 ;; FIXME: What to do with optional arguments, like in
388 ;; (defun NAME ARGLIST [DOCSTRING] BODY...) case?
389 ;; The problem is there is no robust way to determine if
390 ;; the current argument is indeed a docstring.
391
392 ;; When `&key' is used finding position based on `index'
393 ;; would be wrong, so find the arg at point and determine
394 ;; position in ARGS based on this current arg.
395 (when (string-match "&key" args)
396 (let* (case-fold-search
397 key-have-value
398 (sym-name (symbol-name sym))
399 (cur-w (current-word))
400 (args-lst-ak (cdr (member "&key" args-lst)))
401 (limit (save-excursion
402 (when (re-search-backward sym-name nil t)
403 (match-end 0))))
404 (cur-a (if (and cur-w (string-match ":\\([^ ()]*\\)" cur-w))
405 (substring cur-w 1)
406 (save-excursion
407 (let (split)
408 (when (re-search-backward ":\\([^()\n]*\\)" limit t)
409 (setq split (split-string (match-string 1) " " t))
410 (prog1 (car split)
411 (when (cdr split)
412 (setq key-have-value t))))))))
413 ;; If `cur-a' is not one of `args-lst-ak'
414 ;; assume user is entering an unknown key
415 ;; referenced in last position in signature.
416 (other-key-arg (and (stringp cur-a)
417 args-lst-ak
418 (not (member (upcase cur-a) args-lst-ak))
419 (upcase (car (last args-lst-ak))))))
420 (unless (string= cur-w sym-name)
421 ;; The last keyword have already a value
422 ;; i.e :foo a b and cursor is at b.
423 ;; If signature have also `&rest'
424 ;; (assume it is after the `&key' section)
425 ;; go to the arg after `&rest'.
426 (if (and key-have-value
427 (save-excursion
428 (not (re-search-forward ":.*" (point-at-eol) t)))
429 (string-match "&rest \\([^ ()]*\\)" args))
430 (setq index nil ; Skip next block based on positional args.
431 start (match-beginning 1)
432 end (match-end 1))
433 ;; If `cur-a' is nil probably cursor is on a positional arg
434 ;; before `&key', in this case, exit this block and determine
435 ;; position with `index'.
436 (when (and cur-a ; A keyword arg (dot removed) or nil.
437 (or (string-match
438 (concat "\\_<" (upcase cur-a) "\\_>") args)
439 (string-match
440 (concat "\\_<" other-key-arg "\\_>") args)))
441 (setq index nil ; Skip next block based on positional args.
442 start (match-beginning 0)
443 end (match-end 0)))))))
444 ;; Handle now positional arguments.
445 (while (and index (>= index 1))
446 (if (string-match "[^ ()]+" args end)
447 (progn
448 (setq start (match-beginning 0)
449 end (match-end 0))
450 (let ((argument (match-string 0 args)))
451 (cond ((string= argument "&rest")
452 ;; All the rest arguments are the same.
453 (setq index 1))
454 ((string= argument "&optional")) ; Skip.
455 ((string= argument "&allow-other-keys")) ; Skip.
456 ;; Back to index 0 in ARG1 ARG2 ARG2 ARG3 etc...
457 ;; like in `setq'.
458 ((or (and (string-match-p "\\.\\.\\.$" argument)
459 (string= argument (car (last args-lst))))
460 (and (string-match-p "\\.\\.\\.$"
461 (substring args 1 (1- (length args))))
462 (= (length (remove "..." args-lst)) 2)
463 (> index 1) (cl-oddp index)))
464 (setq index 0))
465 (t
466 (setq index (1- index))))))
467 (setq end (length args)
468 start (1- end)
469 argument-face 'font-lock-warning-face
470 index 0)))
471 (let ((doc args))
472 (when start
473 (setq doc (copy-sequence args))
474 (add-text-properties start end (list 'face argument-face) doc))
475 (setq doc (eldoc-docstring-format-sym-doc
476 sym doc (if (functionp sym) 'font-lock-function-name-face
477 'font-lock-keyword-face)))
478 doc)))
479
480;; Return a string containing a brief (one-line) documentation string for
481;; the variable.
482(defun eldoc-get-var-docstring (sym)
483 (cond ((not sym) nil)
484 ((and (eq sym (aref eldoc-last-data 0))
485 (eq 'variable (aref eldoc-last-data 2)))
486 (aref eldoc-last-data 1))
487 (t
488 (let ((doc (documentation-property sym 'variable-documentation t)))
489 (when doc
490 (let ((doc (eldoc-docstring-format-sym-doc
491 sym (eldoc-docstring-first-line doc)
492 'font-lock-variable-name-face)))
493 (eldoc-last-data-store sym doc 'variable)))))))
494
495(defun eldoc-last-data-store (symbol doc type)
496 (aset eldoc-last-data 0 symbol)
497 (aset eldoc-last-data 1 doc)
498 (aset eldoc-last-data 2 type)
499 doc)
500
501;; Note that any leading `*' in the docstring (which indicates the variable
502;; is a user option) is removed.
503(defun eldoc-docstring-first-line (doc)
504 (and (stringp doc)
505 (substitute-command-keys
506 (save-match-data
507 ;; Don't use "^" in the regexp below since it may match
508 ;; anywhere in the doc-string.
509 (let ((start (if (string-match "\\`\\*" doc) (match-end 0) 0)))
510 (cond ((string-match "\n" doc)
511 (substring doc start (match-beginning 0)))
512 ((zerop start) doc)
513 (t (substring doc start))))))))
514
515;; If the entire line cannot fit in the echo area, the symbol name may be
516;; truncated or eliminated entirely from the output to make room for the
517;; description.
518(defun eldoc-docstring-format-sym-doc (sym doc face)
519 (save-match-data
520 (let* ((name (symbol-name sym))
521 (ea-multi eldoc-echo-area-use-multiline-p)
522 ;; Subtract 1 from window width since emacs will not write
523 ;; any chars to the last column, or in later versions, will
524 ;; cause a wraparound and resize of the echo area.
525 (ea-width (1- (window-width (minibuffer-window))))
526 (strip (- (+ (length name) (length ": ") (length doc)) ea-width)))
527 (cond ((or (<= strip 0)
528 (eq ea-multi t)
529 (and ea-multi (> (length doc) ea-width)))
530 (format "%s: %s" (propertize name 'face face) doc))
531 ((> (length doc) ea-width)
532 (substring (format "%s" doc) 0 ea-width))
533 ((>= strip (length name))
534 (format "%s" doc))
535 (t
536 ;; Show the end of the partial symbol name, rather
537 ;; than the beginning, since the former is more likely
538 ;; to be unique given package namespace conventions.
539 (setq name (substring name strip))
540 (format "%s: %s" (propertize name 'face face) doc))))))
541
542
543;; Return a list of current function name and argument index.
544(defun eldoc-fnsym-in-current-sexp ()
545 (save-excursion
546 (let ((argument-index (1- (eldoc-beginning-of-sexp))))
547 ;; If we are at the beginning of function name, this will be -1.
548 (when (< argument-index 0)
549 (setq argument-index 0))
550 ;; Don't do anything if current word is inside a string.
551 (if (= (or (char-after (1- (point))) 0) ?\")
552 nil
553 (list (eldoc-current-symbol) argument-index)))))
554
555;; Move to the beginning of current sexp. Return the number of nested
556;; sexp the point was over or after.
557(defun eldoc-beginning-of-sexp ()
558 (let ((parse-sexp-ignore-comments t)
559 (num-skipped-sexps 0))
560 (condition-case _
561 (progn
562 ;; First account for the case the point is directly over a
563 ;; beginning of a nested sexp.
564 (condition-case _
565 (let ((p (point)))
566 (forward-sexp -1)
567 (forward-sexp 1)
568 (when (< (point) p)
569 (setq num-skipped-sexps 1)))
570 (error))
571 (while
572 (let ((p (point)))
573 (forward-sexp -1)
574 (when (< (point) p)
575 (setq num-skipped-sexps (1+ num-skipped-sexps))))))
576 (error))
577 num-skipped-sexps))
578
579;; returns nil unless current word is an interned symbol.
580(defun eldoc-current-symbol ()
581 (let ((c (char-after (point))))
582 (and c
583 (memq (char-syntax c) '(?w ?_))
584 (intern-soft (current-word)))))
585
586;; Do indirect function resolution if possible.
587(defun eldoc-symbol-function (fsym)
588 (let ((defn (symbol-function fsym)))
589 (and (symbolp defn)
590 (condition-case _
591 (setq defn (indirect-function fsym))
592 (error (setq defn nil))))
593 defn))
594
595(defun eldoc-function-argstring (arglist)
596 "Return ARGLIST as a string enclosed by ().
597ARGLIST is either a string, or a list of strings or symbols."
598 (let ((str (cond ((stringp arglist) arglist)
599 ((not (listp arglist)) nil)
600 (t (format "%S" (help-make-usage 'toto arglist))))))
601 (if (and str (string-match "\\`([^ )]+ ?" str))
602 (replace-match "(" t t str)
603 str)))
604
605 351
606;; When point is in a sexp, the function args are not reprinted in the echo 352;; When point is in a sexp, the function args are not reprinted in the echo
607;; area after every possible interactive command because some of them print 353;; area after every possible interactive command because some of them print
@@ -617,7 +363,7 @@ ARGLIST is either a string, or a list of strings or symbols."
617 363
618(defun eldoc-add-command-completions (&rest names) 364(defun eldoc-add-command-completions (&rest names)
619 (dolist (name names) 365 (dolist (name names)
620 (apply 'eldoc-add-command (all-completions name obarray 'commandp)))) 366 (apply #'eldoc-add-command (all-completions name obarray 'commandp))))
621 367
622(defun eldoc-remove-command (&rest cmds) 368(defun eldoc-remove-command (&rest cmds)
623 (dolist (name cmds) 369 (dolist (name cmds)
@@ -627,7 +373,7 @@ ARGLIST is either a string, or a list of strings or symbols."
627 373
628(defun eldoc-remove-command-completions (&rest names) 374(defun eldoc-remove-command-completions (&rest names)
629 (dolist (name names) 375 (dolist (name names)
630 (apply 'eldoc-remove-command 376 (apply #'eldoc-remove-command
631 (all-completions name eldoc-message-commands)))) 377 (all-completions name eldoc-message-commands))))
632 378
633 379
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 435730ae098..57900e39bed 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -33,17 +33,10 @@
33(defvar font-lock-keywords-case-fold-search) 33(defvar font-lock-keywords-case-fold-search)
34(defvar font-lock-string-face) 34(defvar font-lock-string-face)
35 35
36(defvar lisp-mode-abbrev-table nil)
37(define-abbrev-table 'lisp-mode-abbrev-table () 36(define-abbrev-table 'lisp-mode-abbrev-table ()
38 "Abbrev table for Lisp mode.") 37 "Abbrev table for Lisp mode.")
39 38
40(defvar emacs-lisp-mode-abbrev-table nil) 39(defvar lisp--mode-syntax-table
41(define-abbrev-table 'emacs-lisp-mode-abbrev-table ()
42 "Abbrev table for Emacs Lisp mode.
43It has `lisp-mode-abbrev-table' as its parent."
44 :parents (list lisp-mode-abbrev-table))
45
46(defvar emacs-lisp-mode-syntax-table
47 (let ((table (make-syntax-table)) 40 (let ((table (make-syntax-table))
48 (i 0)) 41 (i 0))
49 (while (< i ?0) 42 (while (< i ?0)
@@ -82,13 +75,11 @@ It has `lisp-mode-abbrev-table' as its parent."
82 (modify-syntax-entry ?\\ "\\ " table) 75 (modify-syntax-entry ?\\ "\\ " table)
83 (modify-syntax-entry ?\( "() " table) 76 (modify-syntax-entry ?\( "() " table)
84 (modify-syntax-entry ?\) ")( " table) 77 (modify-syntax-entry ?\) ")( " table)
85 (modify-syntax-entry ?\[ "(] " table)
86 (modify-syntax-entry ?\] ")[ " table)
87 table) 78 table)
88 "Syntax table used in `emacs-lisp-mode'.") 79 "Parent syntax table used in Lisp modes.")
89 80
90(defvar lisp-mode-syntax-table 81(defvar lisp-mode-syntax-table
91 (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table))) 82 (let ((table (make-syntax-table lisp--mode-syntax-table)))
92 (modify-syntax-entry ?\[ "_ " table) 83 (modify-syntax-entry ?\[ "_ " table)
93 (modify-syntax-entry ?\] "_ " table) 84 (modify-syntax-entry ?\] "_ " table)
94 (modify-syntax-entry ?# "' 14" table) 85 (modify-syntax-entry ?# "' 14" table)
@@ -102,26 +93,35 @@ It has `lisp-mode-abbrev-table' as its parent."
102 (purecopy (concat "^\\s-*(" 93 (purecopy (concat "^\\s-*("
103 (eval-when-compile 94 (eval-when-compile
104 (regexp-opt 95 (regexp-opt
105 '("defun" "defun*" "defsubst" "defmacro" 96 '("defun" "defmacro"
97 ;; Elisp.
98 "defun*" "defsubst"
106 "defadvice" "define-skeleton" 99 "defadvice" "define-skeleton"
107 "define-compilation-mode" "define-minor-mode" 100 "define-compilation-mode" "define-minor-mode"
108 "define-global-minor-mode" 101 "define-global-minor-mode"
109 "define-globalized-minor-mode" 102 "define-globalized-minor-mode"
110 "define-derived-mode" "define-generic-mode" 103 "define-derived-mode" "define-generic-mode"
104 "cl-defun" "cl-defsubst" "cl-defmacro"
105 "cl-define-compiler-macro"
106 ;; CL.
111 "define-compiler-macro" "define-modify-macro" 107 "define-compiler-macro" "define-modify-macro"
112 "defsetf" "define-setf-expander" 108 "defsetf" "define-setf-expander"
113 "define-method-combination" 109 "define-method-combination"
114 "defgeneric" "defmethod" 110 ;; CLOS and EIEIO
115 "cl-defun" "cl-defsubst" "cl-defmacro" 111 "defgeneric" "defmethod")
116 "cl-define-compiler-macro") t)) 112 t))
117 "\\s-+\\(\\(\\sw\\|\\s_\\)+\\)")) 113 "\\s-+\\(\\(\\sw\\|\\s_\\)+\\)"))
118 2) 114 2)
119 (list (purecopy "Variables") 115 (list (purecopy "Variables")
120 (purecopy (concat "^\\s-*(" 116 (purecopy (concat "^\\s-*("
121 (eval-when-compile 117 (eval-when-compile
122 (regexp-opt 118 (regexp-opt
123 '("defconst" "defconstant" "defcustom" 119 '(;; Elisp
124 "defparameter" "define-symbol-macro") t)) 120 "defconst" "defcustom"
121 ;; CL
122 "defconstant"
123 "defparameter" "define-symbol-macro")
124 t))
125 "\\s-+\\(\\(\\sw\\|\\s_\\)+\\)")) 125 "\\s-+\\(\\(\\sw\\|\\s_\\)+\\)"))
126 2) 126 2)
127 ;; For `defvar', we ignore (defvar FOO) constructs. 127 ;; For `defvar', we ignore (defvar FOO) constructs.
@@ -133,10 +133,16 @@ It has `lisp-mode-abbrev-table' as its parent."
133 (purecopy (concat "^\\s-*(" 133 (purecopy (concat "^\\s-*("
134 (eval-when-compile 134 (eval-when-compile
135 (regexp-opt 135 (regexp-opt
136 '("defgroup" "deftheme" "deftype" "defstruct" 136 '(;; Elisp
137 "defclass" "define-condition" "define-widget" 137 "defgroup" "deftheme"
138 "defface" "defpackage" "cl-deftype" 138 "define-widget" "define-error"
139 "cl-defstruct") t)) 139 "defface" "cl-deftype" "cl-defstruct"
140 ;; CL
141 "deftype" "defstruct"
142 "define-condition" "defpackage"
143 ;; CLOS and EIEIO
144 "defclass")
145 t))
140 "\\s-+'?\\(\\(\\sw\\|\\s_\\)+\\)")) 146 "\\s-+'?\\(\\(\\sw\\|\\s_\\)+\\)"))
141 2)) 147 2))
142 148
@@ -558,166 +564,6 @@ font-lock keywords will not be case sensitive."
558 map) 564 map)
559 "Keymap for commands shared by all sorts of Lisp modes.") 565 "Keymap for commands shared by all sorts of Lisp modes.")
560 566
561(defvar emacs-lisp-mode-map
562 (let ((map (make-sparse-keymap "Emacs-Lisp"))
563 (menu-map (make-sparse-keymap "Emacs-Lisp"))
564 (lint-map (make-sparse-keymap))
565 (prof-map (make-sparse-keymap))
566 (tracing-map (make-sparse-keymap)))
567 (set-keymap-parent map lisp-mode-shared-map)
568 (define-key map "\e\t" 'completion-at-point)
569 (define-key map "\e\C-x" 'eval-defun)
570 (define-key map "\e\C-q" 'indent-pp-sexp)
571 (bindings--define-key map [menu-bar emacs-lisp]
572 (cons "Emacs-Lisp" menu-map))
573 (bindings--define-key menu-map [eldoc]
574 '(menu-item "Auto-Display Documentation Strings" eldoc-mode
575 :button (:toggle . (bound-and-true-p eldoc-mode))
576 :help "Display the documentation string for the item under cursor"))
577 (bindings--define-key menu-map [checkdoc]
578 '(menu-item "Check Documentation Strings" checkdoc
579 :help "Check documentation strings for style requirements"))
580 (bindings--define-key menu-map [re-builder]
581 '(menu-item "Construct Regexp" re-builder
582 :help "Construct a regexp interactively"))
583 (bindings--define-key menu-map [tracing] (cons "Tracing" tracing-map))
584 (bindings--define-key tracing-map [tr-a]
585 '(menu-item "Untrace All" untrace-all
586 :help "Untrace all currently traced functions"))
587 (bindings--define-key tracing-map [tr-uf]
588 '(menu-item "Untrace Function..." untrace-function
589 :help "Untrace function, and possibly activate all remaining advice"))
590 (bindings--define-key tracing-map [tr-sep] menu-bar-separator)
591 (bindings--define-key tracing-map [tr-q]
592 '(menu-item "Trace Function Quietly..." trace-function-background
593 :help "Trace the function with trace output going quietly to a buffer"))
594 (bindings--define-key tracing-map [tr-f]
595 '(menu-item "Trace Function..." trace-function
596 :help "Trace the function given as an argument"))
597 (bindings--define-key menu-map [profiling] (cons "Profiling" prof-map))
598 (bindings--define-key prof-map [prof-restall]
599 '(menu-item "Remove Instrumentation for All Functions" elp-restore-all
600 :help "Restore the original definitions of all functions being profiled"))
601 (bindings--define-key prof-map [prof-restfunc]
602 '(menu-item "Remove Instrumentation for Function..." elp-restore-function
603 :help "Restore an instrumented function to its original definition"))
604
605 (bindings--define-key prof-map [sep-rem] menu-bar-separator)
606 (bindings--define-key prof-map [prof-resall]
607 '(menu-item "Reset Counters for All Functions" elp-reset-all
608 :help "Reset the profiling information for all functions being profiled"))
609 (bindings--define-key prof-map [prof-resfunc]
610 '(menu-item "Reset Counters for Function..." elp-reset-function
611 :help "Reset the profiling information for a function"))
612 (bindings--define-key prof-map [prof-res]
613 '(menu-item "Show Profiling Results" elp-results
614 :help "Display current profiling results"))
615 (bindings--define-key prof-map [prof-pack]
616 '(menu-item "Instrument Package..." elp-instrument-package
617 :help "Instrument for profiling all function that start with a prefix"))
618 (bindings--define-key prof-map [prof-func]
619 '(menu-item "Instrument Function..." elp-instrument-function
620 :help "Instrument a function for profiling"))
621 ;; Maybe this should be in a separate submenu from the ELP stuff?
622 (bindings--define-key prof-map [sep-natprof] menu-bar-separator)
623 (bindings--define-key prof-map [prof-natprof-stop]
624 '(menu-item "Stop Native Profiler" profiler-stop
625 :help "Stop recording profiling information"
626 :enable (and (featurep 'profiler)
627 (profiler-running-p))))
628 (bindings--define-key prof-map [prof-natprof-report]
629 '(menu-item "Show Profiler Report" profiler-report
630 :help "Show the current profiler report"
631 :enable (and (featurep 'profiler)
632 (profiler-running-p))))
633 (bindings--define-key prof-map [prof-natprof-start]
634 '(menu-item "Start Native Profiler..." profiler-start
635 :help "Start recording profiling information"))
636
637 (bindings--define-key menu-map [lint] (cons "Linting" lint-map))
638 (bindings--define-key lint-map [lint-di]
639 '(menu-item "Lint Directory..." elint-directory
640 :help "Lint a directory"))
641 (bindings--define-key lint-map [lint-f]
642 '(menu-item "Lint File..." elint-file
643 :help "Lint a file"))
644 (bindings--define-key lint-map [lint-b]
645 '(menu-item "Lint Buffer" elint-current-buffer
646 :help "Lint the current buffer"))
647 (bindings--define-key lint-map [lint-d]
648 '(menu-item "Lint Defun" elint-defun
649 :help "Lint the function at point"))
650 (bindings--define-key menu-map [edebug-defun]
651 '(menu-item "Instrument Function for Debugging" edebug-defun
652 :help "Evaluate the top level form point is in, stepping through with Edebug"
653 :keys "C-u C-M-x"))
654 (bindings--define-key menu-map [separator-byte] menu-bar-separator)
655 (bindings--define-key menu-map [disas]
656 '(menu-item "Disassemble Byte Compiled Object..." disassemble
657 :help "Print disassembled code for OBJECT in a buffer"))
658 (bindings--define-key menu-map [byte-recompile]
659 '(menu-item "Byte-recompile Directory..." byte-recompile-directory
660 :help "Recompile every `.el' file in DIRECTORY that needs recompilation"))
661 (bindings--define-key menu-map [emacs-byte-compile-and-load]
662 '(menu-item "Byte-compile and Load" emacs-lisp-byte-compile-and-load
663 :help "Byte-compile the current file (if it has changed), then load compiled code"))
664 (bindings--define-key menu-map [byte-compile]
665 '(menu-item "Byte-compile This File" emacs-lisp-byte-compile
666 :help "Byte compile the file containing the current buffer"))
667 (bindings--define-key menu-map [separator-eval] menu-bar-separator)
668 (bindings--define-key menu-map [ielm]
669 '(menu-item "Interactive Expression Evaluation" ielm
670 :help "Interactively evaluate Emacs Lisp expressions"))
671 (bindings--define-key menu-map [eval-buffer]
672 '(menu-item "Evaluate Buffer" eval-buffer
673 :help "Execute the current buffer as Lisp code"))
674 (bindings--define-key menu-map [eval-region]
675 '(menu-item "Evaluate Region" eval-region
676 :help "Execute the region as Lisp code"
677 :enable mark-active))
678 (bindings--define-key menu-map [eval-sexp]
679 '(menu-item "Evaluate Last S-expression" eval-last-sexp
680 :help "Evaluate sexp before point; print value in echo area"))
681 (bindings--define-key menu-map [separator-format] menu-bar-separator)
682 (bindings--define-key menu-map [comment-region]
683 '(menu-item "Comment Out Region" comment-region
684 :help "Comment or uncomment each line in the region"
685 :enable mark-active))
686 (bindings--define-key menu-map [indent-region]
687 '(menu-item "Indent Region" indent-region
688 :help "Indent each nonblank line in the region"
689 :enable mark-active))
690 (bindings--define-key menu-map [indent-line]
691 '(menu-item "Indent Line" lisp-indent-line))
692 map)
693 "Keymap for Emacs Lisp mode.
694All commands in `lisp-mode-shared-map' are inherited by this map.")
695
696(defun emacs-lisp-byte-compile ()
697 "Byte compile the file containing the current buffer."
698 (interactive)
699 (if buffer-file-name
700 (byte-compile-file buffer-file-name)
701 (error "The buffer must be saved in a file first")))
702
703(defun emacs-lisp-byte-compile-and-load ()
704 "Byte-compile the current file (if it has changed), then load compiled code."
705 (interactive)
706 (or buffer-file-name
707 (error "The buffer must be saved in a file first"))
708 (require 'bytecomp)
709 ;; Recompile if file or buffer has changed since last compilation.
710 (if (and (buffer-modified-p)
711 (y-or-n-p (format "Save buffer %s first? " (buffer-name))))
712 (save-buffer))
713 (byte-recompile-file buffer-file-name nil 0 t))
714
715(defcustom emacs-lisp-mode-hook nil
716 "Hook run when entering Emacs Lisp mode."
717 :options '(eldoc-mode imenu-add-menubar-index checkdoc-minor-mode)
718 :type 'hook
719 :group 'lisp)
720
721(defcustom lisp-mode-hook nil 567(defcustom lisp-mode-hook nil
722 "Hook run when entering Lisp mode." 568 "Hook run when entering Lisp mode."
723 :options '(imenu-add-menubar-index) 569 :options '(imenu-add-menubar-index)
@@ -733,72 +579,6 @@ All commands in `lisp-mode-shared-map' are inherited by this map.")
733(defconst lisp--prettify-symbols-alist 579(defconst lisp--prettify-symbols-alist
734 '(("lambda" . ?λ))) 580 '(("lambda" . ?λ)))
735 581
736(define-derived-mode emacs-lisp-mode prog-mode "Emacs-Lisp"
737 "Major mode for editing Lisp code to run in Emacs.
738Commands:
739Delete converts tabs to spaces as it moves back.
740Blank lines separate paragraphs. Semicolons start comments.
741
742\\{emacs-lisp-mode-map}"
743 :group 'lisp
744 (lisp-mode-variables nil nil 'elisp)
745 (setq imenu-case-fold-search nil)
746 (add-hook 'completion-at-point-functions
747 'lisp-completion-at-point nil 'local))
748
749;;; Emacs Lisp Byte-Code mode
750
751(eval-and-compile
752 (defconst emacs-list-byte-code-comment-re
753 (concat "\\(#\\)@\\([0-9]+\\) "
754 ;; Make sure it's a docstring and not a lazy-loaded byte-code.
755 "\\(?:[^(]\\|([^\"]\\)")))
756
757(defun emacs-lisp-byte-code-comment (end &optional _point)
758 "Try to syntactically mark the #@NNN ....^_ docstrings in byte-code files."
759 (let ((ppss (syntax-ppss)))
760 (when (and (nth 4 ppss)
761 (eq (char-after (nth 8 ppss)) ?#))
762 (let* ((n (save-excursion
763 (goto-char (nth 8 ppss))
764 (when (looking-at emacs-list-byte-code-comment-re)
765 (string-to-number (match-string 2)))))
766 ;; `maxdiff' tries to make sure the loop below terminates.
767 (maxdiff n))
768 (when n
769 (let* ((bchar (match-end 2))
770 (b (position-bytes bchar)))
771 (goto-char (+ b n))
772 (while (let ((diff (- (position-bytes (point)) b n)))
773 (unless (zerop diff)
774 (when (> diff maxdiff) (setq diff maxdiff))
775 (forward-char (- diff))
776 (setq maxdiff (if (> diff 0) diff
777 (max (1- maxdiff) 1)))
778 t))))
779 (if (<= (point) end)
780 (put-text-property (1- (point)) (point)
781 'syntax-table
782 (string-to-syntax "> b"))
783 (goto-char end)))))))
784
785(defun emacs-lisp-byte-code-syntax-propertize (start end)
786 (emacs-lisp-byte-code-comment end (point))
787 (funcall
788 (syntax-propertize-rules
789 (emacs-list-byte-code-comment-re
790 (1 (prog1 "< b" (emacs-lisp-byte-code-comment end (point))))))
791 start end))
792
793(add-to-list 'auto-mode-alist '("\\.elc\\'" . emacs-lisp-byte-code-mode))
794(define-derived-mode emacs-lisp-byte-code-mode emacs-lisp-mode
795 "Elisp-Byte-Code"
796 "Major mode for *.elc files."
797 ;; TODO: Add way to disassemble byte-code under point.
798 (setq-local open-paren-in-column-0-is-defun-start nil)
799 (setq-local syntax-propertize-function
800 #'emacs-lisp-byte-code-syntax-propertize))
801
802;;; Generic Lisp mode. 582;;; Generic Lisp mode.
803 583
804(defvar lisp-mode-map 584(defvar lisp-mode-map
@@ -852,415 +632,6 @@ or to switch back to an existing one."
852 (interactive) 632 (interactive)
853 (error "Process lisp does not exist")) 633 (error "Process lisp does not exist"))
854 634
855(defvar lisp-interaction-mode-map
856 (let ((map (make-sparse-keymap))
857 (menu-map (make-sparse-keymap "Lisp-Interaction")))
858 (set-keymap-parent map lisp-mode-shared-map)
859 (define-key map "\e\C-x" 'eval-defun)
860 (define-key map "\e\C-q" 'indent-pp-sexp)
861 (define-key map "\e\t" 'completion-at-point)
862 (define-key map "\n" 'eval-print-last-sexp)
863 (bindings--define-key map [menu-bar lisp-interaction]
864 (cons "Lisp-Interaction" menu-map))
865 (bindings--define-key menu-map [eval-defun]
866 '(menu-item "Evaluate Defun" eval-defun
867 :help "Evaluate the top-level form containing point, or after point"))
868 (bindings--define-key menu-map [eval-print-last-sexp]
869 '(menu-item "Evaluate and Print" eval-print-last-sexp
870 :help "Evaluate sexp before point; print value into current buffer"))
871 (bindings--define-key menu-map [edebug-defun-lisp-interaction]
872 '(menu-item "Instrument Function for Debugging" edebug-defun
873 :help "Evaluate the top level form point is in, stepping through with Edebug"
874 :keys "C-u C-M-x"))
875 (bindings--define-key menu-map [indent-pp-sexp]
876 '(menu-item "Indent or Pretty-Print" indent-pp-sexp
877 :help "Indent each line of the list starting just after point, or prettyprint it"))
878 (bindings--define-key menu-map [complete-symbol]
879 '(menu-item "Complete Lisp Symbol" completion-at-point
880 :help "Perform completion on Lisp symbol preceding point"))
881 map)
882 "Keymap for Lisp Interaction mode.
883All commands in `lisp-mode-shared-map' are inherited by this map.")
884
885(define-derived-mode lisp-interaction-mode emacs-lisp-mode "Lisp Interaction"
886 "Major mode for typing and evaluating Lisp forms.
887Like Lisp mode except that \\[eval-print-last-sexp] evals the Lisp expression
888before point, and prints its value into the buffer, advancing point.
889Note that printing is controlled by `eval-expression-print-length'
890and `eval-expression-print-level'.
891
892Commands:
893Delete converts tabs to spaces as it moves back.
894Paragraphs are separated only by blank lines.
895Semicolons start comments.
896
897\\{lisp-interaction-mode-map}"
898 :abbrev-table nil)
899
900(defun eval-print-last-sexp (&optional eval-last-sexp-arg-internal)
901 "Evaluate sexp before point; print value into current buffer.
902
903Normally, this function truncates long output according to the value
904of the variables `eval-expression-print-length' and
905`eval-expression-print-level'. With a prefix argument of zero,
906however, there is no such truncation. Such a prefix argument
907also causes integers to be printed in several additional formats
908\(octal, hexadecimal, and character).
909
910If `eval-expression-debug-on-error' is non-nil, which is the default,
911this command arranges for all errors to enter the debugger."
912 (interactive "P")
913 (let ((standard-output (current-buffer)))
914 (terpri)
915 (eval-last-sexp (or eval-last-sexp-arg-internal t))
916 (terpri)))
917
918
919(defun last-sexp-setup-props (beg end value alt1 alt2)
920 "Set up text properties for the output of `eval-last-sexp-1'.
921BEG and END are the start and end of the output in current-buffer.
922VALUE is the Lisp value printed, ALT1 and ALT2 are strings for the
923alternative printed representations that can be displayed."
924 (let ((map (make-sparse-keymap)))
925 (define-key map "\C-m" 'last-sexp-toggle-display)
926 (define-key map [down-mouse-2] 'mouse-set-point)
927 (define-key map [mouse-2] 'last-sexp-toggle-display)
928 (add-text-properties
929 beg end
930 `(printed-value (,value ,alt1 ,alt2)
931 mouse-face highlight
932 keymap ,map
933 help-echo "RET, mouse-2: toggle abbreviated display"
934 rear-nonsticky (mouse-face keymap help-echo
935 printed-value)))))
936
937
938(defun last-sexp-toggle-display (&optional _arg)
939 "Toggle between abbreviated and unabbreviated printed representations."
940 (interactive "P")
941 (save-restriction
942 (widen)
943 (let ((value (get-text-property (point) 'printed-value)))
944 (when value
945 (let ((beg (or (previous-single-property-change (min (point-max) (1+ (point)))
946 'printed-value)
947 (point)))
948 (end (or (next-single-char-property-change (point) 'printed-value) (point)))
949 (standard-output (current-buffer))
950 (point (point)))
951 (delete-region beg end)
952 (insert (nth 1 value))
953 (or (= beg point)
954 (setq point (1- (point))))
955 (last-sexp-setup-props beg (point)
956 (nth 0 value)
957 (nth 2 value)
958 (nth 1 value))
959 (goto-char (min (point-max) point)))))))
960
961(defun prin1-char (char)
962 "Return a string representing CHAR as a character rather than as an integer.
963If CHAR is not a character, return nil."
964 (and (integerp char)
965 (eventp char)
966 (let ((c (event-basic-type char))
967 (mods (event-modifiers char))
968 string)
969 ;; Prevent ?A from turning into ?\S-a.
970 (if (and (memq 'shift mods)
971 (zerop (logand char ?\S-\^@))
972 (not (let ((case-fold-search nil))
973 (char-equal c (upcase c)))))
974 (setq c (upcase c) mods nil))
975 ;; What string are we considering using?
976 (condition-case nil
977 (setq string
978 (concat
979 "?"
980 (mapconcat
981 (lambda (modif)
982 (cond ((eq modif 'super) "\\s-")
983 (t (string ?\\ (upcase (aref (symbol-name modif) 0)) ?-))))
984 mods "")
985 (cond
986 ((memq c '(?\; ?\( ?\) ?\{ ?\} ?\[ ?\] ?\" ?\' ?\\)) (string ?\\ c))
987 ((eq c 127) "\\C-?")
988 (t
989 (string c)))))
990 (error nil))
991 ;; Verify the string reads a CHAR, not to some other character.
992 ;; If it doesn't, return nil instead.
993 (and string
994 (= (car (read-from-string string)) char)
995 string))))
996
997
998(defun preceding-sexp ()
999 "Return sexp before the point."
1000 (let ((opoint (point))
1001 ignore-quotes
1002 expr)
1003 (save-excursion
1004 (with-syntax-table emacs-lisp-mode-syntax-table
1005 ;; If this sexp appears to be enclosed in `...'
1006 ;; then ignore the surrounding quotes.
1007 (setq ignore-quotes
1008 (or (eq (following-char) ?\')
1009 (eq (preceding-char) ?\')))
1010 (forward-sexp -1)
1011 ;; If we were after `?\e' (or similar case),
1012 ;; use the whole thing, not just the `e'.
1013 (when (eq (preceding-char) ?\\)
1014 (forward-char -1)
1015 (when (eq (preceding-char) ??)
1016 (forward-char -1)))
1017
1018 ;; Skip over hash table read syntax.
1019 (and (> (point) (1+ (point-min)))
1020 (looking-back "#s" (- (point) 2))
1021 (forward-char -2))
1022
1023 ;; Skip over `#N='s.
1024 (when (eq (preceding-char) ?=)
1025 (let (labeled-p)
1026 (save-excursion
1027 (skip-chars-backward "0-9#=")
1028 (setq labeled-p (looking-at "\\(#[0-9]+=\\)+")))
1029 (when labeled-p
1030 (forward-sexp -1))))
1031
1032 (save-restriction
1033 (if (and ignore-quotes (eq (following-char) ?`))
1034 ;; vladimir@cs.ualberta.ca 30-Jul-1997: Skip ` in `variable' so
1035 ;; that the value is returned, not the name.
1036 (forward-char))
1037 (when (looking-at ",@?") (goto-char (match-end 0)))
1038 (narrow-to-region (point-min) opoint)
1039 (setq expr (read (current-buffer)))
1040 ;; If it's an (interactive ...) form, it's more useful to show how an
1041 ;; interactive call would use it.
1042 ;; FIXME: Is it really the right place for this?
1043 (when (eq (car-safe expr) 'interactive)
1044 (setq expr
1045 `(call-interactively
1046 (lambda (&rest args) ,expr args))))
1047 expr)))))
1048
1049
1050(defun eval-last-sexp-1 (eval-last-sexp-arg-internal)
1051 "Evaluate sexp before point; print value in the echo area.
1052With argument, print output into current buffer.
1053With a zero prefix arg, print output with no limit on the length
1054and level of lists, and include additional formats for integers
1055\(octal, hexadecimal, and character)."
1056 (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t)))
1057 ;; Setup the lexical environment if lexical-binding is enabled.
1058 (eval-last-sexp-print-value
1059 (eval (eval-sexp-add-defvars (preceding-sexp)) lexical-binding)
1060 eval-last-sexp-arg-internal)))
1061
1062
1063(defun eval-last-sexp-print-value (value &optional eval-last-sexp-arg-internal)
1064 (let ((unabbreviated (let ((print-length nil) (print-level nil))
1065 (prin1-to-string value)))
1066 (print-length (and (not (zerop (prefix-numeric-value
1067 eval-last-sexp-arg-internal)))
1068 eval-expression-print-length))
1069 (print-level (and (not (zerop (prefix-numeric-value
1070 eval-last-sexp-arg-internal)))
1071 eval-expression-print-level))
1072 (beg (point))
1073 end)
1074 (prog1
1075 (prin1 value)
1076 (let ((str (eval-expression-print-format value)))
1077 (if str (princ str)))
1078 (setq end (point))
1079 (when (and (bufferp standard-output)
1080 (or (not (null print-length))
1081 (not (null print-level)))
1082 (not (string= unabbreviated
1083 (buffer-substring-no-properties beg end))))
1084 (last-sexp-setup-props beg end value
1085 unabbreviated
1086 (buffer-substring-no-properties beg end))
1087 ))))
1088
1089
1090(defvar eval-last-sexp-fake-value (make-symbol "t"))
1091
1092(defun eval-sexp-add-defvars (exp &optional pos)
1093 "Prepend EXP with all the `defvar's that precede it in the buffer.
1094POS specifies the starting position where EXP was found and defaults to point."
1095 (setq exp (macroexpand-all exp)) ;Eager macro-expansion.
1096 (if (not lexical-binding)
1097 exp
1098 (save-excursion
1099 (unless pos (setq pos (point)))
1100 (let ((vars ()))
1101 (goto-char (point-min))
1102 (while (re-search-forward
1103 "(def\\(?:var\\|const\\|custom\\)[ \t\n]+\\([^; '()\n\t]+\\)"
1104 pos t)
1105 (let ((var (intern (match-string 1))))
1106 (and (not (special-variable-p var))
1107 (save-excursion
1108 (zerop (car (syntax-ppss (match-beginning 0)))))
1109 (push var vars))))
1110 `(progn ,@(mapcar (lambda (v) `(defvar ,v)) vars) ,exp)))))
1111
1112(defun eval-last-sexp (eval-last-sexp-arg-internal)
1113 "Evaluate sexp before point; print value in the echo area.
1114Interactively, with prefix argument, print output into current buffer.
1115
1116Normally, this function truncates long output according to the value
1117of the variables `eval-expression-print-length' and
1118`eval-expression-print-level'. With a prefix argument of zero,
1119however, there is no such truncation. Such a prefix argument
1120also causes integers to be printed in several additional formats
1121\(octal, hexadecimal, and character).
1122
1123If `eval-expression-debug-on-error' is non-nil, which is the default,
1124this command arranges for all errors to enter the debugger."
1125 (interactive "P")
1126 (if (null eval-expression-debug-on-error)
1127 (eval-last-sexp-1 eval-last-sexp-arg-internal)
1128 (let ((value
1129 (let ((debug-on-error eval-last-sexp-fake-value))
1130 (cons (eval-last-sexp-1 eval-last-sexp-arg-internal)
1131 debug-on-error))))
1132 (unless (eq (cdr value) eval-last-sexp-fake-value)
1133 (setq debug-on-error (cdr value)))
1134 (car value))))
1135
1136(defun eval-defun-1 (form)
1137 "Treat some expressions specially.
1138Reset the `defvar' and `defcustom' variables to the initial value.
1139\(For `defcustom', use the :set function if there is one.)
1140Reinitialize the face according to the `defface' specification."
1141 ;; The code in edebug-defun should be consistent with this, but not
1142 ;; the same, since this gets a macroexpanded form.
1143 (cond ((not (listp form))
1144 form)
1145 ((and (eq (car form) 'defvar)
1146 (cdr-safe (cdr-safe form))
1147 (boundp (cadr form)))
1148 ;; Force variable to be re-set.
1149 `(progn (defvar ,(nth 1 form) nil ,@(nthcdr 3 form))
1150 (setq-default ,(nth 1 form) ,(nth 2 form))))
1151 ;; `defcustom' is now macroexpanded to
1152 ;; `custom-declare-variable' with a quoted value arg.
1153 ((and (eq (car form) 'custom-declare-variable)
1154 (default-boundp (eval (nth 1 form) lexical-binding)))
1155 ;; Force variable to be bound, using :set function if specified.
1156 (let ((setfunc (memq :set form)))
1157 (when setfunc
1158 (setq setfunc (car-safe (cdr-safe setfunc)))
1159 (or (functionp setfunc) (setq setfunc nil)))
1160 (funcall (or setfunc 'set-default)
1161 (eval (nth 1 form) lexical-binding)
1162 ;; The second arg is an expression that evaluates to
1163 ;; an expression. The second evaluation is the one
1164 ;; normally performed not by normal execution but by
1165 ;; custom-initialize-set (for example), which does not
1166 ;; use lexical-binding.
1167 (eval (eval (nth 2 form) lexical-binding))))
1168 form)
1169 ;; `defface' is macroexpanded to `custom-declare-face'.
1170 ((eq (car form) 'custom-declare-face)
1171 ;; Reset the face.
1172 (let ((face-symbol (eval (nth 1 form) lexical-binding)))
1173 (setq face-new-frame-defaults
1174 (assq-delete-all face-symbol face-new-frame-defaults))
1175 (put face-symbol 'face-defface-spec nil)
1176 (put face-symbol 'face-override-spec nil))
1177 form)
1178 ((eq (car form) 'progn)
1179 (cons 'progn (mapcar 'eval-defun-1 (cdr form))))
1180 (t form)))
1181
1182(defun eval-defun-2 ()
1183 "Evaluate defun that point is in or before.
1184The value is displayed in the echo area.
1185If the current defun is actually a call to `defvar',
1186then reset the variable using the initial value expression
1187even if the variable already has some other value.
1188\(Normally `defvar' does not change the variable's value
1189if it already has a value.\)
1190
1191Return the result of evaluation."
1192 ;; FIXME: the print-length/level bindings should only be applied while
1193 ;; printing, not while evaluating.
1194 (let ((debug-on-error eval-expression-debug-on-error)
1195 (print-length eval-expression-print-length)
1196 (print-level eval-expression-print-level))
1197 (save-excursion
1198 ;; Arrange for eval-region to "read" the (possibly) altered form.
1199 ;; eval-region handles recording which file defines a function or
1200 ;; variable.
1201 (let ((standard-output t)
1202 beg end form)
1203 ;; Read the form from the buffer, and record where it ends.
1204 (save-excursion
1205 (end-of-defun)
1206 (beginning-of-defun)
1207 (setq beg (point))
1208 (setq form (read (current-buffer)))
1209 (setq end (point)))
1210 ;; Alter the form if necessary.
1211 (let ((form (eval-sexp-add-defvars
1212 (eval-defun-1 (macroexpand form)))))
1213 (eval-region beg end standard-output
1214 (lambda (_ignore)
1215 ;; Skipping to the end of the specified region
1216 ;; will make eval-region return.
1217 (goto-char end)
1218 form))))))
1219 (let ((str (eval-expression-print-format (car values))))
1220 (if str (princ str)))
1221 ;; The result of evaluation has been put onto VALUES. So return it.
1222 (car values))
1223
1224(defun eval-defun (edebug-it)
1225 "Evaluate the top-level form containing point, or after point.
1226
1227If the current defun is actually a call to `defvar' or `defcustom',
1228evaluating it this way resets the variable using its initial value
1229expression (using the defcustom's :set function if there is one), even
1230if the variable already has some other value. \(Normally `defvar' and
1231`defcustom' do not alter the value if there already is one.) In an
1232analogous way, evaluating a `defface' overrides any customizations of
1233the face, so that it becomes defined exactly as the `defface' expression
1234says.
1235
1236If `eval-expression-debug-on-error' is non-nil, which is the default,
1237this command arranges for all errors to enter the debugger.
1238
1239With a prefix argument, instrument the code for Edebug.
1240
1241If acting on a `defun' for FUNCTION, and the function was
1242instrumented, `Edebug: FUNCTION' is printed in the echo area. If not
1243instrumented, just FUNCTION is printed.
1244
1245If not acting on a `defun', the result of evaluation is displayed in
1246the echo area. This display is controlled by the variables
1247`eval-expression-print-length' and `eval-expression-print-level',
1248which see."
1249 (interactive "P")
1250 (cond (edebug-it
1251 (require 'edebug)
1252 (eval-defun (not edebug-all-defs)))
1253 (t
1254 (if (null eval-expression-debug-on-error)
1255 (eval-defun-2)
1256 (let ((old-value (make-symbol "t")) new-value value)
1257 (let ((debug-on-error old-value))
1258 (setq value (eval-defun-2))
1259 (setq new-value debug-on-error))
1260 (unless (eq old-value new-value)
1261 (setq debug-on-error new-value))
1262 value)))))
1263
1264;; May still be used by some external Lisp-mode variant. 635;; May still be used by some external Lisp-mode variant.
1265(define-obsolete-function-alias 'lisp-comment-indent 636(define-obsolete-function-alias 'lisp-comment-indent
1266 'comment-indent-default "22.1") 637 'comment-indent-default "22.1")
@@ -1583,19 +954,21 @@ Lisp function does not specify a special indentation."
1583;; like defun if the first form is placed on the next line, otherwise 954;; like defun if the first form is placed on the next line, otherwise
1584;; it is indented like any other form (i.e. forms line up under first). 955;; it is indented like any other form (i.e. forms line up under first).
1585 956
1586(put 'autoload 'lisp-indent-function 'defun) 957(put 'autoload 'lisp-indent-function 'defun) ;Elisp
1587(put 'progn 'lisp-indent-function 0) 958(put 'progn 'lisp-indent-function 0)
1588(put 'prog1 'lisp-indent-function 1) 959(put 'prog1 'lisp-indent-function 1)
1589(put 'prog2 'lisp-indent-function 2) 960(put 'prog2 'lisp-indent-function 2)
1590(put 'save-excursion 'lisp-indent-function 0) 961(put 'save-excursion 'lisp-indent-function 0) ;Elisp
1591(put 'save-restriction 'lisp-indent-function 0) 962(put 'save-restriction 'lisp-indent-function 0) ;Elisp
1592(put 'save-current-buffer 'lisp-indent-function 0) 963(put 'save-current-buffer 'lisp-indent-function 0) ;Elisp
1593(put 'let 'lisp-indent-function 1) 964(put 'let 'lisp-indent-function 1)
1594(put 'let* 'lisp-indent-function 1) 965(put 'let* 'lisp-indent-function 1)
1595(put 'while 'lisp-indent-function 1) 966(put 'while 'lisp-indent-function 1)
1596(put 'if 'lisp-indent-function 2) 967(put 'if 'lisp-indent-function 2)
1597(put 'catch 'lisp-indent-function 1) 968(put 'catch 'lisp-indent-function 1)
1598(put 'condition-case 'lisp-indent-function 2) 969(put 'condition-case 'lisp-indent-function 2)
970(put 'handler-case 'lisp-indent-function 1) ;CL
971(put 'handler-bind 'lisp-indent-function 1) ;CL
1599(put 'unwind-protect 'lisp-indent-function 1) 972(put 'unwind-protect 'lisp-indent-function 1)
1600(put 'with-output-to-temp-buffer 'lisp-indent-function 1) 973(put 'with-output-to-temp-buffer 'lisp-indent-function 1)
1601 974
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
index 7e5f47b80b7..31682d036bf 100644
--- a/lisp/emacs-lisp/lisp.el
+++ b/lisp/emacs-lisp/lisp.el
@@ -758,304 +758,4 @@ considered."
758 (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data) 758 (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data)
759 (plist-get plist :predicate)))))) 759 (plist-get plist :predicate))))))
760 760
761(defun lisp--local-variables-1 (vars sexp)
762 "Return the vars locally bound around the witness, or nil if not found."
763 (let (res)
764 (while
765 (unless
766 (setq res
767 (pcase sexp
768 (`(,(or `let `let*) ,bindings)
769 (let ((vars vars))
770 (when (eq 'let* (car sexp))
771 (dolist (binding (cdr (reverse bindings)))
772 (push (or (car-safe binding) binding) vars)))
773 (lisp--local-variables-1
774 vars (car (cdr-safe (car (last bindings)))))))
775 (`(,(or `let `let*) ,bindings . ,body)
776 (let ((vars vars))
777 (dolist (binding bindings)
778 (push (or (car-safe binding) binding) vars))
779 (lisp--local-variables-1 vars (car (last body)))))
780 (`(lambda ,_) (setq sexp nil))
781 (`(lambda ,args . ,body)
782 (lisp--local-variables-1
783 (append args vars) (car (last body))))
784 (`(condition-case ,_ ,e) (lisp--local-variables-1 vars e))
785 (`(condition-case ,v ,_ . ,catches)
786 (lisp--local-variables-1
787 (cons v vars) (cdr (car (last catches)))))
788 (`(,_ . ,_)
789 (lisp--local-variables-1 vars (car (last sexp))))
790 (`lisp--witness--lisp (or vars '(nil)))
791 (_ nil)))
792 (setq sexp (ignore-errors (butlast sexp)))))
793 res))
794
795(defun lisp--local-variables ()
796 "Return a list of locally let-bound variables at point."
797 (save-excursion
798 (skip-syntax-backward "w_")
799 (let* ((ppss (syntax-ppss))
800 (txt (buffer-substring-no-properties (or (car (nth 9 ppss)) (point))
801 (or (nth 8 ppss) (point))))
802 (closer ()))
803 (dolist (p (nth 9 ppss))
804 (push (cdr (syntax-after p)) closer))
805 (setq closer (apply #'string closer))
806 (let* ((sexp (condition-case nil
807 (car (read-from-string
808 (concat txt "lisp--witness--lisp" closer)))
809 (end-of-file nil)))
810 (macroexpand-advice (lambda (expander form &rest args)
811 (condition-case nil
812 (apply expander form args)
813 (error form))))
814 (sexp
815 (unwind-protect
816 (progn
817 (advice-add 'macroexpand :around macroexpand-advice)
818 (macroexpand-all sexp))
819 (advice-remove 'macroexpand macroexpand-advice)))
820 (vars (lisp--local-variables-1 nil sexp)))
821 (delq nil
822 (mapcar (lambda (var)
823 (and (symbolp var)
824 (not (string-match (symbol-name var) "\\`[&_]"))
825 ;; Eliminate uninterned vars.
826 (intern-soft var)
827 var))
828 vars))))))
829
830(defvar lisp--local-variables-completion-table
831 ;; Use `defvar' rather than `defconst' since defconst would purecopy this
832 ;; value, which would doubly fail: it would fail because purecopy can't
833 ;; handle the recursive bytecode object, and it would fail because it would
834 ;; move `lastpos' and `lastvars' to pure space where they'd be immutable!
835 (let ((lastpos nil) (lastvars nil))
836 (letrec ((hookfun (lambda ()
837 (setq lastpos nil)
838 (remove-hook 'post-command-hook hookfun))))
839 (completion-table-dynamic
840 (lambda (_string)
841 (save-excursion
842 (skip-syntax-backward "_w")
843 (let ((newpos (cons (point) (current-buffer))))
844 (unless (equal lastpos newpos)
845 (add-hook 'post-command-hook hookfun)
846 (setq lastpos newpos)
847 (setq lastvars
848 (mapcar #'symbol-name (lisp--local-variables))))))
849 lastvars)))))
850
851(defun lisp--expect-function-p (pos)
852 "Return non-nil if the symbol at point is expected to be a function."
853 (or
854 (and (eq (char-before pos) ?')
855 (eq (char-before (1- pos)) ?#))
856 (save-excursion
857 (let ((parent (nth 1 (syntax-ppss pos))))
858 (when parent
859 (goto-char parent)
860 (and
861 (looking-at (concat "(\\(cl-\\)?"
862 (regexp-opt '("declare-function"
863 "function" "defadvice"
864 "callf" "callf2"
865 "defsetf"))
866 "[ \t\r\n]+"))
867 (eq (match-end 0) pos)))))))
868
869(defun lisp--form-quoted-p (pos)
870 "Return non-nil if the form at POS is not evaluated.
871It can be quoted, or be inside a quoted form."
872 ;; FIXME: Do some macro expansion maybe.
873 (save-excursion
874 (let ((state (syntax-ppss pos)))
875 (or (nth 8 state) ; Code inside strings usually isn't evaluated.
876 ;; FIXME: The 9th element is undocumented.
877 (let ((nesting (cons (point) (reverse (nth 9 state))))
878 res)
879 (while (and nesting (not res))
880 (goto-char (pop nesting))
881 (cond
882 ((or (eq (char-after) ?\[)
883 (progn
884 (skip-chars-backward " ")
885 (memq (char-before) '(?' ?`))))
886 (setq res t))
887 ((eq (char-before) ?,)
888 (setq nesting nil))))
889 res)))))
890
891;; FIXME: Support for Company brings in features which straddle eldoc.
892;; We should consolidate this, so that major modes can provide all that
893;; data all at once:
894;; - a function to extract "the reference at point" (may be more complex
895;; than a mere string, to distinguish various namespaces).
896;; - a function to jump to such a reference.
897;; - a function to show the signature/interface of such a reference.
898;; - a function to build a help-buffer about that reference.
899;; FIXME: Those functions should also be used by the normal completion code in
900;; the *Completions* buffer.
901
902(defun lisp--company-doc-buffer (str)
903 (let ((symbol (intern-soft str)))
904 ;; FIXME: we really don't want to "display-buffer and then undo it".
905 (save-window-excursion
906 ;; Make sure we don't display it in another frame, otherwise
907 ;; save-window-excursion won't be able to undo it.
908 (let ((display-buffer-overriding-action
909 '(nil . ((inhibit-switch-frame . t)))))
910 (ignore-errors
911 (cond
912 ((fboundp symbol) (describe-function symbol))
913 ((boundp symbol) (describe-variable symbol))
914 ((featurep symbol) (describe-package symbol))
915 ((facep symbol) (describe-face symbol))
916 (t (signal 'user-error nil)))
917 (help-buffer))))))
918
919(defun lisp--company-doc-string (str)
920 (let* ((symbol (intern-soft str))
921 (doc (if (fboundp symbol)
922 (documentation symbol t)
923 (documentation-property symbol 'variable-documentation t))))
924 (and (stringp doc)
925 (string-match ".*$" doc)
926 (match-string 0 doc))))
927
928(declare-function find-library-name "find-func" (library))
929
930(defun lisp--company-location (str)
931 (let ((sym (intern-soft str)))
932 (cond
933 ((fboundp sym) (find-definition-noselect sym nil))
934 ((boundp sym) (find-definition-noselect sym 'defvar))
935 ((featurep sym)
936 (require 'find-func)
937 (cons (find-file-noselect (find-library-name
938 (symbol-name sym)))
939 0))
940 ((facep sym) (find-definition-noselect sym 'defface)))))
941
942(defun lisp-completion-at-point (&optional _predicate)
943 "Function used for `completion-at-point-functions' in `emacs-lisp-mode'."
944 (with-syntax-table emacs-lisp-mode-syntax-table
945 (let* ((pos (point))
946 (beg (condition-case nil
947 (save-excursion
948 (backward-sexp 1)
949 (skip-syntax-forward "'")
950 (point))
951 (scan-error pos)))
952 (end
953 (unless (or (eq beg (point-max))
954 (member (char-syntax (char-after beg))
955 '(?\s ?\" ?\( ?\))))
956 (condition-case nil
957 (save-excursion
958 (goto-char beg)
959 (forward-sexp 1)
960 (skip-chars-backward "'")
961 (when (>= (point) pos)
962 (point)))
963 (scan-error pos))))
964 ;; t if in function position.
965 (funpos (eq (char-before beg) ?\()))
966 (when (and end (or (not (nth 8 (syntax-ppss)))
967 (eq (char-before beg) ?`)))
968 (let ((table-etc
969 (if (not funpos)
970 ;; FIXME: We could look at the first element of the list and
971 ;; use it to provide a more specific completion table in some
972 ;; cases. E.g. filter out keywords that are not understood by
973 ;; the macro/function being called.
974 (cond
975 ((lisp--expect-function-p beg)
976 (list nil obarray
977 :predicate #'fboundp
978 :company-doc-buffer #'lisp--company-doc-buffer
979 :company-docsig #'lisp--company-doc-string
980 :company-location #'lisp--company-location))
981 ((lisp--form-quoted-p beg)
982 (list nil obarray
983 ;; Don't include all symbols
984 ;; (bug#16646).
985 :predicate (lambda (sym)
986 (or (boundp sym)
987 (fboundp sym)
988 (symbol-plist sym)))
989 :annotation-function
990 (lambda (str) (if (fboundp (intern-soft str)) " <f>"))
991 :company-doc-buffer #'lisp--company-doc-buffer
992 :company-docsig #'lisp--company-doc-string
993 :company-location #'lisp--company-location))
994 (t
995 (list nil (completion-table-merge
996 lisp--local-variables-completion-table
997 (apply-partially #'completion-table-with-predicate
998 obarray
999 #'boundp
1000 'strict))
1001 :company-doc-buffer #'lisp--company-doc-buffer
1002 :company-docsig #'lisp--company-doc-string
1003 :company-location #'lisp--company-location)))
1004 ;; Looks like a funcall position. Let's double check.
1005 (save-excursion
1006 (goto-char (1- beg))
1007 (let ((parent
1008 (condition-case nil
1009 (progn (up-list -1) (forward-char 1)
1010 (let ((c (char-after)))
1011 (if (eq c ?\() ?\(
1012 (if (memq (char-syntax c) '(?w ?_))
1013 (read (current-buffer))))))
1014 (error nil))))
1015 (pcase parent
1016 ;; FIXME: Rather than hardcode special cases here,
1017 ;; we should use something like a symbol-property.
1018 (`declare
1019 (list t (mapcar (lambda (x) (symbol-name (car x)))
1020 (delete-dups
1021 ;; FIXME: We should include some
1022 ;; docstring with each entry.
1023 (append
1024 macro-declarations-alist
1025 defun-declarations-alist)))))
1026 ((and (or `condition-case `condition-case-unless-debug)
1027 (guard (save-excursion
1028 (ignore-errors
1029 (forward-sexp 2)
1030 (< (point) beg)))))
1031 (list t obarray
1032 :predicate (lambda (sym) (get sym 'error-conditions))))
1033 ((and ?\(
1034 (guard (save-excursion
1035 (goto-char (1- beg))
1036 (up-list -1)
1037 (forward-symbol -1)
1038 (looking-at "\\_<let\\*?\\_>"))))
1039 (list t obarray
1040 :predicate #'boundp
1041 :company-doc-buffer #'lisp--company-doc-buffer
1042 :company-docsig #'lisp--company-doc-string
1043 :company-location #'lisp--company-location))
1044 (_ (list nil obarray
1045 :predicate #'fboundp
1046 :company-doc-buffer #'lisp--company-doc-buffer
1047 :company-docsig #'lisp--company-doc-string
1048 :company-location #'lisp--company-location
1049 ))))))))
1050 (nconc (list beg end)
1051 (if (null (car table-etc))
1052 (cdr table-etc)
1053 (cons
1054 (if (memq (char-syntax (or (char-after end) ?\s))
1055 '(?\s ?>))
1056 (cadr table-etc)
1057 (apply-partially 'completion-table-with-terminator
1058 " " (cadr table-etc)))
1059 (cddr table-etc)))))))))
1060
1061;;; lisp.el ends here 761;;; lisp.el ends here
diff --git a/lisp/ielm.el b/lisp/ielm.el
index d6d742875d6..37e66ccc611 100644
--- a/lisp/ielm.el
+++ b/lisp/ielm.el
@@ -541,7 +541,9 @@ Customized bindings may be defined in `ielm-map', which currently contains:
541 (setq comint-process-echoes nil) 541 (setq comint-process-echoes nil)
542 (set (make-local-variable 'completion-at-point-functions) 542 (set (make-local-variable 'completion-at-point-functions)
543 '(comint-replace-by-expanded-history 543 '(comint-replace-by-expanded-history
544 ielm-complete-filename lisp-completion-at-point)) 544 ielm-complete-filename elisp-completion-at-point))
545 (setq-local eldoc-documentation-function
546 #'elisp-eldoc-documentation-function)
545 (set (make-local-variable 'ielm-prompt-internal) ielm-prompt) 547 (set (make-local-variable 'ielm-prompt-internal) ielm-prompt)
546 (set (make-local-variable 'comint-prompt-read-only) ielm-prompt-read-only) 548 (set (make-local-variable 'comint-prompt-read-only) ielm-prompt-read-only)
547 (setq comint-get-old-input 'ielm-get-old-input) 549 (setq comint-get-old-input 'ielm-get-old-input)
diff --git a/lisp/loadup.el b/lisp/loadup.el
index 417f0b411c5..c1206e243c5 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -217,6 +217,7 @@
217(load "textmodes/paragraphs") 217(load "textmodes/paragraphs")
218(load "progmodes/prog-mode") 218(load "progmodes/prog-mode")
219(load "emacs-lisp/lisp-mode") 219(load "emacs-lisp/lisp-mode")
220(load "progmodes/elisp-mode")
220(load "textmodes/text-mode") 221(load "textmodes/text-mode")
221(load "textmodes/fill") 222(load "textmodes/fill")
222(load "newcomment") 223(load "newcomment")
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
new file mode 100644
index 00000000000..41d2cd83b25
--- /dev/null
+++ b/lisp/progmodes/elisp-mode.el
@@ -0,0 +1,1288 @@
1;;; elisp-mode.el --- Emacs Lisp mode -*- lexical-binding:t -*-
2
3;; Copyright (C) 1985-1986, 1999-2014 Free Software Foundation, Inc.
4
5;; Maintainer: emacs-devel@gnu.org
6;; Keywords: lisp, languages
7;; Package: emacs
8
9;; This file is part of GNU Emacs.
10
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.
15
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.
20
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/>.
23
24;;; Commentary:
25
26;; The major mode for editing Emacs Lisp code.
27;; This mode is documented in the Emacs manual.
28
29;;; Code:
30
31(require 'lisp-mode)
32
33(defvar emacs-lisp-mode-abbrev-table nil)
34(define-abbrev-table 'emacs-lisp-mode-abbrev-table ()
35 "Abbrev table for Emacs Lisp mode.
36It has `lisp-mode-abbrev-table' as its parent."
37 :parents (list lisp-mode-abbrev-table))
38
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'.")
45
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"))
89
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"))
121
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.
179All commands in `lisp-mode-shared-map' are inherited by this map.")
180
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")))
187
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))
199
200(defun emacs-lisp-macroexpand ()
201 "Macroexpand the form after point.
202Comments 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 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)))))
214
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)
220
221;;;###autoload
222(define-derived-mode emacs-lisp-mode prog-mode "Emacs-Lisp"
223 "Major mode for editing Lisp code to run in Emacs.
224Commands:
225Delete converts tabs to spaces as it moves back.
226Blank lines separate paragraphs. Semicolons start comments.
227
228\\{emacs-lisp-mode-map}"
229 :group 'lisp
230 (lisp-mode-variables nil nil 'elisp)
231 (setq imenu-case-fold-search nil)
232 (setq-local eldoc-documentation-function
233 #'elisp-eldoc-documentation-function)
234 (add-hook 'completion-at-point-functions
235 #'elisp-completion-at-point nil 'local))
236
237;;; Completion at point for Elisp
238
239(defun elisp--local-variables-1 (vars sexp)
240 "Return the vars locally bound around the witness, or nil if not found."
241 (let (res)
242 (while
243 (unless
244 (setq res
245 (pcase sexp
246 (`(,(or `let `let*) ,bindings)
247 (let ((vars vars))
248 (when (eq 'let* (car sexp))
249 (dolist (binding (cdr (reverse bindings)))
250 (push (or (car-safe binding) binding) vars)))
251 (elisp--local-variables-1
252 vars (car (cdr-safe (car (last bindings)))))))
253 (`(,(or `let `let*) ,bindings . ,body)
254 (let ((vars vars))
255 (dolist (binding bindings)
256 (push (or (car-safe binding) binding) vars))
257 (elisp--local-variables-1 vars (car (last body)))))
258 (`(lambda ,_) (setq sexp nil))
259 (`(lambda ,args . ,body)
260 (elisp--local-variables-1
261 (append args vars) (car (last body))))
262 (`(condition-case ,_ ,e) (elisp--local-variables-1 vars e))
263 (`(condition-case ,v ,_ . ,catches)
264 (elisp--local-variables-1
265 (cons v vars) (cdr (car (last catches)))))
266 (`(,_ . ,_)
267 (elisp--local-variables-1 vars (car (last sexp))))
268 (`elisp--witness--lisp (or vars '(nil)))
269 (_ nil)))
270 (setq sexp (ignore-errors (butlast sexp)))))
271 res))
272
273(defun elisp--local-variables ()
274 "Return a list of locally let-bound variables at point."
275 (save-excursion
276 (skip-syntax-backward "w_")
277 (let* ((ppss (syntax-ppss))
278 (txt (buffer-substring-no-properties (or (car (nth 9 ppss)) (point))
279 (or (nth 8 ppss) (point))))
280 (closer ()))
281 (dolist (p (nth 9 ppss))
282 (push (cdr (syntax-after p)) closer))
283 (setq closer (apply #'string closer))
284 (let* ((sexp (condition-case nil
285 (car (read-from-string
286 (concat txt "elisp--witness--lisp" closer)))
287 (end-of-file nil)))
288 (macroexpand-advice (lambda (expander form &rest args)
289 (condition-case nil
290 (apply expander form args)
291 (error form))))
292 (sexp
293 (unwind-protect
294 (progn
295 (advice-add 'macroexpand :around macroexpand-advice)
296 (macroexpand-all sexp))
297 (advice-remove 'macroexpand macroexpand-advice)))
298 (vars (elisp--local-variables-1 nil sexp)))
299 (delq nil
300 (mapcar (lambda (var)
301 (and (symbolp var)
302 (not (string-match (symbol-name var) "\\`[&_]"))
303 ;; Eliminate uninterned vars.
304 (intern-soft var)
305 var))
306 vars))))))
307
308(defvar elisp--local-variables-completion-table
309 ;; Use `defvar' rather than `defconst' since defconst would purecopy this
310 ;; value, which would doubly fail: it would fail because purecopy can't
311 ;; handle the recursive bytecode object, and it would fail because it would
312 ;; move `lastpos' and `lastvars' to pure space where they'd be immutable!
313 (let ((lastpos nil) (lastvars nil))
314 (letrec ((hookfun (lambda ()
315 (setq lastpos nil)
316 (remove-hook 'post-command-hook hookfun))))
317 (completion-table-dynamic
318 (lambda (_string)
319 (save-excursion
320 (skip-syntax-backward "_w")
321 (let ((newpos (cons (point) (current-buffer))))
322 (unless (equal lastpos newpos)
323 (add-hook 'post-command-hook hookfun)
324 (setq lastpos newpos)
325 (setq lastvars
326 (mapcar #'symbol-name (elisp--local-variables))))))
327 lastvars)))))
328
329(defun elisp--expect-function-p (pos)
330 "Return non-nil if the symbol at point is expected to be a function."
331 (or
332 (and (eq (char-before pos) ?')
333 (eq (char-before (1- pos)) ?#))
334 (save-excursion
335 (let ((parent (nth 1 (syntax-ppss pos))))
336 (when parent
337 (goto-char parent)
338 (and
339 (looking-at (concat "(\\(cl-\\)?"
340 (regexp-opt '("declare-function"
341 "function" "defadvice"
342 "callf" "callf2"
343 "defsetf"))
344 "[ \t\r\n]+"))
345 (eq (match-end 0) pos)))))))
346
347(defun elisp--form-quoted-p (pos)
348 "Return non-nil if the form at POS is not evaluated.
349It can be quoted, or be inside a quoted form."
350 ;; FIXME: Do some macro expansion maybe.
351 (save-excursion
352 (let ((state (syntax-ppss pos)))
353 (or (nth 8 state) ; Code inside strings usually isn't evaluated.
354 ;; FIXME: The 9th element is undocumented.
355 (let ((nesting (cons (point) (reverse (nth 9 state))))
356 res)
357 (while (and nesting (not res))
358 (goto-char (pop nesting))
359 (cond
360 ((or (eq (char-after) ?\[)
361 (progn
362 (skip-chars-backward " ")
363 (memq (char-before) '(?' ?`))))
364 (setq res t))
365 ((eq (char-before) ?,)
366 (setq nesting nil))))
367 res)))))
368
369;; FIXME: Support for Company brings in features which straddle eldoc.
370;; We should consolidate this, so that major modes can provide all that
371;; data all at once:
372;; - a function to extract "the reference at point" (may be more complex
373;; than a mere string, to distinguish various namespaces).
374;; - a function to jump to such a reference.
375;; - a function to show the signature/interface of such a reference.
376;; - a function to build a help-buffer about that reference.
377;; FIXME: Those functions should also be used by the normal completion code in
378;; the *Completions* buffer.
379
380(defun elisp--company-doc-buffer (str)
381 (let ((symbol (intern-soft str)))
382 ;; FIXME: we really don't want to "display-buffer and then undo it".
383 (save-window-excursion
384 ;; Make sure we don't display it in another frame, otherwise
385 ;; save-window-excursion won't be able to undo it.
386 (let ((display-buffer-overriding-action
387 '(nil . ((inhibit-switch-frame . t)))))
388 (ignore-errors
389 (cond
390 ((fboundp symbol) (describe-function symbol))
391 ((boundp symbol) (describe-variable symbol))
392 ((featurep symbol) (describe-package symbol))
393 ((facep symbol) (describe-face symbol))
394 (t (signal 'user-error nil)))
395 (help-buffer))))))
396
397(defun elisp--company-doc-string (str)
398 (let* ((symbol (intern-soft str))
399 (doc (if (fboundp symbol)
400 (documentation symbol t)
401 (documentation-property symbol 'variable-documentation t))))
402 (and (stringp doc)
403 (string-match ".*$" doc)
404 (match-string 0 doc))))
405
406(declare-function find-library-name "find-func" (library))
407
408(defun elisp--company-location (str)
409 (let ((sym (intern-soft str)))
410 (cond
411 ((fboundp sym) (find-definition-noselect sym nil))
412 ((boundp sym) (find-definition-noselect sym 'defvar))
413 ((featurep sym)
414 (require 'find-func)
415 (cons (find-file-noselect (find-library-name
416 (symbol-name sym)))
417 0))
418 ((facep sym) (find-definition-noselect sym 'defface)))))
419
420(defun elisp-completion-at-point ()
421 "Function used for `completion-at-point-functions' in `emacs-lisp-mode'."
422 (with-syntax-table emacs-lisp-mode-syntax-table
423 (let* ((pos (point))
424 (beg (condition-case nil
425 (save-excursion
426 (backward-sexp 1)
427 (skip-syntax-forward "'")
428 (point))
429 (scan-error pos)))
430 (end
431 (unless (or (eq beg (point-max))
432 (member (char-syntax (char-after beg))
433 '(?\s ?\" ?\( ?\))))
434 (condition-case nil
435 (save-excursion
436 (goto-char beg)
437 (forward-sexp 1)
438 (skip-chars-backward "'")
439 (when (>= (point) pos)
440 (point)))
441 (scan-error pos))))
442 ;; t if in function position.
443 (funpos (eq (char-before beg) ?\()))
444 (when (and end (or (not (nth 8 (syntax-ppss)))
445 (eq (char-before beg) ?`)))
446 (let ((table-etc
447 (if (not funpos)
448 ;; FIXME: We could look at the first element of the list and
449 ;; use it to provide a more specific completion table in some
450 ;; cases. E.g. filter out keywords that are not understood by
451 ;; the macro/function being called.
452 (cond
453 ((elisp--expect-function-p beg)
454 (list nil obarray
455 :predicate #'fboundp
456 :company-doc-buffer #'elisp--company-doc-buffer
457 :company-docsig #'elisp--company-doc-string
458 :company-location #'elisp--company-location))
459 ((elisp--form-quoted-p beg)
460 (list nil obarray
461 ;; Don't include all symbols
462 ;; (bug#16646).
463 :predicate (lambda (sym)
464 (or (boundp sym)
465 (fboundp sym)
466 (symbol-plist sym)))
467 :annotation-function
468 (lambda (str) (if (fboundp (intern-soft str)) " <f>"))
469 :company-doc-buffer #'elisp--company-doc-buffer
470 :company-docsig #'elisp--company-doc-string
471 :company-location #'elisp--company-location))
472 (t
473 (list nil (completion-table-merge
474 elisp--local-variables-completion-table
475 (apply-partially #'completion-table-with-predicate
476 obarray
477 #'boundp
478 'strict))
479 :company-doc-buffer #'elisp--company-doc-buffer
480 :company-docsig #'elisp--company-doc-string
481 :company-location #'elisp--company-location)))
482 ;; Looks like a funcall position. Let's double check.
483 (save-excursion
484 (goto-char (1- beg))
485 (let ((parent
486 (condition-case nil
487 (progn (up-list -1) (forward-char 1)
488 (let ((c (char-after)))
489 (if (eq c ?\() ?\(
490 (if (memq (char-syntax c) '(?w ?_))
491 (read (current-buffer))))))
492 (error nil))))
493 (pcase parent
494 ;; FIXME: Rather than hardcode special cases here,
495 ;; we should use something like a symbol-property.
496 (`declare
497 (list t (mapcar (lambda (x) (symbol-name (car x)))
498 (delete-dups
499 ;; FIXME: We should include some
500 ;; docstring with each entry.
501 (append
502 macro-declarations-alist
503 defun-declarations-alist)))))
504 ((and (or `condition-case `condition-case-unless-debug)
505 (guard (save-excursion
506 (ignore-errors
507 (forward-sexp 2)
508 (< (point) beg)))))
509 (list t obarray
510 :predicate (lambda (sym) (get sym 'error-conditions))))
511 ((and ?\(
512 (guard (save-excursion
513 (goto-char (1- beg))
514 (up-list -1)
515 (forward-symbol -1)
516 (looking-at "\\_<let\\*?\\_>"))))
517 (list t obarray
518 :predicate #'boundp
519 :company-doc-buffer #'elisp--company-doc-buffer
520 :company-docsig #'elisp--company-doc-string
521 :company-location #'elisp--company-location))
522 (_ (list nil obarray
523 :predicate #'fboundp
524 :company-doc-buffer #'elisp--company-doc-buffer
525 :company-docsig #'elisp--company-doc-string
526 :company-location #'elisp--company-location
527 ))))))))
528 (nconc (list beg end)
529 (if (null (car table-etc))
530 (cdr table-etc)
531 (cons
532 (if (memq (char-syntax (or (char-after end) ?\s))
533 '(?\s ?>))
534 (cadr table-etc)
535 (apply-partially 'completion-table-with-terminator
536 " " (cadr table-etc)))
537 (cddr table-etc)))))))))
538
539(define-obsolete-function-alias
540 'lisp-completion-at-point 'elisp-completion-at-point "25.1")
541
542;;; Elisp Interaction mode
543
544(defvar lisp-interaction-mode-map
545 (let ((map (make-sparse-keymap))
546 (menu-map (make-sparse-keymap "Lisp-Interaction")))
547 (set-keymap-parent map lisp-mode-shared-map)
548 (define-key map "\e\C-x" 'eval-defun)
549 (define-key map "\e\C-q" 'indent-pp-sexp)
550 (define-key map "\e\t" 'completion-at-point)
551 (define-key map "\n" 'eval-print-last-sexp)
552 (bindings--define-key map [menu-bar lisp-interaction]
553 (cons "Lisp-Interaction" menu-map))
554 (bindings--define-key menu-map [eval-defun]
555 '(menu-item "Evaluate Defun" eval-defun
556 :help "Evaluate the top-level form containing point, or after point"))
557 (bindings--define-key menu-map [eval-print-last-sexp]
558 '(menu-item "Evaluate and Print" eval-print-last-sexp
559 :help "Evaluate sexp before point; print value into current buffer"))
560 (bindings--define-key menu-map [edebug-defun-lisp-interaction]
561 '(menu-item "Instrument Function for Debugging" edebug-defun
562 :help "Evaluate the top level form point is in, stepping through with Edebug"
563 :keys "C-u C-M-x"))
564 (bindings--define-key menu-map [indent-pp-sexp]
565 '(menu-item "Indent or Pretty-Print" indent-pp-sexp
566 :help "Indent each line of the list starting just after point, or prettyprint it"))
567 (bindings--define-key menu-map [complete-symbol]
568 '(menu-item "Complete Lisp Symbol" completion-at-point
569 :help "Perform completion on Lisp symbol preceding point"))
570 map)
571 "Keymap for Lisp Interaction mode.
572All commands in `lisp-mode-shared-map' are inherited by this map.")
573
574(define-derived-mode lisp-interaction-mode emacs-lisp-mode "Lisp Interaction"
575 "Major mode for typing and evaluating Lisp forms.
576Like Lisp mode except that \\[eval-print-last-sexp] evals the Lisp expression
577before point, and prints its value into the buffer, advancing point.
578Note that printing is controlled by `eval-expression-print-length'
579and `eval-expression-print-level'.
580
581Commands:
582Delete converts tabs to spaces as it moves back.
583Paragraphs are separated only by blank lines.
584Semicolons start comments.
585
586\\{lisp-interaction-mode-map}"
587 :abbrev-table nil)
588
589;;; Emacs Lisp Byte-Code mode
590
591(eval-and-compile
592 (defconst emacs-list-byte-code-comment-re
593 (concat "\\(#\\)@\\([0-9]+\\) "
594 ;; Make sure it's a docstring and not a lazy-loaded byte-code.
595 "\\(?:[^(]\\|([^\"]\\)")))
596
597(defun elisp--byte-code-comment (end &optional _point)
598 "Try to syntactically mark the #@NNN ....^_ docstrings in byte-code files."
599 (let ((ppss (syntax-ppss)))
600 (when (and (nth 4 ppss)
601 (eq (char-after (nth 8 ppss)) ?#))
602 (let* ((n (save-excursion
603 (goto-char (nth 8 ppss))
604 (when (looking-at emacs-list-byte-code-comment-re)
605 (string-to-number (match-string 2)))))
606 ;; `maxdiff' tries to make sure the loop below terminates.
607 (maxdiff n))
608 (when n
609 (let* ((bchar (match-end 2))
610 (b (position-bytes bchar)))
611 (goto-char (+ b n))
612 (while (let ((diff (- (position-bytes (point)) b n)))
613 (unless (zerop diff)
614 (when (> diff maxdiff) (setq diff maxdiff))
615 (forward-char (- diff))
616 (setq maxdiff (if (> diff 0) diff
617 (max (1- maxdiff) 1)))
618 t))))
619 (if (<= (point) end)
620 (put-text-property (1- (point)) (point)
621 'syntax-table
622 (string-to-syntax "> b"))
623 (goto-char end)))))))
624
625(defun elisp-byte-code-syntax-propertize (start end)
626 (elisp--byte-code-comment end (point))
627 (funcall
628 (syntax-propertize-rules
629 (emacs-list-byte-code-comment-re
630 (1 (prog1 "< b" (elisp--byte-code-comment end (point))))))
631 start end))
632
633;;;###autoload
634(add-to-list 'auto-mode-alist '("\\.elc\\'" . elisp-byte-code-mode))
635;;;###autoload
636(define-derived-mode elisp-byte-code-mode emacs-lisp-mode
637 "Elisp-Byte-Code"
638 "Major mode for *.elc files."
639 ;; TODO: Add way to disassemble byte-code under point.
640 (setq-local open-paren-in-column-0-is-defun-start nil)
641 (setq-local syntax-propertize-function
642 #'elisp-byte-code-syntax-propertize))
643
644
645;;; Globally accessible functionality
646
647(defun eval-print-last-sexp (&optional eval-last-sexp-arg-internal)
648 "Evaluate sexp before point; print value into current buffer.
649
650Normally, this function truncates long output according to the value
651of the variables `eval-expression-print-length' and
652`eval-expression-print-level'. With a prefix argument of zero,
653however, there is no such truncation. Such a prefix argument
654also causes integers to be printed in several additional formats
655\(octal, hexadecimal, and character).
656
657If `eval-expression-debug-on-error' is non-nil, which is the default,
658this command arranges for all errors to enter the debugger."
659 (interactive "P")
660 (let ((standard-output (current-buffer)))
661 (terpri)
662 (eval-last-sexp (or eval-last-sexp-arg-internal t))
663 (terpri)))
664
665
666(defun last-sexp-setup-props (beg end value alt1 alt2)
667 "Set up text properties for the output of `elisp--eval-last-sexp'.
668BEG and END are the start and end of the output in current-buffer.
669VALUE is the Lisp value printed, ALT1 and ALT2 are strings for the
670alternative printed representations that can be displayed."
671 (let ((map (make-sparse-keymap)))
672 (define-key map "\C-m" 'elisp-last-sexp-toggle-display)
673 (define-key map [down-mouse-2] 'mouse-set-point)
674 (define-key map [mouse-2] 'elisp-last-sexp-toggle-display)
675 (add-text-properties
676 beg end
677 `(printed-value (,value ,alt1 ,alt2)
678 mouse-face highlight
679 keymap ,map
680 help-echo "RET, mouse-2: toggle abbreviated display"
681 rear-nonsticky (mouse-face keymap help-echo
682 printed-value)))))
683
684
685(defun elisp-last-sexp-toggle-display (&optional _arg)
686 "Toggle between abbreviated and unabbreviated printed representations."
687 (interactive "P")
688 (save-restriction
689 (widen)
690 (let ((value (get-text-property (point) 'printed-value)))
691 (when value
692 (let ((beg (or (previous-single-property-change (min (point-max) (1+ (point)))
693 'printed-value)
694 (point)))
695 (end (or (next-single-char-property-change (point) 'printed-value) (point)))
696 (standard-output (current-buffer))
697 (point (point)))
698 (delete-region beg end)
699 (insert (nth 1 value))
700 (or (= beg point)
701 (setq point (1- (point))))
702 (last-sexp-setup-props beg (point)
703 (nth 0 value)
704 (nth 2 value)
705 (nth 1 value))
706 (goto-char (min (point-max) point)))))))
707
708(defun prin1-char (char) ;FIXME: Move it, e.g. to simple.el.
709 "Return a string representing CHAR as a character rather than as an integer.
710If CHAR is not a character, return nil."
711 (and (integerp char)
712 (eventp char)
713 (let ((c (event-basic-type char))
714 (mods (event-modifiers char))
715 string)
716 ;; Prevent ?A from turning into ?\S-a.
717 (if (and (memq 'shift mods)
718 (zerop (logand char ?\S-\^@))
719 (not (let ((case-fold-search nil))
720 (char-equal c (upcase c)))))
721 (setq c (upcase c) mods nil))
722 ;; What string are we considering using?
723 (condition-case nil
724 (setq string
725 (concat
726 "?"
727 (mapconcat
728 (lambda (modif)
729 (cond ((eq modif 'super) "\\s-")
730 (t (string ?\\ (upcase (aref (symbol-name modif) 0)) ?-))))
731 mods "")
732 (cond
733 ((memq c '(?\; ?\( ?\) ?\{ ?\} ?\[ ?\] ?\" ?\' ?\\)) (string ?\\ c))
734 ((eq c 127) "\\C-?")
735 (t
736 (string c)))))
737 (error nil))
738 ;; Verify the string reads a CHAR, not to some other character.
739 ;; If it doesn't, return nil instead.
740 (and string
741 (= (car (read-from-string string)) char)
742 string))))
743
744(defun elisp--preceding-sexp ()
745 "Return sexp before the point."
746 (let ((opoint (point))
747 ignore-quotes
748 expr)
749 (save-excursion
750 (with-syntax-table emacs-lisp-mode-syntax-table
751 ;; If this sexp appears to be enclosed in `...'
752 ;; then ignore the surrounding quotes.
753 (setq ignore-quotes
754 (or (eq (following-char) ?\')
755 (eq (preceding-char) ?\')))
756 (forward-sexp -1)
757 ;; If we were after `?\e' (or similar case),
758 ;; use the whole thing, not just the `e'.
759 (when (eq (preceding-char) ?\\)
760 (forward-char -1)
761 (when (eq (preceding-char) ??)
762 (forward-char -1)))
763
764 ;; Skip over hash table read syntax.
765 (and (> (point) (1+ (point-min)))
766 (looking-back "#s" (- (point) 2))
767 (forward-char -2))
768
769 ;; Skip over `#N='s.
770 (when (eq (preceding-char) ?=)
771 (let (labeled-p)
772 (save-excursion
773 (skip-chars-backward "0-9#=")
774 (setq labeled-p (looking-at "\\(#[0-9]+=\\)+")))
775 (when labeled-p
776 (forward-sexp -1))))
777
778 (save-restriction
779 (if (and ignore-quotes (eq (following-char) ?`))
780 ;; vladimir@cs.ualberta.ca 30-Jul-1997: Skip ` in `variable' so
781 ;; that the value is returned, not the name.
782 (forward-char))
783 (when (looking-at ",@?") (goto-char (match-end 0)))
784 (narrow-to-region (point-min) opoint)
785 (setq expr (read (current-buffer)))
786 ;; If it's an (interactive ...) form, it's more useful to show how an
787 ;; interactive call would use it.
788 ;; FIXME: Is it really the right place for this?
789 (when (eq (car-safe expr) 'interactive)
790 (setq expr
791 `(call-interactively
792 (lambda (&rest args) ,expr args))))
793 expr)))))
794(define-obsolete-function-alias 'preceding-sexp 'elisp--preceding-sexp "25.1")
795
796(defun elisp--eval-last-sexp (eval-last-sexp-arg-internal)
797 "Evaluate sexp before point; print value in the echo area.
798With argument, print output into current buffer.
799With a zero prefix arg, print output with no limit on the length
800and level of lists, and include additional formats for integers
801\(octal, hexadecimal, and character)."
802 (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t)))
803 ;; Setup the lexical environment if lexical-binding is enabled.
804 (elisp--eval-last-sexp-print-value
805 (eval (eval-sexp-add-defvars (elisp--preceding-sexp)) lexical-binding)
806 eval-last-sexp-arg-internal)))
807
808
809(defun elisp--eval-last-sexp-print-value (value &optional eval-last-sexp-arg-internal)
810 (let ((unabbreviated (let ((print-length nil) (print-level nil))
811 (prin1-to-string value)))
812 (print-length (and (not (zerop (prefix-numeric-value
813 eval-last-sexp-arg-internal)))
814 eval-expression-print-length))
815 (print-level (and (not (zerop (prefix-numeric-value
816 eval-last-sexp-arg-internal)))
817 eval-expression-print-level))
818 (beg (point))
819 end)
820 (prog1
821 (prin1 value)
822 (let ((str (eval-expression-print-format value)))
823 (if str (princ str)))
824 (setq end (point))
825 (when (and (bufferp standard-output)
826 (or (not (null print-length))
827 (not (null print-level)))
828 (not (string= unabbreviated
829 (buffer-substring-no-properties beg end))))
830 (last-sexp-setup-props beg end value
831 unabbreviated
832 (buffer-substring-no-properties beg end))
833 ))))
834
835
836(defvar elisp--eval-last-sexp-fake-value (make-symbol "t"))
837
838(defun eval-sexp-add-defvars (exp &optional pos)
839 "Prepend EXP with all the `defvar's that precede it in the buffer.
840POS specifies the starting position where EXP was found and defaults to point."
841 (setq exp (macroexpand-all exp)) ;Eager macro-expansion.
842 (if (not lexical-binding)
843 exp
844 (save-excursion
845 (unless pos (setq pos (point)))
846 (let ((vars ()))
847 (goto-char (point-min))
848 (while (re-search-forward
849 "(def\\(?:var\\|const\\|custom\\)[ \t\n]+\\([^; '()\n\t]+\\)"
850 pos t)
851 (let ((var (intern (match-string 1))))
852 (and (not (special-variable-p var))
853 (save-excursion
854 (zerop (car (syntax-ppss (match-beginning 0)))))
855 (push var vars))))
856 `(progn ,@(mapcar (lambda (v) `(defvar ,v)) vars) ,exp)))))
857
858(defun eval-last-sexp (eval-last-sexp-arg-internal)
859 "Evaluate sexp before point; print value in the echo area.
860Interactively, with prefix argument, print output into current buffer.
861
862Normally, this function truncates long output according to the value
863of the variables `eval-expression-print-length' and
864`eval-expression-print-level'. With a prefix argument of zero,
865however, there is no such truncation. Such a prefix argument
866also causes integers to be printed in several additional formats
867\(octal, hexadecimal, and character).
868
869If `eval-expression-debug-on-error' is non-nil, which is the default,
870this command arranges for all errors to enter the debugger."
871 (interactive "P")
872 (if (null eval-expression-debug-on-error)
873 (elisp--eval-last-sexp eval-last-sexp-arg-internal)
874 (let ((value
875 (let ((debug-on-error elisp--eval-last-sexp-fake-value))
876 (cons (elisp--eval-last-sexp eval-last-sexp-arg-internal)
877 debug-on-error))))
878 (unless (eq (cdr value) elisp--eval-last-sexp-fake-value)
879 (setq debug-on-error (cdr value)))
880 (car value))))
881
882(defun elisp--eval-defun-1 (form)
883 "Treat some expressions specially.
884Reset the `defvar' and `defcustom' variables to the initial value.
885\(For `defcustom', use the :set function if there is one.)
886Reinitialize the face according to the `defface' specification."
887 ;; The code in edebug-defun should be consistent with this, but not
888 ;; the same, since this gets a macroexpanded form.
889 (cond ((not (listp form))
890 form)
891 ((and (eq (car form) 'defvar)
892 (cdr-safe (cdr-safe form))
893 (boundp (cadr form)))
894 ;; Force variable to be re-set.
895 `(progn (defvar ,(nth 1 form) nil ,@(nthcdr 3 form))
896 (setq-default ,(nth 1 form) ,(nth 2 form))))
897 ;; `defcustom' is now macroexpanded to
898 ;; `custom-declare-variable' with a quoted value arg.
899 ((and (eq (car form) 'custom-declare-variable)
900 (default-boundp (eval (nth 1 form) lexical-binding)))
901 ;; Force variable to be bound, using :set function if specified.
902 (let ((setfunc (memq :set form)))
903 (when setfunc
904 (setq setfunc (car-safe (cdr-safe setfunc)))
905 (or (functionp setfunc) (setq setfunc nil)))
906 (funcall (or setfunc 'set-default)
907 (eval (nth 1 form) lexical-binding)
908 ;; The second arg is an expression that evaluates to
909 ;; an expression. The second evaluation is the one
910 ;; normally performed not by normal execution but by
911 ;; custom-initialize-set (for example), which does not
912 ;; use lexical-binding.
913 (eval (eval (nth 2 form) lexical-binding))))
914 form)
915 ;; `defface' is macroexpanded to `custom-declare-face'.
916 ((eq (car form) 'custom-declare-face)
917 ;; Reset the face.
918 (let ((face-symbol (eval (nth 1 form) lexical-binding)))
919 (setq face-new-frame-defaults
920 (assq-delete-all face-symbol face-new-frame-defaults))
921 (put face-symbol 'face-defface-spec nil)
922 (put face-symbol 'face-override-spec nil))
923 form)
924 ((eq (car form) 'progn)
925 (cons 'progn (mapcar #'elisp--eval-defun-1 (cdr form))))
926 (t form)))
927
928(defun elisp--eval-defun ()
929 "Evaluate defun that point is in or before.
930The value is displayed in the echo area.
931If the current defun is actually a call to `defvar',
932then reset the variable using the initial value expression
933even if the variable already has some other value.
934\(Normally `defvar' does not change the variable's value
935if it already has a value.\)
936
937Return the result of evaluation."
938 ;; FIXME: the print-length/level bindings should only be applied while
939 ;; printing, not while evaluating.
940 (let ((debug-on-error eval-expression-debug-on-error)
941 (print-length eval-expression-print-length)
942 (print-level eval-expression-print-level))
943 (save-excursion
944 ;; Arrange for eval-region to "read" the (possibly) altered form.
945 ;; eval-region handles recording which file defines a function or
946 ;; variable.
947 (let ((standard-output t)
948 beg end form)
949 ;; Read the form from the buffer, and record where it ends.
950 (save-excursion
951 (end-of-defun)
952 (beginning-of-defun)
953 (setq beg (point))
954 (setq form (read (current-buffer)))
955 (setq end (point)))
956 ;; Alter the form if necessary.
957 (let ((form (eval-sexp-add-defvars
958 (elisp--eval-defun-1 (macroexpand form)))))
959 (eval-region beg end standard-output
960 (lambda (_ignore)
961 ;; Skipping to the end of the specified region
962 ;; will make eval-region return.
963 (goto-char end)
964 form))))))
965 (let ((str (eval-expression-print-format (car values))))
966 (if str (princ str)))
967 ;; The result of evaluation has been put onto VALUES. So return it.
968 (car values))
969
970(defun eval-defun (edebug-it)
971 "Evaluate the top-level form containing point, or after point.
972
973If the current defun is actually a call to `defvar' or `defcustom',
974evaluating it this way resets the variable using its initial value
975expression (using the defcustom's :set function if there is one), even
976if the variable already has some other value. \(Normally `defvar' and
977`defcustom' do not alter the value if there already is one.) In an
978analogous way, evaluating a `defface' overrides any customizations of
979the face, so that it becomes defined exactly as the `defface' expression
980says.
981
982If `eval-expression-debug-on-error' is non-nil, which is the default,
983this command arranges for all errors to enter the debugger.
984
985With a prefix argument, instrument the code for Edebug.
986
987If acting on a `defun' for FUNCTION, and the function was
988instrumented, `Edebug: FUNCTION' is printed in the echo area. If not
989instrumented, just FUNCTION is printed.
990
991If not acting on a `defun', the result of evaluation is displayed in
992the echo area. This display is controlled by the variables
993`eval-expression-print-length' and `eval-expression-print-level',
994which see."
995 (interactive "P")
996 (cond (edebug-it
997 (require 'edebug)
998 (eval-defun (not edebug-all-defs)))
999 (t
1000 (if (null eval-expression-debug-on-error)
1001 (elisp--eval-defun)
1002 (let (new-value value)
1003 (let ((debug-on-error elisp--eval-last-sexp-fake-value))
1004 (setq value (elisp--eval-defun))
1005 (setq new-value debug-on-error))
1006 (unless (eq elisp--eval-last-sexp-fake-value new-value)
1007 (setq debug-on-error new-value))
1008 value)))))
1009
1010;;; ElDoc Support
1011
1012(defconst elisp--eldoc-last-data (make-vector 3 nil)
1013 "Bookkeeping; elements are as follows:
1014 0 - contains the last symbol read from the buffer.
1015 1 - contains the string last displayed in the echo area for variables,
1016 or argument string for functions.
1017 2 - 'function if function args, 'variable if variable documentation.")
1018
1019(defun elisp-eldoc-documentation-function ()
1020 "`eldoc-documentation-function' (which see) for Emacs Lisp."
1021 (let ((current-symbol (elisp--current-symbol))
1022 (current-fnsym (elisp--fnsym-in-current-sexp)))
1023 (cond ((null current-fnsym)
1024 nil)
1025 ((eq current-symbol (car current-fnsym))
1026 (or (apply #'elisp--get-fnsym-args-string current-fnsym)
1027 (elisp--get-var-docstring current-symbol)))
1028 (t
1029 (or (elisp--get-var-docstring current-symbol)
1030 (apply #'elisp--get-fnsym-args-string current-fnsym))))))
1031
1032(defun elisp--get-fnsym-args-string (sym &optional index)
1033 "Return a string containing the parameter list of the function SYM.
1034If SYM is a subr and no arglist is obtainable from the docstring
1035or elsewhere, return a 1-line docstring."
1036 (let ((argstring
1037 (cond
1038 ((not (and sym (symbolp sym) (fboundp sym))) nil)
1039 ((and (eq sym (aref elisp--eldoc-last-data 0))
1040 (eq 'function (aref elisp--eldoc-last-data 2)))
1041 (aref elisp--eldoc-last-data 1))
1042 (t
1043 (let* ((advertised (gethash (indirect-function sym)
1044 advertised-signature-table t))
1045 doc
1046 (args
1047 (cond
1048 ((listp advertised) advertised)
1049 ((setq doc (help-split-fundoc (documentation sym t) sym))
1050 (car doc))
1051 (t (help-function-arglist sym)))))
1052 ;; Stringify, and store before highlighting, downcasing, etc.
1053 ;; FIXME should truncate before storing.
1054 (elisp--last-data-store sym (elisp--function-argstring args)
1055 'function))))))
1056 ;; Highlight, truncate.
1057 (if argstring
1058 (elisp--highlight-function-argument sym argstring index))))
1059
1060(defun elisp--highlight-function-argument (sym args index)
1061 "Highlight argument INDEX in ARGS list for function SYM.
1062In the absence of INDEX, just call `elisp--docstring-format-sym-doc'."
1063 ;; FIXME: This should probably work on the list representation of `args'
1064 ;; rather than its string representation.
1065 ;; FIXME: This function is much too long, we need to split it up!
1066 (let ((start nil)
1067 (end 0)
1068 (argument-face 'eldoc-highlight-function-argument)
1069 (args-lst (mapcar (lambda (x)
1070 (replace-regexp-in-string
1071 "\\`[(]\\|[)]\\'" "" x))
1072 (split-string args))))
1073 ;; Find the current argument in the argument string. We need to
1074 ;; handle `&rest' and informal `...' properly.
1075 ;;
1076 ;; FIXME: What to do with optional arguments, like in
1077 ;; (defun NAME ARGLIST [DOCSTRING] BODY...) case?
1078 ;; The problem is there is no robust way to determine if
1079 ;; the current argument is indeed a docstring.
1080
1081 ;; When `&key' is used finding position based on `index'
1082 ;; would be wrong, so find the arg at point and determine
1083 ;; position in ARGS based on this current arg.
1084 (when (string-match "&key" args)
1085 (let* (case-fold-search
1086 key-have-value
1087 (sym-name (symbol-name sym))
1088 (cur-w (current-word))
1089 (args-lst-ak (cdr (member "&key" args-lst)))
1090 (limit (save-excursion
1091 (when (re-search-backward sym-name nil t)
1092 (match-end 0))))
1093 (cur-a (if (and cur-w (string-match ":\\([^ ()]*\\)" cur-w))
1094 (substring cur-w 1)
1095 (save-excursion
1096 (let (split)
1097 (when (re-search-backward ":\\([^()\n]*\\)" limit t)
1098 (setq split (split-string (match-string 1) " " t))
1099 (prog1 (car split)
1100 (when (cdr split)
1101 (setq key-have-value t))))))))
1102 ;; If `cur-a' is not one of `args-lst-ak'
1103 ;; assume user is entering an unknown key
1104 ;; referenced in last position in signature.
1105 (other-key-arg (and (stringp cur-a)
1106 args-lst-ak
1107 (not (member (upcase cur-a) args-lst-ak))
1108 (upcase (car (last args-lst-ak))))))
1109 (unless (string= cur-w sym-name)
1110 ;; The last keyword have already a value
1111 ;; i.e :foo a b and cursor is at b.
1112 ;; If signature have also `&rest'
1113 ;; (assume it is after the `&key' section)
1114 ;; go to the arg after `&rest'.
1115 (if (and key-have-value
1116 (save-excursion
1117 (not (re-search-forward ":.*" (point-at-eol) t)))
1118 (string-match "&rest \\([^ ()]*\\)" args))
1119 (setq index nil ; Skip next block based on positional args.
1120 start (match-beginning 1)
1121 end (match-end 1))
1122 ;; If `cur-a' is nil probably cursor is on a positional arg
1123 ;; before `&key', in this case, exit this block and determine
1124 ;; position with `index'.
1125 (when (and cur-a ; A keyword arg (dot removed) or nil.
1126 (or (string-match
1127 (concat "\\_<" (upcase cur-a) "\\_>") args)
1128 (string-match
1129 (concat "\\_<" other-key-arg "\\_>") args)))
1130 (setq index nil ; Skip next block based on positional args.
1131 start (match-beginning 0)
1132 end (match-end 0)))))))
1133 ;; Handle now positional arguments.
1134 (while (and index (>= index 1))
1135 (if (string-match "[^ ()]+" args end)
1136 (progn
1137 (setq start (match-beginning 0)
1138 end (match-end 0))
1139 (let ((argument (match-string 0 args)))
1140 (cond ((string= argument "&rest")
1141 ;; All the rest arguments are the same.
1142 (setq index 1))
1143 ((string= argument "&optional")) ; Skip.
1144 ((string= argument "&allow-other-keys")) ; Skip.
1145 ;; Back to index 0 in ARG1 ARG2 ARG2 ARG3 etc...
1146 ;; like in `setq'.
1147 ((or (and (string-match-p "\\.\\.\\.$" argument)
1148 (string= argument (car (last args-lst))))
1149 (and (string-match-p "\\.\\.\\.$"
1150 (substring args 1 (1- (length args))))
1151 (= (length (remove "..." args-lst)) 2)
1152 (> index 1) (eq (logand index 1) 1)))
1153 (setq index 0))
1154 (t
1155 (setq index (1- index))))))
1156 (setq end (length args)
1157 start (1- end)
1158 argument-face 'font-lock-warning-face
1159 index 0)))
1160 (let ((doc args))
1161 (when start
1162 (setq doc (copy-sequence args))
1163 (add-text-properties start end (list 'face argument-face) doc))
1164 (setq doc (elisp--docstring-format-sym-doc
1165 sym doc (if (functionp sym) 'font-lock-function-name-face
1166 'font-lock-keyword-face)))
1167 doc)))
1168
1169;; Return a string containing a brief (one-line) documentation string for
1170;; the variable.
1171(defun elisp--get-var-docstring (sym)
1172 (cond ((not sym) nil)
1173 ((and (eq sym (aref elisp--eldoc-last-data 0))
1174 (eq 'variable (aref elisp--eldoc-last-data 2)))
1175 (aref elisp--eldoc-last-data 1))
1176 (t
1177 (let ((doc (documentation-property sym 'variable-documentation t)))
1178 (when doc
1179 (let ((doc (elisp--docstring-format-sym-doc
1180 sym (elisp--docstring-first-line doc)
1181 'font-lock-variable-name-face)))
1182 (elisp--last-data-store sym doc 'variable)))))))
1183
1184(defun elisp--last-data-store (symbol doc type)
1185 (aset elisp--eldoc-last-data 0 symbol)
1186 (aset elisp--eldoc-last-data 1 doc)
1187 (aset elisp--eldoc-last-data 2 type)
1188 doc)
1189
1190;; Note that any leading `*' in the docstring (which indicates the variable
1191;; is a user option) is removed.
1192(defun elisp--docstring-first-line (doc)
1193 (and (stringp doc)
1194 (substitute-command-keys
1195 (save-match-data
1196 ;; Don't use "^" in the regexp below since it may match
1197 ;; anywhere in the doc-string.
1198 (let ((start (if (string-match "\\`\\*" doc) (match-end 0) 0)))
1199 (cond ((string-match "\n" doc)
1200 (substring doc start (match-beginning 0)))
1201 ((zerop start) doc)
1202 (t (substring doc start))))))))
1203
1204(defvar eldoc-echo-area-use-multiline-p)
1205
1206;; If the entire line cannot fit in the echo area, the symbol name may be
1207;; truncated or eliminated entirely from the output to make room for the
1208;; description.
1209(defun elisp--docstring-format-sym-doc (sym doc face)
1210 (save-match-data
1211 (let* ((name (symbol-name sym))
1212 (ea-multi eldoc-echo-area-use-multiline-p)
1213 ;; Subtract 1 from window width since emacs will not write
1214 ;; any chars to the last column, or in later versions, will
1215 ;; cause a wraparound and resize of the echo area.
1216 (ea-width (1- (window-width (minibuffer-window))))
1217 (strip (- (+ (length name) (length ": ") (length doc)) ea-width)))
1218 (cond ((or (<= strip 0)
1219 (eq ea-multi t)
1220 (and ea-multi (> (length doc) ea-width)))
1221 (format "%s: %s" (propertize name 'face face) doc))
1222 ((> (length doc) ea-width)
1223 (substring (format "%s" doc) 0 ea-width))
1224 ((>= strip (length name))
1225 (format "%s" doc))
1226 (t
1227 ;; Show the end of the partial symbol name, rather
1228 ;; than the beginning, since the former is more likely
1229 ;; to be unique given package namespace conventions.
1230 (setq name (substring name strip))
1231 (format "%s: %s" (propertize name 'face face) doc))))))
1232
1233
1234;; Return a list of current function name and argument index.
1235(defun elisp--fnsym-in-current-sexp ()
1236 (save-excursion
1237 (let ((argument-index (1- (elisp--beginning-of-sexp))))
1238 ;; If we are at the beginning of function name, this will be -1.
1239 (when (< argument-index 0)
1240 (setq argument-index 0))
1241 ;; Don't do anything if current word is inside a string.
1242 (if (= (or (char-after (1- (point))) 0) ?\")
1243 nil
1244 (list (elisp--current-symbol) argument-index)))))
1245
1246;; Move to the beginning of current sexp. Return the number of nested
1247;; sexp the point was over or after.
1248(defun elisp--beginning-of-sexp ()
1249 (let ((parse-sexp-ignore-comments t)
1250 (num-skipped-sexps 0))
1251 (condition-case _
1252 (progn
1253 ;; First account for the case the point is directly over a
1254 ;; beginning of a nested sexp.
1255 (condition-case _
1256 (let ((p (point)))
1257 (forward-sexp -1)
1258 (forward-sexp 1)
1259 (when (< (point) p)
1260 (setq num-skipped-sexps 1)))
1261 (error))
1262 (while
1263 (let ((p (point)))
1264 (forward-sexp -1)
1265 (when (< (point) p)
1266 (setq num-skipped-sexps (1+ num-skipped-sexps))))))
1267 (error))
1268 num-skipped-sexps))
1269
1270;; returns nil unless current word is an interned symbol.
1271(defun elisp--current-symbol ()
1272 (let ((c (char-after (point))))
1273 (and c
1274 (memq (char-syntax c) '(?w ?_))
1275 (intern-soft (current-word)))))
1276
1277(defun elisp--function-argstring (arglist)
1278 "Return ARGLIST as a string enclosed by ().
1279ARGLIST is either a string, or a list of strings or symbols."
1280 (let ((str (cond ((stringp arglist) arglist)
1281 ((not (listp arglist)) nil)
1282 (t (format "%S" (help-make-usage 'toto arglist))))))
1283 (if (and str (string-match "\\`([^ )]+ ?" str))
1284 (replace-match "(" t t str)
1285 str)))
1286
1287(provide 'elisp-mode)
1288;;; elisp-mode.el ends here
diff --git a/lisp/simple.el b/lisp/simple.el
index 6395e5036a9..24f8ae9ac76 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1394,8 +1394,11 @@ display the result of expression evaluation."
1394 (let ((minibuffer-completing-symbol t)) 1394 (let ((minibuffer-completing-symbol t))
1395 (minibuffer-with-setup-hook 1395 (minibuffer-with-setup-hook
1396 (lambda () 1396 (lambda ()
1397 ;; FIXME: call emacs-lisp-mode?
1398 (setq-local eldoc-documentation-function
1399 #'elisp-eldoc-documentation-function)
1397 (add-hook 'completion-at-point-functions 1400 (add-hook 'completion-at-point-functions
1398 #'lisp-completion-at-point nil t) 1401 #'elisp-completion-at-point nil t)
1399 (run-hooks 'eval-expression-minibuffer-setup-hook)) 1402 (run-hooks 'eval-expression-minibuffer-setup-hook))
1400 (read-from-minibuffer prompt initial-contents 1403 (read-from-minibuffer prompt initial-contents
1401 read-expression-map t 1404 read-expression-map t
diff --git a/src/ChangeLog b/src/ChangeLog
index b866977a7ce..3afd5ee6e20 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,7 @@
12014-09-27 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * lisp.mk (lisp): Add elisp-mode.elc.
4
12014-09-26 Paul Eggert <eggert@cs.ucla.edu> 52014-09-26 Paul Eggert <eggert@cs.ucla.edu>
2 6
3 * xfns.c (x_default_scroll_bar_color_parameter): 7 * xfns.c (x_default_scroll_bar_color_parameter):
diff --git a/src/lisp.mk b/src/lisp.mk
index 59d5b86c33a..e9783f649be 100644
--- a/src/lisp.mk
+++ b/src/lisp.mk
@@ -132,6 +132,7 @@ lisp = \
132 $(lispsource)/textmodes/paragraphs.elc \ 132 $(lispsource)/textmodes/paragraphs.elc \
133 $(lispsource)/progmodes/prog-mode.elc \ 133 $(lispsource)/progmodes/prog-mode.elc \
134 $(lispsource)/emacs-lisp/lisp-mode.elc \ 134 $(lispsource)/emacs-lisp/lisp-mode.elc \
135 $(lispsource)/progmodes/elisp-mode.elc \
135 $(lispsource)/textmodes/text-mode.elc \ 136 $(lispsource)/textmodes/text-mode.elc \
136 $(lispsource)/textmodes/fill.elc \ 137 $(lispsource)/textmodes/fill.elc \
137 $(lispsource)/newcomment.elc \ 138 $(lispsource)/newcomment.elc \