From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Wed, 19 Feb 2025 03:27:08 +0000 (-0500)
Subject: (json-pretty-print): Rework a bit
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=18247b506e166b11d0b8738d3f379a6a1bf32bfe;p=emacs.git

(json-pretty-print): Rework a bit

* 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.

(cherry picked from commit 9143c18ae4752cef8465579dcd713db2032ab045)
---

diff --git a/lisp/json.el b/lisp/json.el
index a797423a2f8..6e62e594910 100644
--- a/lisp/json.el
+++ b/lisp/json.el
@@ -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.