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
54 (eval-when-compile (require 'cl))
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.")
106 (defun json-join (strings separator)
107 "Join STRINGS with SEPARATOR."
108 (mapconcat 'identity strings separator))
110 (defun json-alist-p (list)
111 "Non-null if and only if LIST is an alist."
113 (setq list (if (consp (car list))
118 (defun json-plist-p (list)
119 "Non-null if and only if LIST is a plist."
121 (setq list (if (and (keywordp (car list))
129 (defsubst json-advance (&optional n)
130 "Skip past the following N characters."
133 (defsubst json-peek ()
134 "Return the character at point."
135 (let ((char (char-after (point))))
136 (or char :json-eof)))
138 (defsubst json-pop ()
139 "Advance past the character at point, returning it."
140 (let ((char (json-peek)))
141 (if (eq char :json-eof)
142 (signal 'end-of-file nil)
146 (defun json-skip-whitespace ()
147 "Skip past the whitespace at point."
148 (skip-chars-forward "\t\r\n\f\b "))
154 (put 'json-error 'error-message "Unknown JSON error")
155 (put 'json-error 'error-conditions '(json-error error))
157 (put 'json-readtable-error 'error-message "JSON readtable error")
158 (put 'json-readtable-error 'error-conditions
159 '(json-readtable-error json-error error))
161 (put 'json-unknown-keyword 'error-message "Unrecognized keyword")
162 (put 'json-unknown-keyword 'error-conditions
163 '(json-unknown-keyword json-error error))
165 (put 'json-number-format 'error-message "Invalid number format")
166 (put 'json-number-format 'error-conditions
167 '(json-number-format json-error error))
169 (put 'json-string-escape 'error-message "Bad Unicode escape")
170 (put 'json-string-escape 'error-conditions
171 '(json-string-escape json-error error))
173 (put 'json-string-format 'error-message "Bad string format")
174 (put 'json-string-format 'error-conditions
175 '(json-string-format json-error error))
177 (put 'json-key-format 'error-message "Bad JSON object key")
178 (put 'json-key-format 'error-conditions
179 '(json-key-format json-error error))
181 (put 'json-object-format 'error-message "Bad JSON object")
182 (put 'json-object-format 'error-conditions
183 '(json-object-format json-error error))
189 (defvar json-keywords '("true" "false" "null")
190 "List of JSON keywords.")
194 (defun json-read-keyword (keyword)
195 "Read a JSON keyword at point.
196 KEYWORD is the keyword expected."
197 (unless (member keyword json-keywords)
198 (signal 'json-unknown-keyword (list keyword)))
200 (unless (char-equal char (json-peek))
201 (signal 'json-unknown-keyword
202 (list (save-excursion
204 (thing-at-point 'word)))))
207 (unless (looking-at "\\(\\s-\\|[],}]\\|$\\)")
208 (signal 'json-unknown-keyword
209 (list (save-excursion
211 (thing-at-point 'word)))))
212 (cond ((string-equal keyword "true") t)
213 ((string-equal keyword "false") json-false)
214 ((string-equal keyword "null") json-null)))
218 (defun json-encode-keyword (keyword)
219 "Encode KEYWORD as a JSON value."
220 (cond ((eq keyword t) "true")
221 ((eq keyword json-false) "false")
222 ((eq keyword json-null) "null")))
228 (defun json-read-number (&optional sign)
229 "Read the JSON number following point.
230 The optional SIGN argument is for internal use.
232 N.B.: Only numbers which can fit in Emacs Lisp's native number
233 representation will be parsed correctly."
234 ;; If SIGN is non-nil, the number is explicitly signed.
236 "\\([0-9]+\\)?\\(\\.[0-9]+\\)?\\([Ee][+-]?[0-9]+\\)?"))
237 (cond ((and (null sign) (char-equal (json-peek) ?-))
239 (- (json-read-number t)))
240 ((and (null sign) (char-equal (json-peek) ?+))
242 (json-read-number t))
243 ((and (looking-at number-regexp)
244 (or (match-beginning 1)
245 (match-beginning 2)))
246 (goto-char (match-end 0))
247 (string-to-number (match-string 0)))
248 (t (signal 'json-number-format (list (point)))))))
252 (defun json-encode-number (number)
253 "Return a JSON representation of NUMBER."
254 (format "%s" number))
258 (defvar json-special-chars
267 "Characters which are escaped in JSON, with their elisp counterparts.")
271 (defun json-read-escaped-char ()
272 "Read the JSON string escaped character at point."
275 (let* ((char (json-pop))
276 (special (assq char json-special-chars)))
278 (special (cdr special))
279 ((not (eq char ?u)) char)
280 ((looking-at "[0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f]")
281 (let ((hex (match-string 0)))
283 (json-decode-char0 'ucs (string-to-number hex 16))))
285 (signal 'json-string-escape (list (point)))))))
287 (defun json-read-string ()
288 "Read the JSON string at point."
289 (unless (char-equal (json-peek) ?\")
290 (signal 'json-string-format (list "doesn't start with '\"'!")))
293 (let ((characters '())
295 (while (not (char-equal char ?\"))
296 (push (if (char-equal char ?\\)
297 (json-read-escaped-char)
300 (setq char (json-peek)))
304 (apply 'string (nreverse characters))
309 (defun json-encode-char (char)
310 "Encode CHAR as a JSON string."
311 (setq char (json-encode-char0 char 'ucs))
312 (let ((control-char (car (rassoc char json-special-chars))))
314 ;; Special JSON character (\n, \r, etc.).
316 (format "\\%c" control-char))
317 ;; ASCIIish printable character.
318 ((and (> char 31) (< char 127))
320 ;; Fallback: UCS code point in \uNNNN form.
322 (format "\\u%04x" char)))))
324 (defun json-encode-string (string)
325 "Return a JSON representation of STRING."
326 (format "\"%s\"" (mapconcat 'json-encode-char string "")))
328 (defun json-encode-key (object)
329 "Return a JSON representation of OBJECT.
330 If the resulting JSON object isn't a valid JSON object key,
331 this signals `json-key-format'."
332 (let ((encoded (json-encode object)))
333 (unless (stringp (json-read-from-string encoded))
334 (signal 'json-key-format (list object)))
339 (defun json-new-object ()
340 "Create a new Elisp object corresponding to a JSON object.
341 Please see the documentation of `json-object-type'."
342 (cond ((eq json-object-type 'hash-table)
343 (make-hash-table :test 'equal))
347 (defun json-add-to-object (object key value)
348 "Add a new KEY -> VALUE association to OBJECT.
349 Returns the updated object, which you should save, e.g.:
350 (setq obj (json-add-to-object obj \"foo\" \"bar\"))
351 Please see the documentation of `json-object-type' and `json-key-type'."
353 (if (eq json-key-type nil)
354 (cdr (assq json-object-type '((hash-table . string)
359 (cond ((eq json-key-type 'string)
361 ((eq json-key-type 'symbol)
363 ((eq json-key-type 'keyword)
364 (intern (concat ":" key)))))
365 (cond ((eq json-object-type 'hash-table)
366 (puthash key value object)
368 ((eq json-object-type 'alist)
369 (cons (cons key value) object))
370 ((eq json-object-type 'plist)
371 (cons key (cons value object))))))
373 ;; JSON object parsing
375 (defun json-read-object ()
376 "Read the JSON object at point."
379 (json-skip-whitespace)
380 ;; read key/value pairs until "}"
381 (let ((elements (json-new-object))
383 (while (not (char-equal (json-peek) ?}))
384 (json-skip-whitespace)
385 (setq key (json-read-string))
386 (json-skip-whitespace)
387 (if (char-equal (json-peek) ?:)
389 (signal 'json-object-format (list ":" (json-peek))))
390 (setq value (json-read))
391 (setq elements (json-add-to-object elements key value))
392 (json-skip-whitespace)
393 (unless (char-equal (json-peek) ?})
394 (if (char-equal (json-peek) ?,)
396 (signal 'json-object-format (list "," (json-peek))))))
401 ;; Hash table encoding
403 (defun json-encode-hash-table (hash-table)
404 "Return a JSON representation of HASH-TABLE."
410 (push (format "%s:%s"
418 ;; List encoding (including alists and plists)
420 (defun json-encode-alist (alist)
421 "Return a JSON representation of ALIST."
423 (json-join (mapcar (lambda (cons)
425 (json-encode-key (car cons))
426 (json-encode (cdr cons))))
430 (defun json-encode-plist (plist)
431 "Return a JSON representation of PLIST."
434 (push (concat (json-encode-key (car plist))
436 (json-encode (cadr plist)))
438 (setq plist (cddr plist)))
439 (concat "{" (json-join (nreverse result) ", ") "}")))
441 (defun json-encode-list (list)
442 "Return a JSON representation of LIST.
443 Tries to DWIM: simple lists become JSON arrays, while alists and plists
444 become JSON objects."
445 (cond ((null list) "null")
446 ((json-alist-p list) (json-encode-alist list))
447 ((json-plist-p list) (json-encode-plist list))
448 ((listp list) (json-encode-array list))
450 (signal 'json-error (list list)))))
456 (defun json-read-array ()
457 "Read the JSON array at point."
460 (json-skip-whitespace)
461 ;; read values until "]"
463 (while (not (char-equal (json-peek) ?\]))
464 (push (json-read) elements)
465 (json-skip-whitespace)
466 (unless (char-equal (json-peek) ?\])
467 (if (char-equal (json-peek) ?,)
469 (signal 'json-error (list 'bleah)))))
472 (apply json-array-type (nreverse elements))))
476 (defun json-encode-array (array)
477 "Return a JSON representation of ARRAY."
478 (concat "[" (mapconcat 'json-encode array ", ") "]"))
484 (defvar json-readtable
486 '((?t json-read-keyword "true")
487 (?f json-read-keyword "false")
488 (?n json-read-keyword "null")
489 (?{ json-read-object)
490 (?\[ json-read-array)
491 (?\" json-read-string))))
493 (push (list char 'json-read-number) table))
494 '(?- ?+ ?. ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
496 "Readtable for JSON reader.")
499 "Parse and return the JSON object following point.
500 Advances point just past JSON object."
501 (json-skip-whitespace)
502 (let ((char (json-peek)))
503 (if (not (eq char :json-eof))
504 (let ((record (cdr (assq char json-readtable))))
505 (if (functionp (car record))
506 (apply (car record) (cdr record))
507 (signal 'json-readtable-error record)))
508 (signal 'end-of-file nil))))
510 ;; Syntactic sugar for the reader
512 (defun json-read-from-string (string)
513 "Read the JSON object contained in STRING and return it."
516 (goto-char (point-min))
519 (defun json-read-file (file)
520 "Read the first JSON object contained in FILE and return it."
522 (insert-file-contents file)
523 (goto-char (point-min))
530 (defun json-encode (object)
531 "Return a JSON representation of OBJECT as a string."
532 (cond ((memq object (list t json-null json-false))
533 (json-encode-keyword object))
534 ((stringp object) (json-encode-string object))
535 ((keywordp object) (json-encode-string
536 (substring (symbol-name object) 1)))
537 ((symbolp object) (json-encode-string
538 (symbol-name object)))
539 ((numberp object) (json-encode-number object))
540 ((arrayp object) (json-encode-array object))
541 ((hash-table-p object) (json-encode-hash-table object))
542 ((listp object) (json-encode-list object))
543 (t (signal 'json-error (list object)))))
547 ;;; json.el ends here