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)
58 (defalias 'json-encode-char0 'encode-char)
59 (defalias 'json-decode-char0 'decode-char)
64 (defvar json-object-type 'alist
65 "Type to convert JSON objects to.
66 Must be one of `alist', `plist', or `hash-table'. Consider let-binding
67 this around your call to `json-read' instead of `setq'ing it.")
69 (defvar json-array-type 'vector
70 "Type to convert JSON arrays to.
71 Must be one of `vector' or `list'. Consider let-binding this around
72 your call to `json-read' instead of `setq'ing it.")
74 (defvar json-key-type nil
75 "Type to convert JSON keys to.
76 Must be one of `string', `symbol', `keyword', or nil.
78 If nil, `json-read' will guess the type based on the value of
81 If `json-object-type' is: nil will be interpreted as:
86 Note that values other than `string' might behave strangely for
87 Sufficiently Weird keys. Consider let-binding this around your call to
88 `json-read' instead of `setq'ing it.")
90 (defvar json-false :json-false
91 "Value to use when reading JSON `false'.
92 If this has the same value as `json-null', you might not be able to tell
93 the difference between `false' and `null'. Consider let-binding this
94 around your call to `json-read' instead of `setq'ing it.")
97 "Value to use when reading JSON `null'.
98 If this has the same value as `json-false', you might not be able to
99 tell the difference between `false' and `null'. Consider let-binding
100 this around your call to `json-read' instead of `setq'ing it.")
102 (defvar json-encoding-separator ","
103 "Value to use as an element separator when encoding.")
105 (defvar json-encoding-default-indentation " "
106 "The default indentation level for encoding.
107 Used only when `json-encoding-pretty-print' is non-nil.")
109 (defvar json--encoding-current-indentation "\n"
110 "Internally used to keep track of the current indentation level of encoding.
111 Used only when `json-encoding-pretty-print' is non-nil.")
113 (defvar json-encoding-pretty-print nil
114 "If non-nil, then the output of `json-encode' will be pretty-printed.")
116 (defvar json-encoding-lisp-style-closings nil
117 "If non-nil, ] and } closings will be formatted lisp-style,
118 without indentation.")
124 (defun json-join (strings separator)
125 "Join STRINGS with SEPARATOR."
126 (mapconcat 'identity strings separator))
128 (defun json-alist-p (list)
129 "Non-null if and only if LIST is an alist with simple keys."
131 (setq list (if (and (consp (car list))
137 (defun json-plist-p (list)
138 "Non-null if and only if LIST is a plist."
140 (setq list (if (and (keywordp (car list))
146 (defmacro json--with-indentation (body)
147 `(let ((json--encoding-current-indentation
148 (if json-encoding-pretty-print
149 (concat json--encoding-current-indentation
150 json-encoding-default-indentation)
156 (defsubst json-advance (&optional n)
157 "Skip past the following N characters."
160 (defsubst json-peek ()
161 "Return the character at point."
162 (let ((char (char-after (point))))
163 (or char :json-eof)))
165 (defsubst json-pop ()
166 "Advance past the character at point, returning it."
167 (let ((char (json-peek)))
168 (if (eq char :json-eof)
169 (signal 'json-end-of-file nil)
173 (defun json-skip-whitespace ()
174 "Skip past the whitespace at point."
175 (skip-chars-forward "\t\r\n\f\b "))
181 (define-error 'json-error "Unknown JSON error")
182 (define-error 'json-readtable-error "JSON readtable error" 'json-error)
183 (define-error 'json-unknown-keyword "Unrecognized keyword" 'json-error)
184 (define-error 'json-number-format "Invalid number format" 'json-error)
185 (define-error 'json-string-escape "Bad Unicode escape" 'json-error)
186 (define-error 'json-string-format "Bad string format" 'json-error)
187 (define-error 'json-key-format "Bad JSON object key" 'json-error)
188 (define-error 'json-object-format "Bad JSON object" 'json-error)
189 (define-error 'json-end-of-file "End of file while parsing JSON"
190 '(end-of-file json-error))
196 (defvar json-keywords '("true" "false" "null")
197 "List of JSON keywords.")
201 (defun json-read-keyword (keyword)
202 "Read a JSON keyword at point.
203 KEYWORD is the keyword expected."
204 (unless (member keyword json-keywords)
205 (signal 'json-unknown-keyword (list keyword)))
207 (unless (char-equal char (json-peek))
208 (signal 'json-unknown-keyword
209 (list (save-excursion
211 (thing-at-point 'word)))))
214 (unless (looking-at "\\(\\s-\\|[],}]\\|$\\)")
215 (signal 'json-unknown-keyword
216 (list (save-excursion
218 (thing-at-point 'word)))))
219 (cond ((string-equal keyword "true") t)
220 ((string-equal keyword "false") json-false)
221 ((string-equal keyword "null") json-null)))
225 (defun json-encode-keyword (keyword)
226 "Encode KEYWORD as a JSON value."
227 (cond ((eq keyword t) "true")
228 ((eq keyword json-false) "false")
229 ((eq keyword json-null) "null")))
235 (defun json-read-number (&optional sign)
236 "Read the JSON number following point.
237 The optional SIGN argument is for internal use.
239 N.B.: Only numbers which can fit in Emacs Lisp's native number
240 representation will be parsed correctly."
241 ;; If SIGN is non-nil, the number is explicitly signed.
243 "\\([0-9]+\\)?\\(\\.[0-9]+\\)?\\([Ee][+-]?[0-9]+\\)?"))
244 (cond ((and (null sign) (char-equal (json-peek) ?-))
246 (- (json-read-number t)))
247 ((and (null sign) (char-equal (json-peek) ?+))
249 (json-read-number t))
250 ((and (looking-at number-regexp)
251 (or (match-beginning 1)
252 (match-beginning 2)))
253 (goto-char (match-end 0))
254 (string-to-number (match-string 0)))
255 (t (signal 'json-number-format (list (point)))))))
259 (defun json-encode-number (number)
260 "Return a JSON representation of NUMBER."
261 (format "%s" number))
265 (defvar json-special-chars
274 "Characters which are escaped in JSON, with their elisp counterparts.")
278 (defun json-read-escaped-char ()
279 "Read the JSON string escaped character at point."
282 (let* ((char (json-pop))
283 (special (assq char json-special-chars)))
285 (special (cdr special))
286 ((not (eq char ?u)) char)
287 ((looking-at "[0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f]")
288 (let ((hex (match-string 0)))
290 (json-decode-char0 'ucs (string-to-number hex 16))))
292 (signal 'json-string-escape (list (point)))))))
294 (defun json-read-string ()
295 "Read the JSON string at point."
296 (unless (char-equal (json-peek) ?\")
297 (signal 'json-string-format (list "doesn't start with '\"'!")))
300 (let ((characters '())
302 (while (not (char-equal char ?\"))
303 (push (if (char-equal char ?\\)
304 (json-read-escaped-char)
307 (setq char (json-peek)))
311 (apply 'string (nreverse characters))
316 (defun json-encode-char (char)
317 "Encode CHAR as a JSON string."
318 (setq char (json-encode-char0 char 'ucs))
319 (let ((control-char (car (rassoc char json-special-chars))))
321 ;; Special JSON character (\n, \r, etc.).
323 (format "\\%c" control-char))
324 ;; ASCIIish printable character.
325 ((and (> char 31) (< char 127))
327 ;; Fallback: UCS code point in \uNNNN form.
329 (format "\\u%04x" char)))))
331 (defun json-encode-string (string)
332 "Return a JSON representation of STRING."
333 (format "\"%s\"" (mapconcat 'json-encode-char string "")))
335 (defun json-encode-key (object)
336 "Return a JSON representation of OBJECT.
337 If the resulting JSON object isn't a valid JSON object key,
338 this signals `json-key-format'."
339 (let ((encoded (json-encode object)))
340 (unless (stringp (json-read-from-string encoded))
341 (signal 'json-key-format (list object)))
346 (defun json-new-object ()
347 "Create a new Elisp object corresponding to a JSON object.
348 Please see the documentation of `json-object-type'."
349 (cond ((eq json-object-type 'hash-table)
350 (make-hash-table :test 'equal))
354 (defun json-add-to-object (object key value)
355 "Add a new KEY -> VALUE association to OBJECT.
356 Returns the updated object, which you should save, e.g.:
357 (setq obj (json-add-to-object obj \"foo\" \"bar\"))
358 Please see the documentation of `json-object-type' and `json-key-type'."
360 (if (eq json-key-type nil)
361 (cdr (assq json-object-type '((hash-table . string)
366 (cond ((eq json-key-type 'string)
368 ((eq json-key-type 'symbol)
370 ((eq json-key-type 'keyword)
371 (intern (concat ":" key)))))
372 (cond ((eq json-object-type 'hash-table)
373 (puthash key value object)
375 ((eq json-object-type 'alist)
376 (cons (cons key value) object))
377 ((eq json-object-type 'plist)
378 (cons key (cons value object))))))
380 ;; JSON object parsing
382 (defun json-read-object ()
383 "Read the JSON object at point."
386 (json-skip-whitespace)
387 ;; read key/value pairs until "}"
388 (let ((elements (json-new-object))
390 (while (not (char-equal (json-peek) ?}))
391 (json-skip-whitespace)
392 (setq key (json-read-string))
393 (json-skip-whitespace)
394 (if (char-equal (json-peek) ?:)
396 (signal 'json-object-format (list ":" (json-peek))))
397 (setq value (json-read))
398 (setq elements (json-add-to-object elements key value))
399 (json-skip-whitespace)
400 (unless (char-equal (json-peek) ?})
401 (if (char-equal (json-peek) ?,)
403 (signal 'json-object-format (list "," (json-peek))))))
408 ;; Hash table encoding
410 (defun json-encode-hash-table (hash-table)
411 "Return a JSON representation of HASH-TABLE."
415 (json--with-indentation
419 (if json-encoding-pretty-print
422 json--encoding-current-indentation
428 json-encoding-separator)
429 (if (or (not json-encoding-pretty-print)
430 json-encoding-lisp-style-closings)
432 json--encoding-current-indentation)))
434 ;; List encoding (including alists and plists)
436 (defun json-encode-alist (alist)
437 "Return a JSON representation of ALIST."
440 (json--with-indentation
441 (mapcar (lambda (cons)
442 (format (if json-encoding-pretty-print
445 json--encoding-current-indentation
446 (json-encode-key (car cons))
447 (json-encode (cdr cons))))
449 json-encoding-separator)
450 (if (or (not json-encoding-pretty-print)
451 json-encoding-lisp-style-closings)
453 json--encoding-current-indentation)))
455 (defun json-encode-plist (plist)
456 "Return a JSON representation of PLIST."
458 (json--with-indentation
461 json--encoding-current-indentation
462 (json-encode-key (car plist))
463 (if json-encoding-pretty-print
466 (json-encode (cadr plist)))
468 (setq plist (cddr plist))))
470 (json-join (nreverse result) json-encoding-separator)
471 (if (and json-encoding-pretty-print
472 (not json-encoding-lisp-style-closings))
473 json--encoding-current-indentation
477 (defun json-encode-list (list)
478 "Return a JSON representation of LIST.
479 Tries to DWIM: simple lists become JSON arrays, while alists and plists
480 become JSON objects."
481 (cond ((null list) "null")
482 ((json-alist-p list) (json-encode-alist list))
483 ((json-plist-p list) (json-encode-plist list))
484 ((listp list) (json-encode-array list))
486 (signal 'json-error (list list)))))
492 (defun json-read-array ()
493 "Read the JSON array at point."
496 (json-skip-whitespace)
497 ;; read values until "]"
499 (while (not (char-equal (json-peek) ?\]))
500 (push (json-read) elements)
501 (json-skip-whitespace)
502 (unless (char-equal (json-peek) ?\])
503 (if (char-equal (json-peek) ?,)
505 (signal 'json-error (list 'bleah)))))
508 (apply json-array-type (nreverse elements))))
512 (defun json-encode-array (array)
513 "Return a JSON representation of ARRAY."
514 (if (and json-encoding-pretty-print
515 (> (length array) 0))
517 (json--with-indentation
518 (concat (format "[%s" json--encoding-current-indentation)
519 (json-join (mapcar 'json-encode array)
521 json-encoding-separator
522 json--encoding-current-indentation))))
524 (if json-encoding-lisp-style-closings
526 json--encoding-current-indentation)))
528 (mapconcat 'json-encode array json-encoding-separator)
535 (defvar json-readtable
537 '((?t json-read-keyword "true")
538 (?f json-read-keyword "false")
539 (?n json-read-keyword "null")
540 (?{ json-read-object)
541 (?\[ json-read-array)
542 (?\" json-read-string))))
544 (push (list char 'json-read-number) table))
545 '(?- ?+ ?. ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
547 "Readtable for JSON reader.")
550 "Parse and return the JSON object following point.
551 Advances point just past JSON object."
552 (json-skip-whitespace)
553 (let ((char (json-peek)))
554 (if (not (eq char :json-eof))
555 (let ((record (cdr (assq char json-readtable))))
556 (if (functionp (car record))
557 (apply (car record) (cdr record))
558 (signal 'json-readtable-error record)))
559 (signal 'json-end-of-file nil))))
561 ;; Syntactic sugar for the reader
563 (defun json-read-from-string (string)
564 "Read the JSON object contained in STRING and return it."
567 (goto-char (point-min))
570 (defun json-read-file (file)
571 "Read the first JSON object contained in FILE and return it."
573 (insert-file-contents file)
574 (goto-char (point-min))
581 (defun json-encode (object)
582 "Return a JSON representation of OBJECT as a string."
583 (cond ((memq object (list t json-null json-false))
584 (json-encode-keyword object))
585 ((stringp object) (json-encode-string object))
586 ((keywordp object) (json-encode-string
587 (substring (symbol-name object) 1)))
588 ((symbolp object) (json-encode-string
589 (symbol-name object)))
590 ((numberp object) (json-encode-number object))
591 ((arrayp object) (json-encode-array object))
592 ((hash-table-p object) (json-encode-hash-table object))
593 ((listp object) (json-encode-list object))
594 (t (signal 'json-error (list object)))))
598 (defun json-pretty-print-buffer ()
599 "Pretty-print current buffer."
601 (json-pretty-print (point-min) (point-max)))
603 (defun json-pretty-print (begin end)
604 "Pretty-print selected region."
607 (let ((json-encoding-pretty-print t)
608 (txt (delete-and-extract-region begin end)))
609 (insert (json-encode (json-read-from-string txt))))))
613 ;;; json.el ends here