Function: cl-print-to-string-with-limit

cl-print-to-string-with-limit is an autoloaded and byte-compiled function defined in cl-print.el.gz.

Signature

(cl-print-to-string-with-limit PRINT-FUNCTION VALUE LIMIT)

Documentation

Return a string containing a printed representation of VALUE.

Attempt to get the length of the returned string under LIMIT characters with appropriate settings of print-level, print-length, and cl-print-string-length. Use PRINT-FUNCTION to print, which should take the arguments VALUE and STREAM and which should respect print-length, print-level, and cl-print-string-length. LIMIT may be nil or zero in which case PRINT-FUNCTION will be called with these settings bound to nil, and it can also be t in which case PRINT-FUNCTION will be called with their current values.

Use this function with cl-prin1 to print an object, abbreviating it with ellipses to fit within a size limit.

View in manual

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/cl-print.el.gz
;;;###autoload
(defun cl-print-to-string-with-limit (print-function value limit)
  "Return a string containing a printed representation of VALUE.
Attempt to get the length of the returned string under LIMIT
characters with appropriate settings of `print-level',
`print-length', and `cl-print-string-length'.  Use
PRINT-FUNCTION to print, which should take the arguments VALUE
and STREAM and which should respect `print-length',
`print-level', and `cl-print-string-length'.  LIMIT may be nil or
zero in which case PRINT-FUNCTION will be called with these
settings bound to nil, and it can also be t in which case
PRINT-FUNCTION will be called with their current values.

Use this function with `cl-prin1' to print an object,
abbreviating it with ellipses to fit within a size limit."
  (setq limit (and (not (eq limit 0)) limit))
  ;; Since this is used by the debugger when stack space may be
  ;; limited, if you increase print-level here, add more depth in
  ;; call_debugger (bug#31919).
  (let* ((print-length (cond
                        ((eq limit t) print-length)
                        ((or (null limit) (zerop limit)) nil)
                        (t (min limit 50))))
         (print-level (cond
                        ((eq limit t) print-level)
                        ((or (null limit) (zerop limit)) nil)
                        (t (min 8 (truncate (log limit))))))
         (cl-print-string-length
          (cond
           ((eq limit t) cl-print-string-length)
           ((or (null limit) (zerop limit)) nil)
           (t (max 0 (- limit 3)))))
         (delta-length (when (natnump limit)
                         (max 1 (truncate (/ print-length print-level))))))
    (with-temp-buffer
      (catch 'done
        (while t
          (erase-buffer)
          (funcall print-function value (current-buffer))
          (let ((result (- (point-max) (point-min))))
            ;; Stop when either print-level is too low or the value is
            ;; successfully printed in the space allowed.
            (when (or (not (natnump limit)) (< result limit) (<= print-level 2))
              (throw 'done (buffer-string)))
            (let* ((ratio (/ result limit))
                   (delta-level (max 1 (min (- print-level 2) ratio))))
              (cl-decf print-level delta-level)
              (cl-decf print-length (* delta-length delta-level))
              (when cl-print-string-length
                (cl-decf cl-print-string-length
                         (ceiling cl-print-string-length 4.0))))))))))