>From f5ebfc7e1d352e63794264cf971993c5c0d564b2 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sun, 23 Apr 2017 22:21:42 -0400 Subject: [PATCH v2 1/2] Refactor lisp eval result printing * lisp/simple.el (eval-expression-print-format): Don't check `standard-output' or `current-prefix-arg'. (eval-expression-get-print-arguments): New function, centralizes decision about how to print results of `eval-expression' and `eval-last-sexp'. (eval-expression): * lisp/progmodes/elisp-mode.el (elisp--eval-last-sexp-print-value): Use it. --- lisp/progmodes/elisp-mode.el | 35 ++++++++++---------- lisp/simple.el | 58 +++++++++++++++++---------------- test/lisp/progmodes/elisp-mode-tests.el | 18 ++++++++++ test/lisp/simple-tests.el | 42 ++++++++++++++++++------ 4 files changed, 97 insertions(+), 56 deletions(-) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 53a0f66439..c2fdba47a0 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -1119,29 +1119,28 @@ elisp--eval-last-sexp 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 diff --git a/lisp/simple.el b/lisp/simple.el index 082406bdc4..68208118f1 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1460,16 +1460,14 @@ eval-expression-print-format 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.") @@ -1488,9 +1486,21 @@ read--expression 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'. @@ -1511,8 +1521,8 @@ eval-expression 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) @@ -1527,23 +1537,15 @@ eval-expression (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. diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el index 93c428b2d2..5edb590b1e 100644 --- a/test/lisp/progmodes/elisp-mode-tests.el +++ b/test/lisp/progmodes/elisp-mode-tests.el @@ -114,6 +114,24 @@ elisp--test-completions (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) diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el index f4849c4b21..b74e28ccaf 100644 --- a/test/lisp/simple-tests.el +++ b/test/lisp/simple-tests.el @@ -20,6 +20,7 @@ ;;; Code: (require 'ert) +(eval-when-compile (require 'cl-lib)) (defmacro simple-test--dummy-buffer (&rest body) (declare (indent 0) @@ -35,6 +36,8 @@ simple-test--dummy-buffer (buffer-substring (point) (point-max)))))) + +;;; `transpose-sexps' (defmacro simple-test--transpositions (&rest body) (declare (indent 0) (debug t)) @@ -46,6 +49,13 @@ simple-test--transpositions (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)")))) + ;;; `newline' (ert-deftest newline () @@ -239,8 +249,8 @@ simple-test--transpositions (should (equal ?\s (char-syntax ?\f))) (should (equal ?\s (char-syntax ?\n)))))) - -;;; auto-boundary tests + +;;; undo auto-boundary tests (ert-deftest undo-auto-boundary-timer () (should undo-auto-current-boundary-timer)) @@ -269,14 +279,6 @@ simple-test--transpositions (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 () @@ -374,5 +376,25 @@ simple-test-undo-with-switched-buffer (undo) (point))))) + +;;; `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 -- 2.11.1