Function: kfile:print-to-string

kfile:print-to-string is a byte-compiled function defined in kfile.el.

Signature

(kfile:print-to-string OBJECT)

Documentation

Return a string containing OBJECT, any Lisp object, in pretty-printed form.

Quoting characters are used when needed to make output that read can handle, whenever this is possible.

Source Code

;; Defined in ~/.emacs.d/elpa/hyperbole-20260414.325/kotl/kfile.el
(defun kfile:print-to-string (object)
  "Return a string containing OBJECT, any Lisp object, in pretty-printed form.
Quoting characters are used when needed to make output that `read' can
handle, whenever this is possible."
  (with-current-buffer (get-buffer-create " kfile:print-to-string")
    (let ((emacs-lisp-mode-hook)
	  (buffer-read-only))
      (erase-buffer)
      (unwind-protect
	  (progn
	    (emacs-lisp-mode)
	    (let ((print-escape-newlines kfile:escape-newlines))
	      (prin1 object (current-buffer)))
	    (goto-char (point-min))
	    (while (not (smart-eobp))
	      ;; (message "%06d" (- (point-max) (point)))
	      (cond
	       ((looking-at "\\s\(")
		(while (looking-at "\\s(")
		  (forward-char 1)))
	       ((and (looking-at "\\(quote[ \t]+\\)\\([^.)]\\)")
		     (> (match-beginning 1) 1)
		     (eq ?\( (char-after (1- (match-beginning 1))))
		     ;; Make sure this is a two-element list.
		     (save-excursion
		       (goto-char (match-beginning 2))
		       (forward-sexp)
		       ;; (looking-at "[ \t]*\)")
		       ;; Avoid mucking with match-data
		       (eq ?\) (char-after (point)))))
		;; -1 gets the paren preceding the quote as well.
		(delete-region (1- (match-beginning 1)) (match-end 1))
		(insert "'")
		(forward-sexp 1)
		(if (looking-at "[ \t]*\)")
		    (delete-region (match-beginning 0) (match-end 0))
		  (error "Malformed quote"))
		(backward-sexp 1))
	       ((ignore-errors (prog1 t (down-list 1)))
		(backward-char 1)
		(skip-chars-backward " \t")
		(delete-region
		 (point)
		 (progn (skip-chars-forward " \t") (point)))
		(when (not (eq ?' (char-after (1- (point)))))
		  (insert ?\n)))
	       ((ignore-errors (prog1 t (up-list 1)))
		(while (looking-at "\\s)")
		  (forward-char 1))
		(skip-chars-backward " \t")
		(delete-region
		 (point)
		 (progn (skip-chars-forward " \t") (point)))
		(when (not (eq ?' (char-after (1- (point)))))
		  (insert ?\n)))
	       (t (goto-char (point-max)))))
	    (goto-char (point-min))
	    (indent-sexp)
	    (buffer-string))
	(kill-buffer (current-buffer))))))