procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

(json-pretty-print): Rework a bit

Browse source 
* lisp/json.el (json-pretty-print): Call 'replace-buffer-contents'
separately for each json object rather than once at the end, so
its work is easier.  Use 'json--print' rather than 'json-encode' so as
to avoid creating yet more temp buffers.
This commit is contained in:
Stefan Monnier 2025-02-18 22:27:08 -05:00
parent bb45d35ea7
commit 9143c18ae4
1 changed files with 32 additions and 46 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

78
lisp/json.el
View file

@ -800,58 +800,44 @@ With prefix argument MINIMIZE, minimize it instead."
(json-object-type 'alist)
;; Ensure that keys survive roundtrip (bug#24252, bug#42545).
(json-key-type 'string)
(orig-buf (current-buffer))
error)
(orig-buf (current-buffer)))
;; Strategy: Repeatedly `json-read' from the original buffer and
;; write the pretty-printed snippet to a temporary buffer. As
;; soon as we get an error from `json-read', simply append the
;; remainder which we couldn't pretty-print to the temporary
;; buffer as well (probably the region ends _inside_ a JSON
;; object).
;;
;; Finally, use `replace-region-contents' to swap the original
;; write the pretty-printed snippet to a temporary buffer.
;; Use `replace-buffer-contents' to swap the original
;; region with the contents of the temporary buffer so that point,
;; marks, etc. are kept.
;; Stop as soon as we get an error from `json-read'.
(with-temp-buffer
(let ((tmp-buf (current-buffer)))
;; This apparently affords decent performance gains in `json--print'.
(setq-local inhibit-modification-hooks t)
(set-buffer orig-buf)
(replace-region-contents
begin end
(lambda ()
(let ((pos (point))
(keep-going t))
(while keep-going
(condition-case err
;; We want to format only the JSON snippets in the
;; region without modifying the whitespace between
;; them.
(let ((space (buffer-substring
(point)
(+ (point) (skip-chars-forward " \t\n"))))
(json (json-read)))
(setq pos (point)) ; End of last good json-read.
(set-buffer tmp-buf)
(insert space (json-encode json))
(set-buffer orig-buf))
(t
(setq keep-going nil)
(set-buffer orig-buf)
;; Rescue the remainder we couldn't pretty-print.
(append-to-buffer tmp-buf pos (point-max))
;; EOF is expected because we json-read until we hit
;; the end of the narrow region.
(unless (eq (car err) 'json-end-of-file)
(setq error err)))))
tmp-buf))
json-pretty-print-max-secs
;; FIXME: What's a good value here? Can we use something better,
;; e.g., by deriving a value from the size of the region?
64)))
;; If we got an error during JSON processing (possibly the region
;; starts or ends inside a JSON object), signal it to the user.
;; We did our best.
(when error
(signal (car error) (cdr error)))))
(save-excursion
(save-restriction
(narrow-to-region begin end)
(goto-char begin)
(while
(progn
(skip-chars-forward " \t\n")
(condition-case nil
(let ((beg (point))
(json (json-read))
(standard-output tmp-buf))
(with-current-buffer tmp-buf
(erase-buffer) (json--print json))
(save-restriction
(narrow-to-region beg (point))
(replace-buffer-contents
tmp-buf
json-pretty-print-max-secs
;; FIXME: What's a good value here? Can we use
;; something better, e.g., by deriving a value
;; from the size of the region?
64)
'keep-going))
;; EOF is expected because we json-read until we hit
;; the end of the narrow region.
(json-end-of-file nil))))))))))
(defun json-pretty-print-buffer-ordered (&optional minimize)
"Pretty-print current buffer with object keys ordered.