1 ;;; json.el --- JavaScript Object Notation parser / generator
3 ;; Copyright (C) 2006-2013 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."
131 (setq list (if (consp (car list))
136 (defun json-plist-p (list)
137 "Non-null if and only if LIST is a plist."
139 (setq list (if (and (keywordp (car list))
145 (defmacro json--with-indentation (body)
146 `(let ((json--encoding-current-indentation
147 (if json-encoding-pretty-print
148 (concat json--encoding-current-indentation
149 json-encoding-default-indentation)
155 (defsubst json-advance (&optional n)
156 "Skip past the following N characters."
159 (defsubst json-peek ()
160 "Return the character at point."
161 (let ((char (char-after (point))))
162 (or char :json-eof)))
164 (defsubst json-pop ()
165 "Advance past the character at point, returning it."
166 (let ((char (json-peek)))
167 (if (eq char :json-eof)
168 (signal 'end-of-file nil)
172 (defun json-skip-whitespace ()
173 "Skip past the whitespace at point."
174 (skip-chars-forward "\t\r\n\f\b "))
180 (put 'json-error 'error-message "Unknown JSON error")
181 (put 'json-error 'error-conditions '(json-error error))
183 (put 'json-readtable-error 'error-message "JSON readtable error")
184 (put 'json-readtable-error 'error-conditions
185 '(json-readtable-error json-error error))
187 (put 'json-unknown-keyword 'error-message "Unrecognized keyword")
188 (put 'json-unknown-keyword 'error-conditions
189 '(json-unknown-keyword json-error error))
191 (put 'json-number-format 'error-message "Invalid number format")
192 (put 'json-number-format 'error-conditions
193 '(json-number-format json-error error))
195 (put 'json-string-escape 'error-message "Bad Unicode escape")
196 (put 'json-string-escape 'error-conditions
197 '(json-string-escape json-error error))
199 (put 'json-string-format 'error-message "Bad string format")
200 (put 'json-string-format 'error-conditions
201 '(json-string-format json-error error))
203 (put 'json-key-format 'error-message "Bad JSON object key")
204 (put 'json-key-format 'error-conditions
205 '(json-key-format json-error error))
207 (put 'json-object-format 'error-message "Bad JSON object")
208 (put 'json-object-format 'error-conditions
209 '(json-object-format json-error error))
215 (defvar json-keywords '("true" "false" "null")
216 "List of JSON keywords.")
220 (defun json-read-keyword (keyword)
221 "Read a JSON keyword at point.
222 KEYWORD is the keyword expected."
223 (unless (member keyword json-keywords)
224 (signal 'json-unknown-keyword (list keyword)))
226 (unless (char-equal char (json-peek))
227 (signal 'json-unknown-keyword
228 (list (save-excursion
230 (thing-at-point 'word)))))
233 (unless (looking-at "\\(\\s-\\|[],}]\\|$\\)")
234 (signal 'json-unknown-keyword
235 (list (save-excursion
237 (thing-at-point 'word)))))
238 (cond ((string-equal keyword "true") t)
239 ((string-equal keyword "false") json-false)
240 ((string-equal keyword "null") json-null)))
244 (defun json-encode-keyword (keyword)
245 "Encode KEYWORD as a JSON value."
246 (cond ((eq keyword t) "true")
247 ((eq keyword json-false) "false")
248 ((eq keyword json-null) "null")))
254 (defun json-read-number (&optional sign)
255 "Read the JSON number following point.
256 The optional SIGN argument is for internal use.
258 N.B.: Only numbers which can fit in Emacs Lisp's native number
259 representation will be parsed correctly."
260 ;; If SIGN is non-nil, the number is explicitly signed.
262 "\\([0-9]+\\)?\\(\\.[0-9]+\\)?\\([Ee][+-]?[0-9]+\\)?"))
263 (cond ((and (null sign) (char-equal (json-peek) ?-))
265 (- (json-read-number t)))
266 ((and (null sign) (char-equal (json-peek) ?+))
268 (json-read-number t))
269 ((and (looking-at number-regexp)
270 (or (match-beginning 1)
271 (match-beginning 2)))
272 (goto-char (match-end 0))
273 (string-to-number (match-string 0)))
274 (t (signal 'json-number-format (list (point)))))))
278 (defun json-encode-number (number)
279 "Return a JSON representation of NUMBER."
280 (format "%s" number))
284 (defvar json-special-chars
293 "Characters which are escaped in JSON, with their elisp counterparts.")
297 (defun json-read-escaped-char ()
298 "Read the JSON string escaped character at point."
301 (let* ((char (json-pop))
302 (special (assq char json-special-chars)))
304 (special (cdr special))
305 ((not (eq char ?u)) char)
306 ((looking-at "[0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f]")
307 (let ((hex (match-string 0)))
309 (json-decode-char0 'ucs (string-to-number hex 16))))
311 (signal 'json-string-escape (list (point)))))))
313 (defun json-read-string ()
314 "Read the JSON string at point."
315 (unless (char-equal (json-peek) ?\")
316 (signal 'json-string-format (list "doesn't start with '\"'!")))
319 (let ((characters '())
321 (while (not (char-equal char ?\"))
322 (push (if (char-equal char ?\\)
323 (json-read-escaped-char)
326 (setq char (json-peek)))
330 (apply 'string (nreverse characters))
335 (defun json-encode-char (char)
336 "Encode CHAR as a JSON string."
337 (setq char (json-encode-char0 char 'ucs))
338 (let ((control-char (car (rassoc char json-special-chars))))
340 ;; Special JSON character (\n, \r, etc.).
342 (format "\\%c" control-char))
343 ;; ASCIIish printable character.
344 ((and (> char 31) (< char 127))
346 ;; Fallback: UCS code point in \uNNNN form.
348 (format "\\u%04x" char)))))
350 (defun json-encode-string (string)
351 "Return a JSON representation of STRING."
352 (format "\"%s\"" (mapconcat 'json-encode-char string "")))
354 (defun json-encode-key (object)
355 "Return a JSON representation of OBJECT.
356 If the resulting JSON object isn't a valid JSON object key,
357 this signals `json-key-format'."
358 (let ((encoded (json-encode object)))
359 (unless (stringp (json-read-from-string encoded))
360 (signal 'json-key-format (list object)))
365 (defun json-new-object ()
366 "Create a new Elisp object corresponding to a JSON object.
367 Please see the documentation of `json-object-type'."
368 (cond ((eq json-object-type 'hash-table)
369 (make-hash-table :test 'equal))
373 (defun json-add-to-object (object key value)
374 "Add a new KEY -> VALUE association to OBJECT.
375 Returns the updated object, which you should save, e.g.:
376 (setq obj (json-add-to-object obj \"foo\" \"bar\"))
377 Please see the documentation of `json-object-type' and `json-key-type'."
379 (if (eq json-key-type nil)
380 (cdr (assq json-object-type '((hash-table . string)
385 (cond ((eq json-key-type 'string)
387 ((eq json-key-type 'symbol)
389 ((eq json-key-type 'keyword)
390 (intern (concat ":" key)))))
391 (cond ((eq json-object-type 'hash-table)
392 (puthash key value object)
394 ((eq json-object-type 'alist)
395 (cons (cons key value) object))
396 ((eq json-object-type 'plist)
397 (cons key (cons value object))))))
399 ;; JSON object parsing
401 (defun json-read-object ()
402 "Read the JSON object at point."
405 (json-skip-whitespace)
406 ;; read key/value pairs until "}"
407 (let ((elements (json-new-object))
409 (while (not (char-equal (json-peek) ?}))
410 (json-skip-whitespace)
411 (setq key (json-read-string))
412 (json-skip-whitespace)
413 (if (char-equal (json-peek) ?:)
415 (signal 'json-object-format (list ":" (json-peek))))
416 (setq value (json-read))
417 (setq elements (json-add-to-object elements key value))
418 (json-skip-whitespace)
419 (unless (char-equal (json-peek) ?})
420 (if (char-equal (json-peek) ?,)
422 (signal 'json-object-format (list "," (json-peek))))))
427 ;; Hash table encoding
429 (defun json-encode-hash-table (hash-table)
430 "Return a JSON representation of HASH-TABLE."
434 (json--with-indentation
438 (if json-encoding-pretty-print
441 json--encoding-current-indentation
447 json-encoding-separator)
448 (if (or (not json-encoding-pretty-print)
449 json-encoding-lisp-style-closings)
451 json--encoding-current-indentation)))
453 ;; List encoding (including alists and plists)
455 (defun json-encode-alist (alist)
456 "Return a JSON representation of ALIST."
459 (json--with-indentation
460 (mapcar (lambda (cons)
461 (format (if json-encoding-pretty-print
464 json--encoding-current-indentation
465 (json-encode-key (car cons))
466 (json-encode (cdr cons))))
468 json-encoding-separator)
469 (if (or (not json-encoding-pretty-print)
470 json-encoding-lisp-style-closings)
472 json--encoding-current-indentation)))
474 (defun json-encode-plist (plist)
475 "Return a JSON representation of PLIST."
477 (json--with-indentation
480 json--encoding-current-indentation
481 (json-encode-key (car plist))
482 (if json-encoding-pretty-print
485 (json-encode (cadr plist)))
487 (setq plist (cddr plist))))
489 (json-join (nreverse result) json-encoding-separator)
490 (if (and json-encoding-pretty-print
491 (not json-encoding-lisp-style-closings))
492 json--encoding-current-indentation
496 (defun json-encode-list (list)
497 "Return a JSON representation of LIST.
498 Tries to DWIM: simple lists become JSON arrays, while alists and plists
499 become JSON objects."
500 (cond ((null list) "null")
501 ((json-alist-p list) (json-encode-alist list))
502 ((json-plist-p list) (json-encode-plist list))
503 ((listp list) (json-encode-array list))
505 (signal 'json-error (list list)))))
511 (defun json-read-array ()
512 "Read the JSON array at point."
515 (json-skip-whitespace)
516 ;; read values until "]"
518 (while (not (char-equal (json-peek) ?\]))
519 (push (json-read) elements)
520 (json-skip-whitespace)
521 (unless (char-equal (json-peek) ?\])
522 (if (char-equal (json-peek) ?,)
524 (signal 'json-error (list 'bleah)))))
527 (apply json-array-type (nreverse elements))))
531 (defun json-encode-array (array)
532 "Return a JSON representation of ARRAY."
533 (if (and json-encoding-pretty-print
534 (> (length array) 0))
536 (json--with-indentation
537 (concat (format "[%s" json--encoding-current-indentation)
538 (json-join (mapcar 'json-encode array)
540 json-encoding-separator
541 json--encoding-current-indentation))))
543 (if json-encoding-lisp-style-closings
545 json--encoding-current-indentation)))
547 (mapconcat 'json-encode array json-encoding-separator)
554 (defvar json-readtable
556 '((?t json-read-keyword "true")
557 (?f json-read-keyword "false")
558 (?n json-read-keyword "null")
559 (?{ json-read-object)
560 (?\[ json-read-array)
561 (?\" json-read-string))))
563 (push (list char 'json-read-number) table))
564 '(?- ?+ ?. ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
566 "Readtable for JSON reader.")
569 "Parse and return the JSON object following point.
570 Advances point just past JSON object."
571 (json-skip-whitespace)
572 (let ((char (json-peek)))
573 (if (not (eq char :json-eof))
574 (let ((record (cdr (assq char json-readtable))))
575 (if (functionp (car record))
576 (apply (car record) (cdr record))
577 (signal 'json-readtable-error record)))
578 (signal 'end-of-file nil))))
580 ;; Syntactic sugar for the reader
582 (defun json-read-from-string (string)
583 "Read the JSON object contained in STRING and return it."
586 (goto-char (point-min))
589 (defun json-read-file (file)
590 "Read the first JSON object contained in FILE and return it."
592 (insert-file-contents file)
593 (goto-char (point-min))
600 (defun json-encode (object)
601 "Return a JSON representation of OBJECT as a string."
602 (cond ((memq object (list t json-null json-false))
603 (json-encode-keyword object))
604 ((stringp object) (json-encode-string object))
605 ((keywordp object) (json-encode-string
606 (substring (symbol-name object) 1)))
607 ((symbolp object) (json-encode-string
608 (symbol-name object)))
609 ((numberp object) (json-encode-number object))
610 ((arrayp object) (json-encode-array object))
611 ((hash-table-p object) (json-encode-hash-table object))
612 ((listp object) (json-encode-list object))
613 (t (signal 'json-error (list object)))))
617 (defun json-pretty-print-buffer ()
618 "Pretty-print current buffer."
620 (json-pretty-print (point-min) (point-max)))
622 (defun json-pretty-print (begin end)
623 "Pretty-print selected region."
626 (let ((json-encoding-pretty-print t)
627 (txt (delete-and-extract-region begin end)))
628 (insert (json-encode (json-read-from-string txt))))))
632 ;;; json.el ends here