-(defvar lisp-interaction-mode-map
- (let ((map (make-sparse-keymap))
- (menu-map (make-sparse-keymap "Lisp-Interaction")))
- (set-keymap-parent map lisp-mode-shared-map)
- (define-key map "\e\C-x" 'eval-defun)
- (define-key map "\e\C-q" 'indent-pp-sexp)
- (define-key map "\e\t" 'completion-at-point)
- (define-key map "\n" 'eval-print-last-sexp)
- (bindings--define-key map [menu-bar lisp-interaction]
- (cons "Lisp-Interaction" menu-map))
- (bindings--define-key menu-map [eval-defun]
- '(menu-item "Evaluate Defun" eval-defun
- :help "Evaluate the top-level form containing point, or after point"))
- (bindings--define-key menu-map [eval-print-last-sexp]
- '(menu-item "Evaluate and Print" eval-print-last-sexp
- :help "Evaluate sexp before point; print value into current buffer"))
- (bindings--define-key menu-map [edebug-defun-lisp-interaction]
- '(menu-item "Instrument Function for Debugging" edebug-defun
- :help "Evaluate the top level form point is in, stepping through with Edebug"
- :keys "C-u C-M-x"))
- (bindings--define-key menu-map [indent-pp-sexp]
- '(menu-item "Indent or Pretty-Print" indent-pp-sexp
- :help "Indent each line of the list starting just after point, or prettyprint it"))
- (bindings--define-key menu-map [complete-symbol]
- '(menu-item "Complete Lisp Symbol" completion-at-point
- :help "Perform completion on Lisp symbol preceding point"))
- map)
- "Keymap for Lisp Interaction mode.
-All commands in `lisp-mode-shared-map' are inherited by this map.")
-
-(define-derived-mode lisp-interaction-mode emacs-lisp-mode "Lisp Interaction"
- "Major mode for typing and evaluating Lisp forms.
-Like Lisp mode except that \\[eval-print-last-sexp] evals the Lisp expression
-before point, and prints its value into the buffer, advancing point.
-Note that printing is controlled by `eval-expression-print-length'
-and `eval-expression-print-level'.
-
-Commands:
-Delete converts tabs to spaces as it moves back.
-Paragraphs are separated only by blank lines.
-Semicolons start comments.
-
-\\{lisp-interaction-mode-map}"
- :abbrev-table nil)
-
-(defun eval-print-last-sexp (&optional eval-last-sexp-arg-internal)
- "Evaluate sexp before point; print value into current buffer.
-
-Normally, this function truncates long output according to the value
-of the variables `eval-expression-print-length' and
-`eval-expression-print-level'. With a prefix argument of zero,
-however, there is no such truncation. Such a prefix argument
-also causes integers to be printed in several additional formats
-\(octal, hexadecimal, and character).
-
-If `eval-expression-debug-on-error' is non-nil, which is the default,
-this command arranges for all errors to enter the debugger."
- (interactive "P")
- (let ((standard-output (current-buffer)))
- (terpri)
- (eval-last-sexp (or eval-last-sexp-arg-internal t))
- (terpri)))
-
-
-(defun last-sexp-setup-props (beg end value alt1 alt2)
- "Set up text properties for the output of `eval-last-sexp-1'.
-BEG and END are the start and end of the output in current-buffer.
-VALUE is the Lisp value printed, ALT1 and ALT2 are strings for the
-alternative printed representations that can be displayed."
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-m" 'last-sexp-toggle-display)
- (define-key map [down-mouse-2] 'mouse-set-point)
- (define-key map [mouse-2] 'last-sexp-toggle-display)
- (add-text-properties
- beg end
- `(printed-value (,value ,alt1 ,alt2)
- mouse-face highlight
- keymap ,map
- help-echo "RET, mouse-2: toggle abbreviated display"
- rear-nonsticky (mouse-face keymap help-echo
- printed-value)))))
-
-
-(defun last-sexp-toggle-display (&optional _arg)
- "Toggle between abbreviated and unabbreviated printed representations."
- (interactive "P")
- (save-restriction
- (widen)
- (let ((value (get-text-property (point) 'printed-value)))
- (when value
- (let ((beg (or (previous-single-property-change (min (point-max) (1+ (point)))
- 'printed-value)
- (point)))
- (end (or (next-single-char-property-change (point) 'printed-value) (point)))
- (standard-output (current-buffer))
- (point (point)))
- (delete-region beg end)
- (insert (nth 1 value))
- (or (= beg point)
- (setq point (1- (point))))
- (last-sexp-setup-props beg (point)
- (nth 0 value)
- (nth 2 value)
- (nth 1 value))
- (goto-char (min (point-max) point)))))))
-
-(defun prin1-char (char)
- "Return a string representing CHAR as a character rather than as an integer.
-If CHAR is not a character, return nil."
- (and (integerp char)
- (eventp char)
- (let ((c (event-basic-type char))
- (mods (event-modifiers char))
- string)
- ;; Prevent ?A from turning into ?\S-a.
- (if (and (memq 'shift mods)
- (zerop (logand char ?\S-\^@))
- (not (let ((case-fold-search nil))
- (char-equal c (upcase c)))))
- (setq c (upcase c) mods nil))
- ;; What string are we considering using?
- (condition-case nil
- (setq string
- (concat
- "?"
- (mapconcat
- (lambda (modif)
- (cond ((eq modif 'super) "\\s-")
- (t (string ?\\ (upcase (aref (symbol-name modif) 0)) ?-))))
- mods "")
- (cond
- ((memq c '(?\; ?\( ?\) ?\{ ?\} ?\[ ?\] ?\" ?\' ?\\)) (string ?\\ c))
- ((eq c 127) "\\C-?")
- (t
- (string c)))))
- (error nil))
- ;; Verify the string reads a CHAR, not to some other character.
- ;; If it doesn't, return nil instead.
- (and string
- (= (car (read-from-string string)) char)
- string))))
-
-
-(defun preceding-sexp ()
- "Return sexp before the point."
- (let ((opoint (point))
- ignore-quotes
- expr)
- (save-excursion
- (with-syntax-table emacs-lisp-mode-syntax-table
- ;; If this sexp appears to be enclosed in `...'
- ;; then ignore the surrounding quotes.
- (setq ignore-quotes
- (or (eq (following-char) ?\')
- (eq (preceding-char) ?\')))
- (forward-sexp -1)
- ;; If we were after `?\e' (or similar case),
- ;; use the whole thing, not just the `e'.
- (when (eq (preceding-char) ?\\)
- (forward-char -1)
- (when (eq (preceding-char) ??)
- (forward-char -1)))
-
- ;; Skip over hash table read syntax.
- (and (> (point) (1+ (point-min)))
- (looking-back "#s" (- (point) 2))
- (forward-char -2))
-
- ;; Skip over `#N='s.
- (when (eq (preceding-char) ?=)
- (let (labeled-p)
- (save-excursion
- (skip-chars-backward "0-9#=")
- (setq labeled-p (looking-at "\\(#[0-9]+=\\)+")))
- (when labeled-p
- (forward-sexp -1))))
-
- (save-restriction
- ;; vladimir@cs.ualberta.ca 30-Jul-1997: skip ` in
- ;; `variable' so that the value is returned, not the
- ;; name
- (if (and ignore-quotes
- (eq (following-char) ?`))
- (forward-char))
- (narrow-to-region (point-min) opoint)
- (setq expr (read (current-buffer)))
- ;; If it's an (interactive ...) form, it's more
- ;; useful to show how an interactive call would
- ;; use it.
- (and (consp expr)
- (eq (car expr) 'interactive)
- (setq expr
- (list 'call-interactively
- (list 'quote
- (list 'lambda
- '(&rest args)
- expr
- 'args)))))
- expr)))))
-
-
-(defun eval-last-sexp-1 (eval-last-sexp-arg-internal)
- "Evaluate sexp before point; print value in the echo area.
-With argument, print output into current buffer.
-With a zero prefix arg, print output with no limit on the length
-and level of lists, and include additional formats for integers
-\(octal, hexadecimal, and character)."
- (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t)))
- ;; Setup the lexical environment if lexical-binding is enabled.
- (eval-last-sexp-print-value
- (eval (eval-sexp-add-defvars (preceding-sexp)) lexical-binding)
- eval-last-sexp-arg-internal)))
-
-
-(defun eval-last-sexp-print-value (value &optional eval-last-sexp-arg-internal)
- (let ((unabbreviated (let ((print-length nil) (print-level nil))
- (prin1-to-string value)))
- (print-length (and (not (zerop (prefix-numeric-value
- eval-last-sexp-arg-internal)))
- eval-expression-print-length))
- (print-level (and (not (zerop (prefix-numeric-value
- eval-last-sexp-arg-internal)))
- eval-expression-print-level))
- (beg (point))
- end)
- (prog1
- (prin1 value)
- (let ((str (eval-expression-print-format value)))
- (if str (princ str)))
- (setq end (point))
- (when (and (bufferp standard-output)
- (or (not (null print-length))
- (not (null print-level)))
- (not (string= unabbreviated
- (buffer-substring-no-properties beg end))))
- (last-sexp-setup-props beg end value
- unabbreviated
- (buffer-substring-no-properties beg end))
- ))))
-
-
-(defvar eval-last-sexp-fake-value (make-symbol "t"))
-
-(defun eval-sexp-add-defvars (exp &optional pos)
- "Prepend EXP with all the `defvar's that precede it in the buffer.
-POS specifies the starting position where EXP was found and defaults to point."
- (setq exp (macroexpand-all exp)) ;Eager macro-expansion.
- (if (not lexical-binding)
- exp
- (save-excursion
- (unless pos (setq pos (point)))
- (let ((vars ()))
- (goto-char (point-min))
- (while (re-search-forward
- "(def\\(?:var\\|const\\|custom\\)[ \t\n]+\\([^; '()\n\t]+\\)"
- pos t)
- (let ((var (intern (match-string 1))))
- (and (not (special-variable-p var))
- (save-excursion
- (zerop (car (syntax-ppss (match-beginning 0)))))
- (push var vars))))
- `(progn ,@(mapcar (lambda (v) `(defvar ,v)) vars) ,exp)))))
-
-(defun eval-last-sexp (eval-last-sexp-arg-internal)
- "Evaluate sexp before point; print value in the echo area.
-Interactively, with prefix argument, print output into current buffer.
-
-Normally, this function truncates long output according to the value
-of the variables `eval-expression-print-length' and
-`eval-expression-print-level'. With a prefix argument of zero,
-however, there is no such truncation. Such a prefix argument
-also causes integers to be printed in several additional formats
-\(octal, hexadecimal, and character).
-
-If `eval-expression-debug-on-error' is non-nil, which is the default,
-this command arranges for all errors to enter the debugger."
- (interactive "P")
- (if (null eval-expression-debug-on-error)
- (eval-last-sexp-1 eval-last-sexp-arg-internal)
- (let ((value
- (let ((debug-on-error eval-last-sexp-fake-value))
- (cons (eval-last-sexp-1 eval-last-sexp-arg-internal)
- debug-on-error))))
- (unless (eq (cdr value) eval-last-sexp-fake-value)
- (setq debug-on-error (cdr value)))
- (car value))))
-
-(defun eval-defun-1 (form)
- "Treat some expressions specially.
-Reset the `defvar' and `defcustom' variables to the initial value.
-\(For `defcustom', use the :set function if there is one.)
-Reinitialize the face according to the `defface' specification."
- ;; The code in edebug-defun should be consistent with this, but not
- ;; the same, since this gets a macroexpanded form.
- (cond ((not (listp form))
- form)
- ((and (eq (car form) 'defvar)
- (cdr-safe (cdr-safe form))
- (boundp (cadr form)))
- ;; Force variable to be re-set.
- `(progn (defvar ,(nth 1 form) nil ,@(nthcdr 3 form))
- (setq-default ,(nth 1 form) ,(nth 2 form))))
- ;; `defcustom' is now macroexpanded to
- ;; `custom-declare-variable' with a quoted value arg.
- ((and (eq (car form) 'custom-declare-variable)
- (default-boundp (eval (nth 1 form) lexical-binding)))
- ;; Force variable to be bound, using :set function if specified.
- (let ((setfunc (memq :set form)))
- (when setfunc
- (setq setfunc (car-safe (cdr-safe setfunc)))
- (or (functionp setfunc) (setq setfunc nil)))
- (funcall (or setfunc 'set-default)
- (eval (nth 1 form) lexical-binding)
- ;; The second arg is an expression that evaluates to
- ;; an expression. The second evaluation is the one
- ;; normally performed not by normal execution but by
- ;; custom-initialize-set (for example), which does not
- ;; use lexical-binding.
- (eval (eval (nth 2 form) lexical-binding))))
- form)
- ;; `defface' is macroexpanded to `custom-declare-face'.
- ((eq (car form) 'custom-declare-face)
- ;; Reset the face.
- (let ((face-symbol (eval (nth 1 form) lexical-binding)))
- (setq face-new-frame-defaults
- (assq-delete-all face-symbol face-new-frame-defaults))
- (put face-symbol 'face-defface-spec nil)
- (put face-symbol 'face-override-spec nil))
- form)
- ((eq (car form) 'progn)
- (cons 'progn (mapcar 'eval-defun-1 (cdr form))))
- (t form)))
-
-(defun eval-defun-2 ()
- "Evaluate defun that point is in or before.
-The value is displayed in the echo area.
-If the current defun is actually a call to `defvar',
-then reset the variable using the initial value expression
-even if the variable already has some other value.
-\(Normally `defvar' does not change the variable's value
-if it already has a value.\)
-
-Return the result of evaluation."
- ;; FIXME: the print-length/level bindings should only be applied while
- ;; printing, not while evaluating.
- (let ((debug-on-error eval-expression-debug-on-error)
- (print-length eval-expression-print-length)
- (print-level eval-expression-print-level))
- (save-excursion
- ;; Arrange for eval-region to "read" the (possibly) altered form.
- ;; eval-region handles recording which file defines a function or
- ;; variable.
- (let ((standard-output t)
- beg end form)
- ;; Read the form from the buffer, and record where it ends.
- (save-excursion
- (end-of-defun)
- (beginning-of-defun)
- (setq beg (point))
- (setq form (read (current-buffer)))
- (setq end (point)))
- ;; Alter the form if necessary.
- (let ((form (eval-sexp-add-defvars
- (eval-defun-1 (macroexpand form)))))
- (eval-region beg end standard-output
- (lambda (_ignore)
- ;; Skipping to the end of the specified region
- ;; will make eval-region return.
- (goto-char end)
- form))))))
- (let ((str (eval-expression-print-format (car values))))
- (if str (princ str)))
- ;; The result of evaluation has been put onto VALUES. So return it.
- (car values))
-
-(defun eval-defun (edebug-it)
- "Evaluate the top-level form containing point, or after point.
-
-If the current defun is actually a call to `defvar' or `defcustom',
-evaluating it this way resets the variable using its initial value
-expression (using the defcustom's :set function if there is one), even
-if the variable already has some other value. \(Normally `defvar' and
-`defcustom' do not alter the value if there already is one.) In an
-analogous way, evaluating a `defface' overrides any customizations of
-the face, so that it becomes defined exactly as the `defface' expression
-says.
-
-If `eval-expression-debug-on-error' is non-nil, which is the default,
-this command arranges for all errors to enter the debugger.
-
-With a prefix argument, instrument the code for Edebug.
-
-If acting on a `defun' for FUNCTION, and the function was
-instrumented, `Edebug: FUNCTION' is printed in the echo area. If not
-instrumented, just FUNCTION is printed.
-
-If not acting on a `defun', the result of evaluation is displayed in
-the echo area. This display is controlled by the variables
-`eval-expression-print-length' and `eval-expression-print-level',
-which see."
- (interactive "P")
- (cond (edebug-it
- (require 'edebug)
- (eval-defun (not edebug-all-defs)))
- (t
- (if (null eval-expression-debug-on-error)
- (eval-defun-2)
- (let ((old-value (make-symbol "t")) new-value value)
- (let ((debug-on-error old-value))
- (setq value (eval-defun-2))
- (setq new-value debug-on-error))
- (unless (eq old-value new-value)
- (setq debug-on-error new-value))
- value)))))
-