Speed up json.el encoding

This replaces most json-encode-* functions with similar
json--print-* counterparts that insert into the current buffer
instead of returning a string (bug#46761).

Some unused but useful json-encode-* functions are kept for backward
compatibility and as a public API, and the rest are deprecated.

* etc/NEWS: Announce obsoletions.

* lisp/json.el: Document organization of library.  Make subsection
headings more consistent.
(json--encoding-current-indentation): Rename...
(json--print-indentation-prefix): ...to this, to reflect new use.
(json--encode-stringlike, json--encode-alist): Rename...
(json--print-stringlike, json--print-alist): ...to these,
respectively, and encode argument into current buffer instead.  All
callers changed.

(json--print-string, json--print-unordered-map, json--print-array)
(json--print): New functions.
(json-encode-string, json-encode-plist, json-encode-array)
(json-encode): Use them, respectively.

(json-encode-number, json-encode-hash-table): Mark as obsolete
aliases of json-encode.
(json-encode-key, json-encode-list): Mark as obsolete in preference
for json-encode.

(json--print-indentation-depth, json--print-keyval-separator): New
variables.
(json--with-output-to-string): New macro.
(json--print-indentation, json--print-keyword, json--print-key)
(json--print-pair, json--print-map, json--print-list): New
functions.

(json--with-indentation): Use json--print-indentation-depth to avoid
unnecessary string allocation.
(json-encoding-default-indentation, json-pretty-print-max-secs):
Clarify docstrings.
(json--escape, json--long-string-threshold, json--string-buffer):
Remove; no longer used.

* lisp/progmodes/js.el (js--js-encode-value): Replace
json-encode-string and json-encode-number with json-encode.
(js-eval-defun): Use json--print-list to avoid
json-encode-list->insert roundtrip.

* test/lisp/json-tests.el (test-json-encode-number)
(test-json-encode-hash-table, test-json-encode-hash-table-pretty)
(test-json-encode-hash-table-lisp-style)
(test-json-encode-hash-table-sort,  test-json-encode-list):  Replace
uses of obsolete functions with the equivalent use of json-encode.
(test-json-encode-key): Suppress obsoletion warnings.
(test-json-encode-string): Check that text properties are stripped.

1 files changed, 96 insertions, 98 deletions

diff --git a/test/lisp/json-tests.el b/test/lisp/json-tests.el
index 9886dc0d457..f400fb064a6 100644
--- a/test/lisp/json-tests.el
+++ b/test/lisp/json-tests.el
@@ -329,13 +329,13 @@ Point is moved to beginning of the buffer."
           (should (equal (read str) res)))))))
 
 (ert-deftest test-json-encode-number ()
-  (should (equal (json-encode-number 0) "0"))
-  (should (equal (json-encode-number -0) "0"))
-  (should (equal (json-encode-number 3) "3"))
-  (should (equal (json-encode-number -5) "-5"))
-  (should (equal (json-encode-number 123.456) "123.456"))
+  (should (equal (json-encode 0) "0"))
+  (should (equal (json-encode -0) "0"))
+  (should (equal (json-encode 3) "3"))
+  (should (equal (json-encode -5) "-5"))
+  (should (equal (json-encode 123.456) "123.456"))
   (let ((bignum (1+ most-positive-fixnum)))
-    (should (equal (json-encode-number bignum)
+    (should (equal (json-encode bignum)
                    (number-to-string bignum)))))
 
 ;;; Strings
@@ -404,6 +404,8 @@ Point is moved to beginning of the buffer."
     (should (equal (json-read-string) "abcαβγ")))
   (json-tests--with-temp-buffer "\"\\nasd\\u0444\\u044b\\u0432fgh\\t\""
     (should (equal (json-read-string) "\nasdфывfgh\t")))
+  (json-tests--with-temp-buffer "\"abc\uFFFFαβγ𝔸𝐁𝖢\\\"\\\\\""
+    (should (equal (json-read-string) "abc\uFFFFαβγ𝔸𝐁𝖢\"\\")))
   ;; Bug#24784
   (json-tests--with-temp-buffer "\"\\uD834\\uDD1E\""
     (should (equal (json-read-string) "\U0001D11E")))
@@ -418,30 +420,37 @@ Point is moved to beginning of the buffer."
   (should (equal (json-encode-string "foo") "\"foo\""))
   (should (equal (json-encode-string "a\n\fb") "\"a\\n\\fb\""))
   (should (equal (json-encode-string "\nasdфыв\u001f\u007ffgh\t")
-                 "\"\\nasdфыв\\u001f\u007ffgh\\t\"")))
+                 "\"\\nasdфыв\\u001f\u007ffgh\\t\""))
+  ;; Bug#43549.
+  (should (equal (json-encode-string (propertize "foo" 'read-only t))
+                 "\"foo\""))
+  (should (equal (json-encode-string "a\0b") "\"a\\u0000b\""))
+  (should (equal (json-encode-string "abc\uFFFFαβγ𝔸𝐁𝖢\"\\")
+                 "\"abc\uFFFFαβγ𝔸𝐁𝖢\\\"\\\\\"")))
 
 (ert-deftest test-json-encode-key ()
-  (should (equal (json-encode-key '##) "\"\""))
-  (should (equal (json-encode-key :) "\"\""))
-  (should (equal (json-encode-key "") "\"\""))
-  (should (equal (json-encode-key 'a) "\"a\""))
-  (should (equal (json-encode-key :a) "\"a\""))
-  (should (equal (json-encode-key "a") "\"a\""))
-  (should (equal (json-encode-key t) "\"t\""))
-  (should (equal (json-encode-key :t) "\"t\""))
-  (should (equal (json-encode-key "t") "\"t\""))
-  (should (equal (json-encode-key nil) "\"nil\""))
-  (should (equal (json-encode-key :nil) "\"nil\""))
-  (should (equal (json-encode-key "nil") "\"nil\""))
-  (should (equal (json-encode-key ":a") "\":a\""))
-  (should (equal (json-encode-key ":t") "\":t\""))
-  (should (equal (json-encode-key ":nil") "\":nil\""))
-  (should (equal (should-error (json-encode-key 5))
-                 '(json-key-format 5)))
-  (should (equal (should-error (json-encode-key ["foo"]))
-                 '(json-key-format ["foo"])))
-  (should (equal (should-error (json-encode-key '("foo")))
-                 '(json-key-format ("foo")))))
+  (with-suppressed-warnings ((obsolete json-encode-key))
+    (should (equal (json-encode-key '##) "\"\""))
+    (should (equal (json-encode-key :) "\"\""))
+    (should (equal (json-encode-key "") "\"\""))
+    (should (equal (json-encode-key 'a) "\"a\""))
+    (should (equal (json-encode-key :a) "\"a\""))
+    (should (equal (json-encode-key "a") "\"a\""))
+    (should (equal (json-encode-key t) "\"t\""))
+    (should (equal (json-encode-key :t) "\"t\""))
+    (should (equal (json-encode-key "t") "\"t\""))
+    (should (equal (json-encode-key nil) "\"nil\""))
+    (should (equal (json-encode-key :nil) "\"nil\""))
+    (should (equal (json-encode-key "nil") "\"nil\""))
+    (should (equal (json-encode-key ":a") "\":a\""))
+    (should (equal (json-encode-key ":t") "\":t\""))
+    (should (equal (json-encode-key ":nil") "\":nil\""))
+    (should (equal (should-error (json-encode-key 5))
+                   '(json-key-format 5)))
+    (should (equal (should-error (json-encode-key ["foo"]))
+                   '(json-key-format ["foo"])))
+    (should (equal (should-error (json-encode-key '("foo")))
+                   '(json-key-format ("foo"))))))
 
 ;;; Objects
 
@@ -578,45 +587,32 @@ Point is moved to beginning of the buffer."
 (ert-deftest test-json-encode-hash-table ()
   (let ((json-encoding-object-sort-predicate nil)
         (json-encoding-pretty-print nil))
-    (should (equal (json-encode-hash-table #s(hash-table)) "{}"))
-    (should (equal (json-encode-hash-table #s(hash-table data (a 1)))
-                   "{\"a\":1}"))
-    (should (equal (json-encode-hash-table #s(hash-table data (t 1)))
-                   "{\"t\":1}"))
-    (should (equal (json-encode-hash-table #s(hash-table data (nil 1)))
-                   "{\"nil\":1}"))
-    (should (equal (json-encode-hash-table #s(hash-table data (:a 1)))
-                   "{\"a\":1}"))
-    (should (equal (json-encode-hash-table #s(hash-table data (:t 1)))
-                   "{\"t\":1}"))
-    (should (equal (json-encode-hash-table #s(hash-table data (:nil 1)))
-                   "{\"nil\":1}"))
-    (should (equal (json-encode-hash-table
-                    #s(hash-table test equal data ("a" 1)))
+    (should (equal (json-encode #s(hash-table)) "{}"))
+    (should (equal (json-encode #s(hash-table data (a 1))) "{\"a\":1}"))
+    (should (equal (json-encode #s(hash-table data (t 1))) "{\"t\":1}"))
+    (should (equal (json-encode #s(hash-table data (nil 1))) "{\"nil\":1}"))
+    (should (equal (json-encode #s(hash-table data (:a 1))) "{\"a\":1}"))
+    (should (equal (json-encode #s(hash-table data (:t 1))) "{\"t\":1}"))
+    (should (equal (json-encode #s(hash-table data (:nil 1))) "{\"nil\":1}"))
+    (should (equal (json-encode #s(hash-table test equal data ("a" 1)))
                    "{\"a\":1}"))
-    (should (equal (json-encode-hash-table
-                    #s(hash-table test equal data ("t" 1)))
+    (should (equal (json-encode #s(hash-table test equal data ("t" 1)))
                    "{\"t\":1}"))
-    (should (equal (json-encode-hash-table
-                    #s(hash-table test equal data ("nil" 1)))
+    (should (equal (json-encode #s(hash-table test equal data ("nil" 1)))
                    "{\"nil\":1}"))
-    (should (equal (json-encode-hash-table
-                    #s(hash-table test equal data (":a" 1)))
+    (should (equal (json-encode #s(hash-table test equal data (":a" 1)))
                    "{\":a\":1}"))
-    (should (equal (json-encode-hash-table
-                    #s(hash-table test equal data (":t" 1)))
+    (should (equal (json-encode #s(hash-table test equal data (":t" 1)))
                    "{\":t\":1}"))
-    (should (equal (json-encode-hash-table
-                    #s(hash-table test equal data (":nil" 1)))
+    (should (equal (json-encode #s(hash-table test equal data (":nil" 1)))
                    "{\":nil\":1}"))
-    (should (member (json-encode-hash-table #s(hash-table data (t 2 :nil 1)))
+    (should (member (json-encode #s(hash-table data (t 2 :nil 1)))
                     '("{\"nil\":1,\"t\":2}" "{\"t\":2,\"nil\":1}")))
-    (should (member (json-encode-hash-table
-                     #s(hash-table test equal data (:t 2 ":t" 1)))
+    (should (member (json-encode #s(hash-table test equal data (:t 2 ":t" 1)))
                     '("{\":t\":1,\"t\":2}" "{\"t\":2,\":t\":1}")))
-    (should (member (json-encode-hash-table #s(hash-table data (b 2 a 1)))
+    (should (member (json-encode #s(hash-table data (b 2 a 1)))
                     '("{\"a\":1,\"b\":2}" "{\"b\":2,\"a\":1}")))
-    (should (member (json-encode-hash-table #s(hash-table data (c 3 b 2 a 1)))
+    (should (member (json-encode #s(hash-table data (c 3 b 2 a 1)))
                     '("{\"a\":1,\"b\":2,\"c\":3}"
                       "{\"a\":1,\"c\":3,\"b\":2}"
                       "{\"b\":2,\"a\":1,\"c\":3}"
@@ -629,13 +625,12 @@ Point is moved to beginning of the buffer."
         (json-encoding-pretty-print t)
         (json-encoding-default-indentation " ")
         (json-encoding-lisp-style-closings nil))
-    (should (equal (json-encode-hash-table #s(hash-table)) "{}"))
-    (should (equal (json-encode-hash-table #s(hash-table data (a 1)))
-                   "{\n \"a\": 1\n}"))
-    (should (member (json-encode-hash-table #s(hash-table data (b 2 a 1)))
+    (should (equal (json-encode #s(hash-table)) "{}"))
+    (should (equal (json-encode #s(hash-table data (a 1))) "{\n \"a\": 1\n}"))
+    (should (member (json-encode #s(hash-table data (b 2 a 1)))
                     '("{\n \"a\": 1,\n \"b\": 2\n}"
                       "{\n \"b\": 2,\n \"a\": 1\n}")))
-    (should (member (json-encode-hash-table #s(hash-table data (c 3 b 2 a 1)))
+    (should (member (json-encode #s(hash-table data (c 3 b 2 a 1)))
                     '("{\n \"a\": 1,\n \"b\": 2,\n \"c\": 3\n}"
                       "{\n \"a\": 1,\n \"c\": 3,\n \"b\": 2\n}"
                       "{\n \"b\": 2,\n \"a\": 1,\n \"c\": 3\n}"
@@ -648,13 +643,12 @@ Point is moved to beginning of the buffer."
         (json-encoding-pretty-print t)
         (json-encoding-default-indentation " ")
         (json-encoding-lisp-style-closings t))
-    (should (equal (json-encode-hash-table #s(hash-table)) "{}"))
-    (should (equal (json-encode-hash-table #s(hash-table data (a 1)))
-                   "{\n \"a\": 1}"))
-    (should (member (json-encode-hash-table #s(hash-table data (b 2 a 1)))
+    (should (equal (json-encode #s(hash-table)) "{}"))
+    (should (equal (json-encode #s(hash-table data (a 1))) "{\n \"a\": 1}"))
+    (should (member (json-encode #s(hash-table data (b 2 a 1)))
                     '("{\n \"a\": 1,\n \"b\": 2}"
                       "{\n \"b\": 2,\n \"a\": 1}")))
-    (should (member (json-encode-hash-table #s(hash-table data (c 3 b 2 a 1)))
+    (should (member (json-encode #s(hash-table data (c 3 b 2 a 1)))
                     '("{\n \"a\": 1,\n \"b\": 2,\n \"c\": 3}"
                       "{\n \"a\": 1,\n \"c\": 3,\n \"b\": 2}"
                       "{\n \"b\": 2,\n \"a\": 1,\n \"c\": 3}"
@@ -672,7 +666,7 @@ Point is moved to beginning of the buffer."
                      (#s(hash-table data (c 3 b 2 a 1))
                         . "{\"a\":1,\"b\":2,\"c\":3}")))
       (let ((copy (map-pairs in)))
-        (should (equal (json-encode-hash-table in) out))
+        (should (equal (json-encode in) out))
         ;; Ensure sorting isn't destructive.
         (should (seq-set-equal-p (map-pairs in) copy))))))
 
@@ -785,38 +779,42 @@ Point is moved to beginning of the buffer."
         (should (equal in copy))))))
 
 (ert-deftest test-json-encode-list ()
+  "Test `json-encode-list' or its more moral equivalents."
   (let ((json-encoding-object-sort-predicate nil)
         (json-encoding-pretty-print nil))
-    (should (equal (json-encode-list ()) "{}"))
-    (should (equal (json-encode-list '(a)) "[\"a\"]"))
-    (should (equal (json-encode-list '(:a)) "[\"a\"]"))
-    (should (equal (json-encode-list '("a")) "[\"a\"]"))
-    (should (equal (json-encode-list '(a 1)) "[\"a\",1]"))
-    (should (equal (json-encode-list '("a" 1)) "[\"a\",1]"))
-    (should (equal (json-encode-list '(:a 1)) "{\"a\":1}"))
-    (should (equal (json-encode-list '((a . 1))) "{\"a\":1}"))
-    (should (equal (json-encode-list '((:a . 1))) "{\"a\":1}"))
-    (should (equal (json-encode-list '(:b 2 :a)) "[\"b\",2,\"a\"]"))
-    (should (equal (json-encode-list '(4 3 2 1)) "[4,3,2,1]"))
-    (should (equal (json-encode-list '(b 2 a 1)) "[\"b\",2,\"a\",1]"))
-    (should (equal (json-encode-list '(:b 2 :a 1)) "{\"b\":2,\"a\":1}"))
-    (should (equal (json-encode-list '((b . 2) (a . 1))) "{\"b\":2,\"a\":1}"))
-    (should (equal (json-encode-list '((:b . 2) (:a . 1)))
+    ;; Trick `json-encode' into using `json--print-list'.
+    (let ((json-null (list nil)))
+      (should (equal (json-encode ()) "{}")))
+    (should (equal (json-encode '(a)) "[\"a\"]"))
+    (should (equal (json-encode '(:a)) "[\"a\"]"))
+    (should (equal (json-encode '("a")) "[\"a\"]"))
+    (should (equal (json-encode '(a 1)) "[\"a\",1]"))
+    (should (equal (json-encode '("a" 1)) "[\"a\",1]"))
+    (should (equal (json-encode '(:a 1)) "{\"a\":1}"))
+    (should (equal (json-encode '((a . 1))) "{\"a\":1}"))
+    (should (equal (json-encode '((:a . 1))) "{\"a\":1}"))
+    (should (equal (json-encode '(:b 2 :a)) "[\"b\",2,\"a\"]"))
+    (should (equal (json-encode '(4 3 2 1)) "[4,3,2,1]"))
+    (should (equal (json-encode '(b 2 a 1)) "[\"b\",2,\"a\",1]"))
+    (should (equal (json-encode '(:b 2 :a 1)) "{\"b\":2,\"a\":1}"))
+    (should (equal (json-encode '((b . 2) (a . 1))) "{\"b\":2,\"a\":1}"))
+    (should (equal (json-encode '((:b . 2) (:a . 1)))
                    "{\"b\":2,\"a\":1}"))
-    (should (equal (json-encode-list '((a) 1)) "[[\"a\"],1]"))
-    (should (equal (json-encode-list '((:a) 1)) "[[\"a\"],1]"))
-    (should (equal (json-encode-list '(("a") 1)) "[[\"a\"],1]"))
-    (should (equal (json-encode-list '((a 1) 2)) "[[\"a\",1],2]"))
-    (should (equal (json-encode-list '((:a 1) 2)) "[{\"a\":1},2]"))
-    (should (equal (json-encode-list '(((a . 1)) 2)) "[{\"a\":1},2]"))
-    (should (equal (json-encode-list '(:a 1 :b (2))) "{\"a\":1,\"b\":[2]}"))
-    (should (equal (json-encode-list '((a . 1) (b 2))) "{\"a\":1,\"b\":[2]}"))
-    (should-error (json-encode-list '(a . 1)) :type 'wrong-type-argument)
-    (should-error (json-encode-list '((a . 1) 2)) :type 'wrong-type-argument)
-    (should (equal (should-error (json-encode-list []))
-                   '(json-error [])))
-    (should (equal (should-error (json-encode-list [a]))
-                   '(json-error [a])))))
+    (should (equal (json-encode '((a) 1)) "[[\"a\"],1]"))
+    (should (equal (json-encode '((:a) 1)) "[[\"a\"],1]"))
+    (should (equal (json-encode '(("a") 1)) "[[\"a\"],1]"))
+    (should (equal (json-encode '((a 1) 2)) "[[\"a\",1],2]"))
+    (should (equal (json-encode '((:a 1) 2)) "[{\"a\":1},2]"))
+    (should (equal (json-encode '(((a . 1)) 2)) "[{\"a\":1},2]"))
+    (should (equal (json-encode '(:a 1 :b (2))) "{\"a\":1,\"b\":[2]}"))
+    (should (equal (json-encode '((a . 1) (b 2))) "{\"a\":1,\"b\":[2]}"))
+    (should-error (json-encode '(a . 1)) :type 'wrong-type-argument)
+    (should-error (json-encode '((a . 1) 2)) :type 'wrong-type-argument)
+    (with-suppressed-warnings ((obsolete json-encode-list))
+      (should (equal (should-error (json-encode-list []))
+                     '(json-error [])))
+      (should (equal (should-error (json-encode-list [a]))
+                     '(json-error [a]))))))
 
 ;;; Arrays