1 ;;; json.el --- JavaScript Object Notation parser / generator
3 ;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
5 ;; Author: Edward O'Connor <ted@oconnor.cx>
7 ;; Keywords: convenience
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26 ;; This is a library for parsing and generating JSON (JavaScript Object
29 ;; Learn all about JSON here: <URL:http://json.org/>.
31 ;; The user-serviceable entry points for the parser are the functions
32 ;; `json-read' and `json-read-from-string'. The encoder has a single
33 ;; entry point, `json-encode'.
35 ;; Since there are several natural representations of key-value pair
36 ;; mappings in elisp (alist, plist, hash-table), `json-read' allows you
37 ;; to specify which you'd prefer (see `json-object-type' and
38 ;; `json-array-type').
40 ;; Similarly, since `false' and `null' are distinct in JSON, you can
41 ;; distinguish them by binding `json-false' and `json-null' as desired.
45 ;; 2006-03-11 - Initial version.
46 ;; 2006-03-13 - Added JSON generation in addition to parsing. Various
47 ;; other cleanups, bugfixes, and improvements.
48 ;; 2006-12-29 - XEmacs support, from Aidan Kehoe <kehoea@parhasard.net>.
49 ;; 2008-02-21 - Installed in GNU Emacs.
50 ;; 2011-10-17 - Patch `json-alist-p' and `json-plist-p' to avoid recursion -tzz
51 ;; 2012-10-25 - Added pretty-printed reformatting -Ryan Crum (ryan@ryancrum.org)
57 (defvar json-object-type 'alist
58 "Type to convert JSON objects to.
59 Must be one of `alist', `plist', or `hash-table'. Consider let-binding
60 this around your call to `json-read' instead of `setq'ing it. Ordering
61 is maintained for `alist' and `plist', but not for `hash-table'.")
63 (defvar json-array-type 'vector
64 "Type to convert JSON arrays to.
65 Must be one of `vector' or `list'. Consider let-binding this around
66 your call to `json-read' instead of `setq'ing it.")
68 (defvar json-key-type nil
69 "Type to convert JSON keys to.
70 Must be one of `string', `symbol', `keyword', or nil.
72 If nil, `json-read' will guess the type based on the value of
75 If `json-object-type' is: nil will be interpreted as:
80 Note that values other than `string' might behave strangely for
81 Sufficiently Weird keys. Consider let-binding this around your call to
82 `json-read' instead of `setq'ing it.")
84 (defvar json-false :json-false
85 "Value to use when reading JSON `false'.
86 If this has the same value as `json-null', you might not be able to tell
87 the difference between `false' and `null'. Consider let-binding this
88 around your call to `json-read' instead of `setq'ing it.")
91 "Value to use when reading JSON `null'.
92 If this has the same value as `json-false', you might not be able to
93 tell the difference between `false' and `null'. Consider let-binding
94 this around your call to `json-read' instead of `setq'ing it.")
96 (defvar json-encoding-separator ","
97 "Value to use as an element separator when encoding.")
99 (defvar json-encoding-default-indentation " "
100 "The default indentation level for encoding.
101 Used only when `json-encoding-pretty-print' is non-nil.")
103 (defvar json--encoding-current-indentation "\n"
104 "Internally used to keep track of the current indentation level of encoding.
105 Used only when `json-encoding-pretty-print' is non-nil.")
107 (defvar json-encoding-pretty-print nil
108 "If non-nil, then the output of `json-encode' will be pretty-printed.")
110 (defvar json-encoding-lisp-style-closings nil
111 "If non-nil, ] and } closings will be formatted lisp-style,
112 without indentation.")
114 (defvar json-pre-element-read-function nil
115 "Function called (if non-nil) by `json-read-array' and
116 `json-read-object' right before reading a JSON array or object,
117 respectively. The function is called with one argument, which is
118 the current JSON key.")
120 (defvar json-post-element-read-function nil
121 "Function called (if non-nil) by `json-read-array' and
122 `json-read-object' right after reading a JSON array or object,
129 (defun json-join (strings separator)
130 "Join STRINGS with SEPARATOR."
131 (mapconcat 'identity strings separator))
133 (defun json-alist-p (list)
134 "Non-null if and only if LIST is an alist with simple keys."
136 (setq list (if (and (consp (car list))
142 (defun json-plist-p (list)
143 "Non-null if and only if LIST is a plist."
145 (setq list (if (and (keywordp (car list))
151 (defun json--plist-reverse (plist)
152 "Return a copy of PLIST in reverse order.
153 Unlike `reverse', this keeps the property-value pairs intact."
156 (let ((prop (pop plist))
162 (defmacro json--with-indentation (body)
163 `(let ((json--encoding-current-indentation
164 (if json-encoding-pretty-print
165 (concat json--encoding-current-indentation
166 json-encoding-default-indentation)
172 (defsubst json-advance (&optional n)
173 "Skip past the following N characters."
176 (defsubst json-peek ()
177 "Return the character at point."
178 (let ((char (char-after (point))))
179 (or char :json-eof)))
181 (defsubst json-pop ()
182 "Advance past the character at point, returning it."
183 (let ((char (json-peek)))
184 (if (eq char :json-eof)
185 (signal 'json-end-of-file nil)
189 (defun json-skip-whitespace ()
190 "Skip past the whitespace at point."
191 (skip-chars-forward "\t\r\n\f\b "))
197 (define-error 'json-error "Unknown JSON error")
198 (define-error 'json-readtable-error "JSON readtable error" 'json-error)
199 (define-error 'json-unknown-keyword "Unrecognized keyword" 'json-error)
200 (define-error 'json-number-format "Invalid number format" 'json-error)
201 (define-error 'json-string-escape "Bad Unicode escape" 'json-error)
202 (define-error 'json-string-format "Bad string format" 'json-error)
203 (define-error 'json-key-format "Bad JSON object key" 'json-error)
204 (define-error 'json-object-format "Bad JSON object" 'json-error)
205 (define-error 'json-end-of-file "End of file while parsing JSON"
206 '(end-of-file json-error))
212 (defvar json--path '()
213 "Used internally by `json-path-to-position' to keep track of
214 the path during recursive calls to `json-read'.")
216 (defun json--record-path (key)
217 "Record the KEY to the current JSON path.
218 Used internally by `json-path-to-position'."
219 (push (cons (point) key) json--path))
221 (defun json--check-position (position)
222 "Check if the last parsed JSON structure passed POSITION.
223 Used internally by `json-path-to-position'."
224 (let ((start (caar json--path)))
225 (when (< start position (+ (point) 1))
226 (throw :json-path (list :path (nreverse (mapcar #'cdr json--path))
228 :match-end (point)))))
231 (defun json-path-to-position (position &optional string)
232 "Return the path to the JSON element at POSITION.
234 When STRING is provided, return the path to the position in the
235 string, else to the position in the current buffer.
237 The return value is a property list with the following
240 :path -- A list of strings and numbers forming the path to
241 the JSON element at the given position. Strings
242 denote object names, while numbers denote array
245 :match-start -- Position where the matched JSON element begins.
247 :match-end -- Position where the matched JSON element ends.
249 This can for instance be useful to determine the path to a JSON
250 element in a deeply nested structure."
253 (goto-char (point-min)))
254 (let* ((json--path '())
255 (json-pre-element-read-function #'json--record-path)
256 (json-post-element-read-function
257 (apply-partially #'json--check-position position))
258 (path (catch :json-path
260 (json-read-from-string string)
262 (when (plist-get path :path)
267 (defvar json-keywords '("true" "false" "null")
268 "List of JSON keywords.")
272 (defun json-read-keyword (keyword)
273 "Read a JSON keyword at point.
274 KEYWORD is the keyword expected."
275 (unless (member keyword json-keywords)
276 (signal 'json-unknown-keyword (list keyword)))
278 (unless (char-equal char (json-peek))
279 (signal 'json-unknown-keyword
280 (list (save-excursion
282 (thing-at-point 'word)))))
285 (unless (looking-at "\\(\\s-\\|[],}]\\|$\\)")
286 (signal 'json-unknown-keyword
287 (list (save-excursion
289 (thing-at-point 'word)))))
290 (cond ((string-equal keyword "true") t)
291 ((string-equal keyword "false") json-false)
292 ((string-equal keyword "null") json-null)))
296 (defun json-encode-keyword (keyword)
297 "Encode KEYWORD as a JSON value."
298 (cond ((eq keyword t) "true")
299 ((eq keyword json-false) "false")
300 ((eq keyword json-null) "null")))
306 (defun json-read-number (&optional sign)
307 "Read the JSON number following point.
308 The optional SIGN argument is for internal use.
310 N.B.: Only numbers which can fit in Emacs Lisp's native number
311 representation will be parsed correctly."
312 ;; If SIGN is non-nil, the number is explicitly signed.
314 "\\([0-9]+\\)?\\(\\.[0-9]+\\)?\\([Ee][+-]?[0-9]+\\)?"))
315 (cond ((and (null sign) (char-equal (json-peek) ?-))
317 (- (json-read-number t)))
318 ((and (null sign) (char-equal (json-peek) ?+))
320 (json-read-number t))
321 ((and (looking-at number-regexp)
322 (or (match-beginning 1)
323 (match-beginning 2)))
324 (goto-char (match-end 0))
325 (string-to-number (match-string 0)))
326 (t (signal 'json-number-format (list (point)))))))
330 (defun json-encode-number (number)
331 "Return a JSON representation of NUMBER."
332 (format "%s" number))
336 (defvar json-special-chars
344 "Characters which are escaped in JSON, with their elisp counterparts.")
348 (defun json-read-escaped-char ()
349 "Read the JSON string escaped character at point."
352 (let* ((char (json-pop))
353 (special (assq char json-special-chars)))
355 (special (cdr special))
356 ((not (eq char ?u)) char)
357 ((looking-at "[0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f]")
358 (let ((hex (match-string 0)))
360 (string-to-number hex 16)))
362 (signal 'json-string-escape (list (point)))))))
364 (defun json-read-string ()
365 "Read the JSON string at point."
366 (unless (char-equal (json-peek) ?\")
367 (signal 'json-string-format (list "doesn't start with `\"'!")))
370 (let ((characters '())
372 (while (not (char-equal char ?\"))
373 (push (if (char-equal char ?\\)
374 (json-read-escaped-char)
377 (setq char (json-peek)))
381 (apply 'string (nreverse characters))
386 (defun json-encode-string (string)
387 "Return a JSON representation of STRING."
388 ;; Reimplement the meat of `replace-regexp-in-string', for
389 ;; performance (bug#20154).
390 (let ((l (length string))
393 ;; Only escape quotation mark, backslash and the control
394 ;; characters U+0000 to U+001F (RFC 4627, ECMA-404).
395 (while (setq mb (string-match "[\"\\[:cntrl:]]" string start))
396 (let* ((c (aref string mb))
397 (special (rassq c json-special-chars)))
398 (push (substring string start mb) res)
400 ;; Special JSON character (\n, \r, etc.).
401 (string ?\\ (car special))
402 ;; Fallback: UCS code point in \uNNNN form.
403 (format "\\u%04x" c))
405 (setq start (1+ mb))))
406 (push (substring string start l) res)
408 (apply #'concat "\"" (nreverse res))))
410 (defun json-encode-key (object)
411 "Return a JSON representation of OBJECT.
412 If the resulting JSON object isn't a valid JSON object key,
413 this signals `json-key-format'."
414 (let ((encoded (json-encode object)))
415 (unless (stringp (json-read-from-string encoded))
416 (signal 'json-key-format (list object)))
421 (defun json-new-object ()
422 "Create a new Elisp object corresponding to a JSON object.
423 Please see the documentation of `json-object-type'."
424 (cond ((eq json-object-type 'hash-table)
425 (make-hash-table :test 'equal))
429 (defun json-add-to-object (object key value)
430 "Add a new KEY -> VALUE association to OBJECT.
431 Returns the updated object, which you should save, e.g.:
432 (setq obj (json-add-to-object obj \"foo\" \"bar\"))
433 Please see the documentation of `json-object-type' and `json-key-type'."
435 (if (eq json-key-type nil)
436 (cdr (assq json-object-type '((hash-table . string)
441 (cond ((eq json-key-type 'string)
443 ((eq json-key-type 'symbol)
445 ((eq json-key-type 'keyword)
446 (intern (concat ":" key)))))
447 (cond ((eq json-object-type 'hash-table)
448 (puthash key value object)
450 ((eq json-object-type 'alist)
451 (cons (cons key value) object))
452 ((eq json-object-type 'plist)
453 (cons key (cons value object))))))
455 ;; JSON object parsing
457 (defun json-read-object ()
458 "Read the JSON object at point."
461 (json-skip-whitespace)
462 ;; read key/value pairs until "}"
463 (let ((elements (json-new-object))
465 (while (not (char-equal (json-peek) ?}))
466 (json-skip-whitespace)
467 (setq key (json-read-string))
468 (json-skip-whitespace)
469 (if (char-equal (json-peek) ?:)
471 (signal 'json-object-format (list ":" (json-peek))))
472 (json-skip-whitespace)
473 (when json-pre-element-read-function
474 (funcall json-pre-element-read-function key))
475 (setq value (json-read))
476 (when json-post-element-read-function
477 (funcall json-post-element-read-function))
478 (setq elements (json-add-to-object elements key value))
479 (json-skip-whitespace)
480 (unless (char-equal (json-peek) ?})
481 (if (char-equal (json-peek) ?,)
483 (signal 'json-object-format (list "," (json-peek))))))
486 (pcase json-object-type
487 (`alist (nreverse elements))
488 (`plist (json--plist-reverse elements))
491 ;; Hash table encoding
493 (defun json-encode-hash-table (hash-table)
494 "Return a JSON representation of HASH-TABLE."
498 (json--with-indentation
502 (if json-encoding-pretty-print
505 json--encoding-current-indentation
511 json-encoding-separator)
512 (if (or (not json-encoding-pretty-print)
513 json-encoding-lisp-style-closings)
515 json--encoding-current-indentation)))
517 ;; List encoding (including alists and plists)
519 (defun json-encode-alist (alist)
520 "Return a JSON representation of ALIST."
523 (json--with-indentation
524 (mapcar (lambda (cons)
525 (format (if json-encoding-pretty-print
528 json--encoding-current-indentation
529 (json-encode-key (car cons))
530 (json-encode (cdr cons))))
532 json-encoding-separator)
533 (if (or (not json-encoding-pretty-print)
534 json-encoding-lisp-style-closings)
536 json--encoding-current-indentation)))
538 (defun json-encode-plist (plist)
539 "Return a JSON representation of PLIST."
541 (json--with-indentation
544 json--encoding-current-indentation
545 (json-encode-key (car plist))
546 (if json-encoding-pretty-print
549 (json-encode (cadr plist)))
551 (setq plist (cddr plist))))
553 (json-join (nreverse result) json-encoding-separator)
554 (if (and json-encoding-pretty-print
555 (not json-encoding-lisp-style-closings))
556 json--encoding-current-indentation
560 (defun json-encode-list (list)
561 "Return a JSON representation of LIST.
562 Tries to DWIM: simple lists become JSON arrays, while alists and plists
563 become JSON objects."
564 (cond ((null list) "null")
565 ((json-alist-p list) (json-encode-alist list))
566 ((json-plist-p list) (json-encode-plist list))
567 ((listp list) (json-encode-array list))
569 (signal 'json-error (list list)))))
575 (defun json-read-array ()
576 "Read the JSON array at point."
579 (json-skip-whitespace)
580 ;; read values until "]"
582 (while (not (char-equal (json-peek) ?\]))
583 (json-skip-whitespace)
584 (when json-pre-element-read-function
585 (funcall json-pre-element-read-function (length elements)))
586 (push (json-read) elements)
587 (when json-post-element-read-function
588 (funcall json-post-element-read-function))
589 (json-skip-whitespace)
590 (unless (char-equal (json-peek) ?\])
591 (if (char-equal (json-peek) ?,)
593 (signal 'json-error (list 'bleah)))))
596 (apply json-array-type (nreverse elements))))
600 (defun json-encode-array (array)
601 "Return a JSON representation of ARRAY."
602 (if (and json-encoding-pretty-print
603 (> (length array) 0))
605 (json--with-indentation
606 (concat (format "[%s" json--encoding-current-indentation)
607 (json-join (mapcar 'json-encode array)
609 json-encoding-separator
610 json--encoding-current-indentation))))
612 (if json-encoding-lisp-style-closings
614 json--encoding-current-indentation)))
616 (mapconcat 'json-encode array json-encoding-separator)
623 (defvar json-readtable
625 '((?t json-read-keyword "true")
626 (?f json-read-keyword "false")
627 (?n json-read-keyword "null")
628 (?{ json-read-object)
629 (?\[ json-read-array)
630 (?\" json-read-string))))
632 (push (list char 'json-read-number) table))
633 '(?- ?+ ?. ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
635 "Readtable for JSON reader.")
638 "Parse and return the JSON object following point.
639 Advances point just past JSON object."
640 (json-skip-whitespace)
641 (let ((char (json-peek)))
642 (if (not (eq char :json-eof))
643 (let ((record (cdr (assq char json-readtable))))
644 (if (functionp (car record))
645 (apply (car record) (cdr record))
646 (signal 'json-readtable-error record)))
647 (signal 'json-end-of-file nil))))
649 ;; Syntactic sugar for the reader
651 (defun json-read-from-string (string)
652 "Read the JSON object contained in STRING and return it."
655 (goto-char (point-min))
658 (defun json-read-file (file)
659 "Read the first JSON object contained in FILE and return it."
661 (insert-file-contents file)
662 (goto-char (point-min))
669 (defun json-encode (object)
670 "Return a JSON representation of OBJECT as a string."
671 (cond ((memq object (list t json-null json-false))
672 (json-encode-keyword object))
673 ((stringp object) (json-encode-string object))
674 ((keywordp object) (json-encode-string
675 (substring (symbol-name object) 1)))
676 ((symbolp object) (json-encode-string
677 (symbol-name object)))
678 ((numberp object) (json-encode-number object))
679 ((arrayp object) (json-encode-array object))
680 ((hash-table-p object) (json-encode-hash-table object))
681 ((listp object) (json-encode-list object))
682 (t (signal 'json-error (list object)))))
686 (defun json-pretty-print-buffer ()
687 "Pretty-print current buffer."
689 (json-pretty-print (point-min) (point-max)))
691 (defun json-pretty-print (begin end)
692 "Pretty-print selected region."
695 (let ((json-encoding-pretty-print t)
696 ;; Ensure that ordering is maintained
697 (json-object-type 'alist)
698 (txt (delete-and-extract-region begin end)))
699 (insert (json-encode (json-read-from-string txt))))))
703 ;;; json.el ends here