Plaster

text
(defun prin1-to-line (x &key (columns 1) (reserve 0)) (let* ((line (write-to-string x :escape t :readably nil :lines 2 :circle t)) (p (position #\newline line)) (limit (truncate (- *print-right-margin* reserve) columns))) (flet ((trunc (&optional end) (let* ((line-end (- limit 2)) (out (%with-output-to-string (s) (write-string line s :end (if end (min end line-end) line-end)) (write-string ".." s))) (parens-to-close (cl-user::balance-parens out))) (if (> parens-to-close 0) (concatenate 'string out (make-array parens-to-close :initial-element #\))) out) ))) (cond (p (trunc p)) ((> (length line) limit) (trunc)) (t line)))))