branch: elpa/slime
commit b12b5e0232ad5bee38584d684cc2d6bffd08c260
Author: Stas Boukarev <stass...@gmail.com>
Commit: Stas Boukarev <stass...@gmail.com>
Cut output when displaying in the minibuffer.
Fixes #803
---
slime.el | 20 ++++++++++++---
swank.lisp | 85 +++++++++++++++++++++++++++++++++++++++++++-------------------
2 files changed, 75 insertions(+), 30 deletions(-)
diff --git a/slime.el b/slime.el
index 53f3a50f8d..bc4a111151 100644
--- a/slime.el
+++ b/slime.el
@@ -4059,7 +4059,11 @@ inserted in the current buffer."
(interactive (list (slime-read-from-minibuffer "Slime Eval: ")))
(cl-case current-prefix-arg
((nil)
- (slime-eval-with-transcript `(swank:interactive-eval ,string)))
+ (slime-eval-with-transcript `(swank:interactive-eval ,string
+ ,(if
resize-mini-windows
+ (truncate
(max-mini-window-lines))
+ 1)
+ ,(window-width))))
((-)
(slime-eval-save string))
(t
@@ -4145,7 +4149,11 @@ Use `slime-re-evaluate-defvar' if the from starts with
'(defvar'"
(interactive "r")
(slime-eval-with-transcript
`(swank:interactive-eval-region
- ,(buffer-substring-no-properties start end))))
+ ,(buffer-substring-no-properties start end)
+ ,(if resize-mini-windows
+ (truncate (max-mini-window-lines))
+ 1)
+ ,(window-width))))
(defun slime-pprint-eval-region (start end)
"Evaluate region; pprint the value in a buffer."
@@ -5899,7 +5907,7 @@ VAR should be a plist with the keys :name, :id, and
:value."
(defun sldb-eval-in-frame (frame string package)
"Prompt for an expression and evaluate it in the selected frame."
(interactive (sldb-read-form-for-frame "Eval in frame (%s)> "))
- (slime-eval-async `(swank:eval-string-in-frame ,string ,frame ,package)
+ (slime-eval-async `(swank:eval-string-in-frame ,string ,frame ,package )
(if current-prefix-arg
'slime-write-string
'slime-display-eval-result)))
@@ -5908,7 +5916,11 @@ VAR should be a plist with the keys :name, :id, and
:value."
"Prompt for an expression, evaluate in selected frame, pretty-print result."
(interactive (sldb-read-form-for-frame "Eval in frame (%s)> "))
(slime-eval-async
- `(swank:pprint-eval-string-in-frame ,string ,frame ,package)
+ `(swank:pprint-eval-string-in-frame ,string ,frame ,package
+ ,(if resize-mini-windows
+ (truncate
(max-mini-window-lines))
+ 1)
+ ,(window-width))
(lambda (result)
(slime-show-description result nil))))
diff --git a/swank.lisp b/swank.lisp
index cf6eb9acbf..0f0e979e10 100644
--- a/swank.lisp
+++ b/swank.lisp
@@ -1737,33 +1737,65 @@ Errors are trapped and invoke our debugger."
(defvar *echo-area-prefix* "=> "
"A prefix that `format-values-for-echo-area' should use.")
-(defun format-values-for-echo-area (values)
+(defun format-values-for-echo-area (values max-lines width)
(with-buffer-syntax ()
- (let ((*print-readably* nil))
- (cond ((null values) "; No value")
- ((and (integerp (car values)) (null (cdr values)))
- (let ((i (car values)))
- (format nil "~A~D (~a bit~:p, #x~X, #o~O, #b~B)"
- *echo-area-prefix*
- i (integer-length i) i i i)))
- ((and (typep (car values) 'ratio)
- (null (cdr values))
- (ignore-errors
- ;; The ratio may be to large to be represented as a single
float
- (format nil "~A~D (~:*~f)"
- *echo-area-prefix*
- (car values)))))
- (t (format nil "~a~{~S~^, ~}" *echo-area-prefix* values))))))
-
-(defmacro values-to-string (values)
- `(format-values-for-echo-area (multiple-value-list ,values)))
-
-(defslimefun interactive-eval (string)
+ (let* ((*print-readably* nil)
+ (*print-right-margin* (- width 10))
+ (output
+ (with-output-to-string (out)
+ (cond ((null values) "; No value")
+ ((and (integerp (car values)) (null (cdr values)))
+ (let ((i (car values)))
+ (format out "~A~D (~a bit~:p, #x~X, #o~O, #b~B)"
+ *echo-area-prefix*
+ i (integer-length i) i i i)))
+ ((and (typep (car values) 'ratio)
+ (null (cdr values))
+ (ignore-errors
+ ;; The ratio may be to large to be represented as
a single float
+ (format out "~A~D (~:*~f)"
+ *echo-area-prefix*
+ (car values)))))
+ (t (format out "~a~{~S~^, ~}" *echo-area-prefix*
values)))))
+ (max-chars (* max-lines width))
+ (lines (count #\Newline output)))
+ (if (and (<= (length output) max-chars)
+ (<= lines max-chars))
+ output
+ (let ((lines-left max-lines)
+ (chars-left max-chars)
+ (start 0))
+ (with-output-to-string (out)
+ (loop for newline = (position #\Newline output :start start)
+ do
+ (let* ((end (or newline
+ (length output)))
+ (line-length (- end start)))
+ (if (or (> line-length chars-left)
+ (= lines-left 1))
+ (cond ((zerop start)
+ (write-string output out :start start :end (-
chars-left 25))
+ (write-string " ... " out)
+ (write-string output out :start (- (length
output) 20))
+ (return))
+ (t
+ (write-string " ... " out)
+ (write-string output out :start (- (length
output) 20))
+ (return)))
+ (write-string output out :start start
+ :end (when newline
+ (1+ newline))))
+ (decf lines-left)
+ (decf chars-left line-length))
+ while newline
+ do (setf start (1+ newline)))))))))
+
+(defslimefun interactive-eval (string lines width)
(with-buffer-syntax ()
(with-retry-restart (:msg "Retry SLIME interactive evaluation request.")
(let ((values (multiple-value-list (eval (from-string string)))))
(finish-output)
- (format-values-for-echo-area values)))))
+ (format-values-for-echo-area values lines width)))))
(defslimefun eval-and-grab-output (string)
(with-buffer-syntax ()
@@ -1789,10 +1821,10 @@ last form."
(setq values (multiple-value-list (eval form)))
(finish-output))))))
-(defslimefun interactive-eval-region (string)
+(defslimefun interactive-eval-region (string lines width)
(with-buffer-syntax ()
(with-retry-restart (:msg "Retry SLIME interactive evaluation request.")
- (format-values-for-echo-area (eval-region string)))))
+ (format-values-for-echo-area (eval-region string) lines width))))
(defslimefun re-evaluate-defvar (form)
(with-buffer-syntax ()
@@ -2299,8 +2331,9 @@ has changed, ignore the request."
(with-buffer-syntax (package)
(funcall print values))))
-(defslimefun eval-string-in-frame (string frame package)
- (eval-in-frame-aux frame string package #'format-values-for-echo-area))
+(defslimefun eval-string-in-frame (string frame package lines width)
+ (eval-in-frame-aux frame string package
+ (lambda (values) (format-values-for-echo-area values
lines width))))
(defslimefun pprint-eval-string-in-frame (string frame package)
(eval-in-frame-aux frame string package #'swank-pprint))
