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.
This commit is contained in:
Basil L. Contovounesios
parent
b24c21e82c
commit
428339e231
4 changed files with 305 additions and 273 deletions
10
etc/NEWS
10
etc/NEWS
|
|
@ -1559,6 +1559,16 @@ component are now rejected by 'json-read' and friends. This makes
|
|||
them more compliant with the JSON specification and consistent with
|
||||
the native JSON parsing functions.
|
||||
|
||||
---
|
||||
*** Some JSON encoding functions are now obsolete.
|
||||
The functions 'json-encode-number', 'json-encode-hash-table',
|
||||
'json-encode-key', and 'json-encode-list' are now obsolete.
|
||||
|
||||
The first two are kept as aliases of 'json-encode', which should be
|
||||
used instead. Uses of 'json-encode-list' should be changed to call
|
||||
one of 'json-encode', 'json-encode-alist', 'json-encode-plist', or
|
||||
'json-encode-array' instead.
|
||||
|
||||
** xml.el
|
||||
|
||||
*** XML serialization functions now reject invalid characters.
|
||||
|
|
|
|||
368
lisp/json.el
368
lisp/json.el
|
|
@ -40,6 +40,17 @@
|
|||
;; Similarly, since `false' and `null' are distinct in JSON, you can
|
||||
;; distinguish them by binding `json-false' and `json-null' as desired.
|
||||
|
||||
;;; Organization:
|
||||
|
||||
;; Historically json.el used the prefix `json-read-' for decoding and
|
||||
;; the prefix `json-encode-' for encoding. Many of these definitions
|
||||
;; are used by external packages since few were marked as internal.
|
||||
;; Optimizing the encoder to manipulate a buffer rather than strings
|
||||
;; while minimizing code duplication therefore necessitated a new
|
||||
;; namespace `json--print-'. This rendered many encoding functions
|
||||
;; obsolete and unused, but those considered externally useful are
|
||||
;; kept for backward compatibility and as a public API.
|
||||
|
||||
;;; History:
|
||||
|
||||
;; 2006-03-11 - Initial version.
|
||||
|
|
@ -57,7 +68,7 @@
|
|||
(require 'map)
|
||||
(require 'subr-x)
|
||||
|
||||
;; Parameters
|
||||
;;;; Parameters
|
||||
|
||||
(defvar json-object-type 'alist
|
||||
"Type to convert JSON objects to.
|
||||
|
|
@ -102,13 +113,22 @@ this around your call to `json-read' instead of `setq'ing it.")
|
|||
"Value to use as an element separator when encoding.")
|
||||
|
||||
(defvar json-encoding-default-indentation " "
|
||||
"The default indentation level for encoding.
|
||||
"String used for a single indentation level during encoding.
|
||||
This value is repeated for each further nested element.
|
||||
Used only when `json-encoding-pretty-print' is non-nil.")
|
||||
|
||||
(defvar json--encoding-current-indentation "\n"
|
||||
"Internally used to keep track of the current indentation level of encoding.
|
||||
(defvar json--print-indentation-prefix "\n"
|
||||
"String used to start indentation during encoding.
|
||||
Used only when `json-encoding-pretty-print' is non-nil.")
|
||||
|
||||
(defvar json--print-indentation-depth 0
|
||||
"Current indentation level during encoding.
|
||||
Dictates repetitions of `json-encoding-default-indentation'.
|
||||
Used only when `json-encoding-pretty-print' is non-nil.")
|
||||
|
||||
(defvar json--print-keyval-separator ":"
|
||||
"String used to separate key-value pairs during encoding.")
|
||||
|
||||
(defvar json-encoding-pretty-print nil
|
||||
"If non-nil, then the output of `json-encode' will be pretty-printed.")
|
||||
|
||||
|
|
@ -137,7 +157,7 @@ respectively, with no arguments.")
|
|||
|
||||
|
||||
|
||||
;;; Utilities
|
||||
;;;; Utilities
|
||||
|
||||
(define-obsolete-function-alias 'json-join #'string-join "28.1")
|
||||
|
||||
|
|
@ -169,18 +189,38 @@ destructively modify PLIST to produce the result."
|
|||
(setcdr (cdr plist) prev)))
|
||||
plist)
|
||||
|
||||
;; Encoder utilities
|
||||
|
||||
(defmacro json--with-output-to-string (&rest body)
|
||||
"Eval BODY in a temporary buffer bound to `standard-output'.
|
||||
Return the resulting buffer contents as a string."
|
||||
(declare (indent 0) (debug t))
|
||||
`(with-output-to-string
|
||||
(with-current-buffer standard-output
|
||||
;; This affords decent performance gains.
|
||||
(setq-local inhibit-modification-hooks t)
|
||||
,@body)))
|
||||
|
||||
(defmacro json--with-indentation (&rest body)
|
||||
"Evaluate BODY with the correct indentation for JSON encoding.
|
||||
This macro binds `json--encoding-current-indentation' according
|
||||
to `json-encoding-pretty-print' around BODY."
|
||||
"Eval BODY with the JSON encoding nesting incremented by one step.
|
||||
This macro sets up appropriate variable bindings for
|
||||
`json--print-indentation' to produce the correct indentation when
|
||||
`json-encoding-pretty-print' is non-nil."
|
||||
(declare (debug t) (indent 0))
|
||||
`(let ((json--encoding-current-indentation
|
||||
(if json-encoding-pretty-print
|
||||
(concat json--encoding-current-indentation
|
||||
json-encoding-default-indentation)
|
||||
"")))
|
||||
`(let ((json--print-indentation-prefix
|
||||
(if json-encoding-pretty-print json--print-indentation-prefix ""))
|
||||
(json--print-keyval-separator (if json-encoding-pretty-print ": " ":"))
|
||||
(json--print-indentation-depth (1+ json--print-indentation-depth)))
|
||||
,@body))
|
||||
|
||||
(defun json--print-indentation ()
|
||||
"Insert the current indentation for JSON encoding at point.
|
||||
Has no effect if `json-encoding-pretty-print' is nil."
|
||||
(when json-encoding-pretty-print
|
||||
(insert json--print-indentation-prefix)
|
||||
(dotimes (_ json--print-indentation-depth)
|
||||
(insert json-encoding-default-indentation))))
|
||||
|
||||
;; Reader utilities
|
||||
|
||||
(define-inline json-advance (&optional n)
|
||||
|
|
@ -210,8 +250,6 @@ Signal `json-end-of-file' if called at the end of the buffer."
|
|||
;; definition of whitespace in JSON.
|
||||
(inline-quote (skip-chars-forward "\t\n\r ")))
|
||||
|
||||
|
||||
|
||||
;; Error conditions
|
||||
|
||||
(define-error 'json-error "Unknown JSON error")
|
||||
|
|
@ -228,7 +266,7 @@ Signal `json-end-of-file' if called at the end of the buffer."
|
|||
|
||||
|
||||
|
||||
;;; Paths
|
||||
;;;; Paths
|
||||
|
||||
(defvar json--path '()
|
||||
"Keeps track of the path during recursive calls to `json-read'.
|
||||
|
|
@ -283,7 +321,9 @@ element in a deeply nested structure."
|
|||
(when (plist-get path :path)
|
||||
path))))
|
||||
|
||||
;;; Keywords
|
||||
|
||||
|
||||
;;;; Keywords
|
||||
|
||||
(defconst json-keywords '("true" "false" "null")
|
||||
"List of JSON keywords.")
|
||||
|
|
@ -316,7 +356,13 @@ element in a deeply nested structure."
|
|||
((eq keyword json-false) "false")
|
||||
((eq keyword json-null) "null")))
|
||||
|
||||
;;; Numbers
|
||||
(defun json--print-keyword (keyword)
|
||||
"Insert KEYWORD as a JSON value at point.
|
||||
Return nil if KEYWORD is not recognized as a JSON keyword."
|
||||
(prog1 (setq keyword (json-encode-keyword keyword))
|
||||
(and keyword (insert keyword))))
|
||||
|
||||
;;;; Numbers
|
||||
|
||||
;; Number parsing
|
||||
|
||||
|
|
@ -339,10 +385,9 @@ element in a deeply nested structure."
|
|||
|
||||
;; Number encoding
|
||||
|
||||
(defalias 'json-encode-number #'number-to-string
|
||||
"Return a JSON representation of NUMBER.")
|
||||
(define-obsolete-function-alias 'json-encode-number #'json-encode "28.1")
|
||||
|
||||
;;; Strings
|
||||
;;;; Strings
|
||||
|
||||
(defconst json-special-chars
|
||||
'((?\" . ?\")
|
||||
|
|
@ -410,65 +455,52 @@ element in a deeply nested structure."
|
|||
|
||||
;; String encoding
|
||||
|
||||
;; Escape only quotation mark, backslash, and the control
|
||||
;; characters U+0000 to U+001F (RFC 4627, ECMA-404).
|
||||
(rx-define json--escape (in ?\" ?\\ cntrl))
|
||||
|
||||
(defvar json--long-string-threshold 200
|
||||
"Length above which strings are considered long for JSON encoding.
|
||||
It is generally faster to manipulate such strings in a buffer
|
||||
rather than directly.")
|
||||
|
||||
(defvar json--string-buffer nil
|
||||
"Buffer used for encoding Lisp strings as JSON.
|
||||
Initialized lazily by `json-encode-string'.")
|
||||
(defun json--print-string (string &optional from)
|
||||
"Insert a JSON representation of STRING at point.
|
||||
FROM is the index of STRING to start from and defaults to 0."
|
||||
(insert ?\")
|
||||
(goto-char (prog1 (point) (princ string)))
|
||||
(and from (delete-char from))
|
||||
;; Escape only quotation mark, backslash, and the control
|
||||
;; characters U+0000 to U+001F (RFC 4627, ECMA-404).
|
||||
(while (re-search-forward (rx (in ?\" ?\\ cntrl)) nil 'move)
|
||||
(let ((char (preceding-char)))
|
||||
(delete-char -1)
|
||||
(insert ?\\ (or
|
||||
;; Special JSON character (\n, \r, etc.).
|
||||
(car (rassq char json-special-chars))
|
||||
;; Fallback: UCS code point in \uNNNN form.
|
||||
(format "u%04x" char)))))
|
||||
(insert ?\")
|
||||
string)
|
||||
|
||||
(defun json-encode-string (string)
|
||||
"Return a JSON representation of STRING."
|
||||
;; Try to avoid buffer overhead in trivial cases, while also
|
||||
;; avoiding searching pathological strings for escape characters.
|
||||
;; Since `string-match-p' doesn't take a LIMIT argument, we use
|
||||
;; string length as our heuristic. See also bug#20154.
|
||||
(if (and (< (length string) json--long-string-threshold)
|
||||
(not (string-match-p (rx json--escape) string)))
|
||||
(concat "\"" (substring-no-properties string) "\"")
|
||||
(with-current-buffer
|
||||
(or json--string-buffer
|
||||
(with-current-buffer (generate-new-buffer " *json-string*" t)
|
||||
;; This seems to afford decent performance gains.
|
||||
(setq-local inhibit-modification-hooks t)
|
||||
(setq json--string-buffer (current-buffer))))
|
||||
;; Strip `read-only' property (bug#43549).
|
||||
(insert ?\" (substring-no-properties string))
|
||||
(goto-char (1+ (point-min)))
|
||||
(while (re-search-forward (rx json--escape) nil 'move)
|
||||
(let ((char (preceding-char)))
|
||||
(delete-char -1)
|
||||
(insert ?\\ (or
|
||||
;; Special JSON character (\n, \r, etc.).
|
||||
(car (rassq char json-special-chars))
|
||||
;; Fallback: UCS code point in \uNNNN form.
|
||||
(format "u%04x" char)))))
|
||||
(insert ?\")
|
||||
;; Empty buffer for next invocation.
|
||||
(delete-and-extract-region (point-min) (point-max)))))
|
||||
(json--with-output-to-string (json--print-string string)))
|
||||
|
||||
(defun json--encode-stringlike (object)
|
||||
"Return OBJECT encoded as a JSON string, or nil if not possible."
|
||||
(cond ((stringp object) (json-encode-string object))
|
||||
((keywordp object) (json-encode-string
|
||||
(substring (symbol-name object) 1)))
|
||||
((symbolp object) (json-encode-string (symbol-name object)))))
|
||||
(defun json--print-stringlike (object)
|
||||
"Insert OBJECT encoded as a JSON string at point.
|
||||
Return nil if OBJECT cannot be encoded as a JSON string."
|
||||
(cond ((stringp object) (json--print-string object))
|
||||
((keywordp object) (json--print-string (symbol-name object) 1))
|
||||
((symbolp object) (json--print-string (symbol-name object)))))
|
||||
|
||||
(defun json--print-key (object)
|
||||
"Insert a JSON key representation of OBJECT at point.
|
||||
Signal `json-key-format' if it cannot be encoded as a string."
|
||||
(or (json--print-stringlike object)
|
||||
(signal 'json-key-format (list object))))
|
||||
|
||||
(defun json-encode-key (object)
|
||||
"Return a JSON representation of OBJECT.
|
||||
If the resulting JSON object isn't a valid JSON object key,
|
||||
this signals `json-key-format'."
|
||||
;; Encoding must be a JSON string.
|
||||
(or (json--encode-stringlike object)
|
||||
(signal 'json-key-format (list object))))
|
||||
(declare (obsolete json-encode "28.1"))
|
||||
(json--with-output-to-string (json--print-key object)))
|
||||
|
||||
;;; Objects
|
||||
;;;; Objects
|
||||
|
||||
;; JSON object parsing
|
||||
|
||||
(defun json-new-object ()
|
||||
"Create a new Elisp object corresponding to an empty JSON object.
|
||||
|
|
@ -501,8 +533,6 @@ Please see the documentation of `json-object-type' and `json-key-type'."
|
|||
((eq json-object-type 'plist)
|
||||
(cons key (cons value object))))))
|
||||
|
||||
;; JSON object parsing
|
||||
|
||||
(defun json-read-object ()
|
||||
"Read the JSON object at point."
|
||||
;; Skip over the '{'.
|
||||
|
|
@ -537,95 +567,81 @@ Please see the documentation of `json-object-type' and `json-key-type'."
|
|||
('plist (json--plist-nreverse elements))
|
||||
(_ elements))))
|
||||
|
||||
;; JSON object encoding
|
||||
|
||||
(defun json--print-pair (key val)
|
||||
"Insert JSON representation of KEY-VAL pair at point.
|
||||
This always inserts a trailing `json-encoding-separator'."
|
||||
(json--print-indentation)
|
||||
(json--print-key key)
|
||||
(insert json--print-keyval-separator)
|
||||
(json--print val)
|
||||
(insert json-encoding-separator))
|
||||
|
||||
(defun json--print-map (map)
|
||||
"Insert JSON object representation of MAP at point.
|
||||
This works for any MAP satisfying `mapp'."
|
||||
(insert ?\{)
|
||||
(unless (map-empty-p map)
|
||||
(json--with-indentation
|
||||
(map-do #'json--print-pair map)
|
||||
(delete-char (- (length json-encoding-separator))))
|
||||
(or json-encoding-lisp-style-closings
|
||||
(json--print-indentation)))
|
||||
(insert ?\}))
|
||||
|
||||
(defun json--print-unordered-map (map)
|
||||
"Like `json--print-map', but optionally sort MAP first.
|
||||
If `json-encoding-object-sort-predicate' is non-nil, this first
|
||||
transforms an unsortable MAP into a sortable alist."
|
||||
(if (and json-encoding-object-sort-predicate
|
||||
(not (map-empty-p map)))
|
||||
(json--print-alist (map-pairs map) t)
|
||||
(json--print-map map)))
|
||||
|
||||
;; Hash table encoding
|
||||
|
||||
(defun json-encode-hash-table (hash-table)
|
||||
"Return a JSON representation of HASH-TABLE."
|
||||
(cond ((hash-table-empty-p hash-table) "{}")
|
||||
(json-encoding-object-sort-predicate
|
||||
(json--encode-alist (map-pairs hash-table) t))
|
||||
(t
|
||||
(let ((kv-sep (if json-encoding-pretty-print ": " ":"))
|
||||
result)
|
||||
(json--with-indentation
|
||||
(maphash
|
||||
(lambda (k v)
|
||||
(push (concat json--encoding-current-indentation
|
||||
(json-encode-key k)
|
||||
kv-sep
|
||||
(json-encode v))
|
||||
result))
|
||||
hash-table))
|
||||
(concat "{"
|
||||
(string-join (nreverse result) json-encoding-separator)
|
||||
(and json-encoding-pretty-print
|
||||
(not json-encoding-lisp-style-closings)
|
||||
json--encoding-current-indentation)
|
||||
"}")))))
|
||||
(define-obsolete-function-alias 'json-encode-hash-table #'json-encode "28.1")
|
||||
|
||||
;; List encoding (including alists and plists)
|
||||
|
||||
(defun json--encode-alist (alist &optional destructive)
|
||||
"Return a JSON representation of ALIST.
|
||||
DESTRUCTIVE non-nil means it is safe to modify ALIST by
|
||||
side-effects."
|
||||
(when json-encoding-object-sort-predicate
|
||||
(setq alist (sort (if destructive alist (copy-sequence alist))
|
||||
(lambda (a b)
|
||||
(funcall json-encoding-object-sort-predicate
|
||||
(car a) (car b))))))
|
||||
(concat "{"
|
||||
(let ((kv-sep (if json-encoding-pretty-print ": " ":")))
|
||||
(json--with-indentation
|
||||
(mapconcat (lambda (cons)
|
||||
(concat json--encoding-current-indentation
|
||||
(json-encode-key (car cons))
|
||||
kv-sep
|
||||
(json-encode (cdr cons))))
|
||||
alist
|
||||
json-encoding-separator)))
|
||||
(and json-encoding-pretty-print
|
||||
(not json-encoding-lisp-style-closings)
|
||||
json--encoding-current-indentation)
|
||||
"}"))
|
||||
(defun json--print-alist (alist &optional destructive)
|
||||
"Insert a JSON representation of ALIST at point.
|
||||
Sort ALIST first if `json-encoding-object-sort-predicate' is
|
||||
non-nil. Sorting can optionally be DESTRUCTIVE for speed."
|
||||
(json--print-map (if (and json-encoding-object-sort-predicate alist)
|
||||
(sort (if destructive alist (copy-sequence alist))
|
||||
(lambda (a b)
|
||||
(funcall json-encoding-object-sort-predicate
|
||||
(car a) (car b))))
|
||||
alist)))
|
||||
|
||||
;; The following two are unused but useful to keep around due to the
|
||||
;; inherent ambiguity of lists.
|
||||
|
||||
(defun json-encode-alist (alist)
|
||||
"Return a JSON representation of ALIST."
|
||||
(if alist (json--encode-alist alist) "{}"))
|
||||
(json--with-output-to-string (json--print-alist alist)))
|
||||
|
||||
(defun json-encode-plist (plist)
|
||||
"Return a JSON representation of PLIST."
|
||||
(cond ((null plist) "{}")
|
||||
(json-encoding-object-sort-predicate
|
||||
(json--encode-alist (map-pairs plist) t))
|
||||
(t
|
||||
(let ((kv-sep (if json-encoding-pretty-print ": " ":"))
|
||||
result)
|
||||
(json--with-indentation
|
||||
(while plist
|
||||
(push (concat json--encoding-current-indentation
|
||||
(json-encode-key (pop plist))
|
||||
kv-sep
|
||||
(json-encode (pop plist)))
|
||||
result)))
|
||||
(concat "{"
|
||||
(string-join (nreverse result) json-encoding-separator)
|
||||
(and json-encoding-pretty-print
|
||||
(not json-encoding-lisp-style-closings)
|
||||
json--encoding-current-indentation)
|
||||
"}")))))
|
||||
(json--with-output-to-string (json--print-unordered-map plist)))
|
||||
|
||||
(defun json--print-list (list)
|
||||
"Like `json-encode-list', but insert the JSON at point."
|
||||
(cond ((json-alist-p list) (json--print-alist list))
|
||||
((json-plist-p list) (json--print-unordered-map list))
|
||||
((listp list) (json--print-array list))
|
||||
((signal 'json-error (list list)))))
|
||||
|
||||
(defun json-encode-list (list)
|
||||
"Return a JSON representation of LIST.
|
||||
Tries to DWIM: simple lists become JSON arrays, while alists and plists
|
||||
become JSON objects."
|
||||
(cond ((json-alist-p list) (json-encode-alist list))
|
||||
((json-plist-p list) (json-encode-plist list))
|
||||
((listp list) (json-encode-array list))
|
||||
(t
|
||||
(signal 'json-error (list list)))))
|
||||
Tries to DWIM: alists and plists become JSON objects, while
|
||||
simple lists become JSON arrays."
|
||||
(declare (obsolete json-encode "28.1"))
|
||||
(json--with-output-to-string (json--print-list list)))
|
||||
|
||||
;;; Arrays
|
||||
;;;; Arrays
|
||||
|
||||
;; Array parsing
|
||||
|
||||
|
|
@ -658,28 +674,32 @@ become JSON objects."
|
|||
|
||||
;; Array encoding
|
||||
|
||||
(defun json--print-array (array)
|
||||
"Like `json-encode-array', but insert the JSON at point."
|
||||
(insert ?\[)
|
||||
(unless (length= array 0)
|
||||
(json--with-indentation
|
||||
(json--print-indentation)
|
||||
(let ((first t))
|
||||
(mapc (lambda (elt)
|
||||
(if first
|
||||
(setq first nil)
|
||||
(insert json-encoding-separator)
|
||||
(json--print-indentation))
|
||||
(json--print elt))
|
||||
array)))
|
||||
(or json-encoding-lisp-style-closings
|
||||
(json--print-indentation)))
|
||||
(insert ?\]))
|
||||
|
||||
(defun json-encode-array (array)
|
||||
"Return a JSON representation of ARRAY.
|
||||
ARRAY can also be a list."
|
||||
(if (and json-encoding-pretty-print
|
||||
(not (length= array 0)))
|
||||
(concat
|
||||
"["
|
||||
(json--with-indentation
|
||||
(concat json--encoding-current-indentation
|
||||
(mapconcat #'json-encode array
|
||||
(concat json-encoding-separator
|
||||
json--encoding-current-indentation))))
|
||||
(unless json-encoding-lisp-style-closings
|
||||
json--encoding-current-indentation)
|
||||
"]")
|
||||
(concat "["
|
||||
(mapconcat #'json-encode array json-encoding-separator)
|
||||
"]")))
|
||||
(json--with-output-to-string (json--print-array array)))
|
||||
|
||||
|
||||
|
||||
;;; Reader
|
||||
;;;; Reader
|
||||
|
||||
(defmacro json-readtable-dispatch (char)
|
||||
"Dispatch reader function for CHAR at point.
|
||||
|
|
@ -735,7 +755,17 @@ you will get the following structure returned:
|
|||
|
||||
|
||||
|
||||
;;; Encoder
|
||||
;;;; Encoder
|
||||
|
||||
(defun json--print (object)
|
||||
"Like `json-encode', but insert or print the JSON at point."
|
||||
(cond ((json--print-keyword object))
|
||||
((listp object) (json--print-list object))
|
||||
((json--print-stringlike object))
|
||||
((numberp object) (prin1 object))
|
||||
((arrayp object) (json--print-array object))
|
||||
((hash-table-p object) (json--print-unordered-map object))
|
||||
((signal 'json-error (list object)))))
|
||||
|
||||
(defun json-encode (object)
|
||||
"Return a JSON representation of OBJECT as a string.
|
||||
|
|
@ -743,15 +773,9 @@ you will get the following structure returned:
|
|||
OBJECT should have a structure like one returned by `json-read'.
|
||||
If an error is detected during encoding, an error based on
|
||||
`json-error' is signaled."
|
||||
(cond ((json-encode-keyword object))
|
||||
((listp object) (json-encode-list object))
|
||||
((json--encode-stringlike object))
|
||||
((numberp object) (json-encode-number object))
|
||||
((arrayp object) (json-encode-array object))
|
||||
((hash-table-p object) (json-encode-hash-table object))
|
||||
(t (signal 'json-error (list object)))))
|
||||
(json--with-output-to-string (json--print object)))
|
||||
|
||||
;;; Pretty printing & minimizing
|
||||
;;;; Pretty printing & minimizing
|
||||
|
||||
(defun json-pretty-print-buffer (&optional minimize)
|
||||
"Pretty-print current buffer.
|
||||
|
|
@ -762,7 +786,7 @@ With prefix argument MINIMIZE, minimize it instead."
|
|||
(defvar json-pretty-print-max-secs 2.0
|
||||
"Maximum time for `json-pretty-print's comparison.
|
||||
The function `json-pretty-print' uses `replace-region-contents'
|
||||
(which see) passing the value of this variable as argument
|
||||
\(which see) passing the value of this variable as argument
|
||||
MAX-SECS.")
|
||||
|
||||
(defun json-pretty-print (begin end &optional minimize)
|
||||
|
|
|
|||
|
|
@ -3699,8 +3699,7 @@ Otherwise, use the current value of `process-mark'."
|
|||
Strings and numbers are JSON-encoded. Lists (including nil) are
|
||||
made into JavaScript array literals and their contents encoded
|
||||
with `js--js-encode-value'."
|
||||
(cond ((stringp x) (json-encode-string x))
|
||||
((numberp x) (json-encode-number x))
|
||||
(cond ((or (stringp x) (numberp x)) (json-encode x))
|
||||
((symbolp x) (format "{objid:%S}" (symbol-name x)))
|
||||
((js--js-handle-p x)
|
||||
|
||||
|
|
@ -4390,7 +4389,8 @@ If one hasn't been set, or if it's stale, prompt for a new one."
|
|||
(with-temp-buffer
|
||||
(insert js--js-inserter)
|
||||
(insert "(")
|
||||
(insert (json-encode-list defun-info))
|
||||
(let ((standard-output (current-buffer)))
|
||||
(json--print-list defun-info))
|
||||
(insert ",\n")
|
||||
(insert defun-body)
|
||||
(insert "\n)")
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
(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 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 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 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)))
|
||||
"{\"a\":1}"))
|
||||
(should (equal (json-encode-hash-table
|
||||
#s(hash-table test equal data ("t" 1)))
|
||||
"{\"t\":1}"))
|
||||
(should (equal (json-encode-hash-table
|
||||
#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
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue