[Emacs-diffs] master 267be4b 1/2: Refactor lisp eval result printing

[Noam Postavsky]

branch: master
commit 267be4bdc28564a99f45da29e84eb98838117b50
Author: Noam Postavsky <address@hidden>
Commit: Noam Postavsky <address@hidden>

    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 53a0f66..c2fdba4 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -1119,29 +1119,28 @@ current buffer.  If EVAL-LAST-SEXP-ARG-INTERNAL is `0', 
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)))
+  (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 7f13df5..3af6265 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1456,16 +1456,14 @@ This string will typically look like \" (#o1, #x1, 
?\\C-a)\".
 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.")
@@ -1484,9 +1482,21 @@ result of expression evaluation."
                             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'.
@@ -1507,8 +1517,8 @@ minibuffer.
 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)
@@ -1523,23 +1533,15 @@ this command arranges for all errors to enter the 
debugger."
       (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 93c428b..5edb590 100644
--- a/test/lisp/progmodes/elisp-mode-tests.el
+++ b/test/lisp/progmodes/elisp-mode-tests.el
@@ -114,6 +114,24 @@
       (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 f4849c4..b74e28c 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 @@
              (buffer-substring (point) (point-max))))))
 
 
+
+;;; `transpose-sexps'
 (defmacro simple-test--transpositions (&rest body)
   (declare (indent 0)
            (debug t))
@@ -46,6 +49,13 @@
      (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 @@
       (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 @@
      (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 @@ See Bug#21722."
        (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