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)))
+ (pcase-let*
+ ((`(,insert-value ,no-truncate ,char-print)
+ (eval-expression-get-print-arguments eval-last-sexp-arg-internal)))
;; Setup the lexical environment if lexical-binding is enabled.
(elisp--eval-last-sexp-print-value
(eval (eval-sexp-add-defvars (elisp--preceding-sexp)) lexical-binding)
- eval-last-sexp-arg-internal)))
-
-(defun elisp--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)
+ (if insert-value (current-buffer) t) no-truncate char-print)))
+
+(defun elisp--eval-last-sexp-print-value
+ (value output &optional no-truncate char-print)
+ (let* ((unabbreviated (let ((print-length nil) (print-level nil))
+ (prin1-to-string value)))
+ (print-length (unless no-truncate eval-expression-print-length))
+ (print-level (unless no-truncate eval-expression-print-level))
+ (beg (point))
+ end)
(prog1
- (prin1 value)
- (let ((str (eval-expression-print-format value)))
- (if str (princ str)))
+ (prin1 value output)
+ (let ((str (and char-print (eval-expression-print-format value))))
+ (if str (princ str output)))
(setq end (point))
- (when (and (bufferp standard-output)
+ (when (and (bufferp output)
(or (not (null print-length))
(not (null print-level)))
(not (string= unabbreviated
If VALUE is not an integer, nil is returned.
This function is used by functions like `prin1' that display the
result of expression evaluation."
- (if (and (integerp value)
- (or (eq standard-output t)
- (zerop (prefix-numeric-value current-prefix-arg))))
- (let ((char-string
- (if (and (characterp value)
- (char-displayable-p value))
- (prin1-char value))))
- (if char-string
- (format " (#o%o, #x%x, %s)" value value char-string)
- (format " (#o%o, #x%x)" value value)))))
+ (when (integerp value)
+ (let ((char-string
+ (and (characterp value)
+ (char-displayable-p value)
+ (prin1-char value))))
+ (if char-string
+ (format " (#o%o, #x%x, %s)" value value char-string)
+ (format " (#o%o, #x%x)" value value)))))
(defvar eval-expression-minibuffer-setup-hook nil
"Hook run by `eval-expression' when entering the minibuffer.")
read-expression-map t
'read-expression-history))))
+(defun eval-expression-get-print-arguments (prefix-argument)
+ "Get arguments for commands that print an expression result.
+Returns a list (INSERT-VALUE NO-TRUNCATE CHAR-PRINT)
+based on PREFIX-ARG. This function determines the interpretation
+of the prefix argument for `eval-expression' and
+`eval-last-sexp'."
+ (let ((num (prefix-numeric-value prefix-argument)))
+ (list (not (memq prefix-argument '(nil)))
+ (= num 0)
+ (cond ((not (memq prefix-argument '(0 nil))) nil)
+ (t t)))))
+
;; We define this, rather than making `eval' interactive,
;; for the sake of completion of names like eval-region, eval-buffer.
-(defun eval-expression (exp &optional insert-value)
+(defun eval-expression (exp &optional insert-value no-truncate char-print)
"Evaluate EXP and print value in the echo area.
When called interactively, read an Emacs Lisp expression and evaluate it.
Value is also consed on to front of the variable `values'.
If `eval-expression-debug-on-error' is non-nil, which is the default,
this command arranges for all errors to enter the debugger."
(interactive
- (list (read--expression "Eval: ")
- current-prefix-arg))
+ (cons (read--expression "Eval: ")
+ (eval-expression-get-print-arguments current-prefix-arg)))
(if (null eval-expression-debug-on-error)
(push (eval exp lexical-binding) values)
(unless (eq old-value new-value)
(setq debug-on-error new-value))))
- (let ((print-length (and (not (zerop (prefix-numeric-value insert-value)))
- eval-expression-print-length))
- (print-level (and (not (zerop (prefix-numeric-value insert-value)))
- eval-expression-print-level))
+ (let ((print-length (unless no-truncate eval-expression-print-length))
+ (print-level (unless no-truncate eval-expression-print-level))
(deactivate-mark))
- (if insert-value
- (with-no-warnings
- (let ((standard-output (current-buffer)))
- (prog1
- (prin1 (car values))
- (when (zerop (prefix-numeric-value insert-value))
- (let ((str (eval-expression-print-format (car values))))
- (if str (princ str)))))))
+ (let ((out (if insert-value (current-buffer) t)))
(prog1
- (prin1 (car values) t)
- (let ((str (eval-expression-print-format (car values))))
- (if str (princ str t)))))))
+ (prin1 (car values) out)
+ (let ((str (and char-print
+ (eval-expression-print-format (car values)))))
+ (when str (princ str out)))))))
(defun edit-and-eval-command (prompt command)
"Prompting with PROMPT, let user edit COMMAND and eval result.
(should (member "backup-buffer" comps))
(should-not (member "backup-inhibited" comps)))))
+;;; eval-last-sexp
+
+(ert-deftest eval-last-sexp-print-format-sym ()
+ (with-temp-buffer
+ (let ((current-prefix-arg '(4)))
+ (erase-buffer) (insert "t")
+ (call-interactively #'eval-last-sexp)
+ (should (equal (buffer-string) "tt")))))
+
+(ert-deftest eval-last-sexp-print-format-sym-echo ()
+ ;; We can only check the echo area when running interactive.
+ (skip-unless (not noninteractive))
+ (with-temp-buffer
+ (let ((current-prefix-arg nil))
+ (erase-buffer) (insert "t") (message nil)
+ (call-interactively #'eval-last-sexp)
+ (should (equal (current-message) "t")))))
+
;;; xref
(defun xref-elisp-test-descr-to-target (xref)
;;; Code:
(require 'ert)
+(eval-when-compile (require 'cl-lib))
(defmacro simple-test--dummy-buffer (&rest body)
(declare (indent 0)
(buffer-substring (point) (point-max))))))
+\f
+;;; `transpose-sexps'
(defmacro simple-test--transpositions (&rest body)
(declare (indent 0)
(debug t))
(cons (buffer-substring (point-min) (point))
(buffer-substring (point) (point-max)))))
+;;; Transposition with negative args (bug#20698, bug#21885)
+(ert-deftest simple-transpose-subr ()
+ (should (equal (simple-test--transpositions (transpose-sexps -1))
+ '("(s1) (s2) (s4)" . " (s3) (s5)")))
+ (should (equal (simple-test--transpositions (transpose-sexps -2))
+ '("(s1) (s4)" . " (s2) (s3) (s5)"))))
+
\f
;;; `newline'
(ert-deftest newline ()
(should (equal ?\s (char-syntax ?\f)))
(should (equal ?\s (char-syntax ?\n))))))
-
-;;; auto-boundary tests
+\f
+;;; undo auto-boundary tests
(ert-deftest undo-auto-boundary-timer ()
(should
undo-auto-current-boundary-timer))
(insert "hello")
(undo-auto--boundaries 'test))))
-;;; Transposition with negative args (bug#20698, bug#21885)
-(ert-deftest simple-transpose-subr ()
- (should (equal (simple-test--transpositions (transpose-sexps -1))
- '("(s1) (s2) (s4)" . " (s3) (s5)")))
- (should (equal (simple-test--transpositions (transpose-sexps -2))
- '("(s1) (s4)" . " (s2) (s3) (s5)"))))
-
-
;; Test for a regression introduced by undo-auto--boundaries changes.
;; https://lists.gnu.org/archive/html/emacs-devel/2015-11/msg01652.html
(defun undo-test-kill-c-a-then-undo ()
(undo)
(point)))))
+\f
+;;; `eval-expression'
+
+(ert-deftest eval-expression-print-format-sym ()
+ (with-temp-buffer
+ (cl-letf (((symbol-function 'read--expression) (lambda (&rest _) t)))
+ (let ((current-prefix-arg '(4)))
+ (call-interactively #'eval-expression)
+ (should (equal (buffer-string) "t"))))))
+
+(ert-deftest eval-expression-print-format-sym-echo ()
+ ;; We can only check the echo area when running interactive.
+ (skip-unless (not noninteractive))
+ (with-temp-buffer
+ (cl-letf (((symbol-function 'read--expression) (lambda (&rest _) t)))
+ (let ((current-prefix-arg nil))
+ (message nil)
+ (call-interactively #'eval-expression)
+ (should (equal (current-message) "t"))))))
+
(provide 'simple-test)
;;; simple-test.el ends here
projects / emacs.git / commitdiff