1 ;;; json.el --- JavaScript Object Notation parser / generator
3 ;; Copyright (C) 2006-2012 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
57 (defalias 'json-encode-char0
'encode-char
)
58 (defalias 'json-decode-char0
'decode-char
)
63 (defvar json-object-type
'alist
64 "Type to convert JSON objects to.
65 Must be one of `alist', `plist', or `hash-table'. Consider let-binding
66 this around your call to `json-read' instead of `setq'ing it.")
68 (defvar json-array-type
'vector
69 "Type to convert JSON arrays to.
70 Must be one of `vector' or `list'. Consider let-binding this around
71 your call to `json-read' instead of `setq'ing it.")
73 (defvar json-key-type nil
74 "Type to convert JSON keys to.
75 Must be one of `string', `symbol', `keyword', or nil.
77 If nil, `json-read' will guess the type based on the value of
80 If `json-object-type' is: nil will be interpreted as:
85 Note that values other than `string' might behave strangely for
86 Sufficiently Weird keys. Consider let-binding this around your call to
87 `json-read' instead of `setq'ing it.")
89 (defvar json-false
:json-false
90 "Value to use when reading JSON `false'.
91 If this has the same value as `json-null', you might not be able to tell
92 the difference between `false' and `null'. Consider let-binding this
93 around your call to `json-read' instead of `setq'ing it.")
96 "Value to use when reading JSON `null'.
97 If this has the same value as `json-false', you might not be able to
98 tell the difference between `false' and `null'. Consider let-binding
99 this around your call to `json-read' instead of `setq'ing it.")
105 (defun json-join (strings separator
)
106 "Join STRINGS with SEPARATOR."
107 (mapconcat 'identity strings separator
))
109 (defun json-alist-p (list)
110 "Non-null if and only if LIST is an alist."
112 (setq list
(if (consp (car list
))
117 (defun json-plist-p (list)
118 "Non-null if and only if LIST is a plist."
120 (setq list
(if (and (keywordp (car list
))
128 (defsubst json-advance
(&optional n
)
129 "Skip past the following N characters."
132 (defsubst json-peek
()
133 "Return the character at point."
134 (let ((char (char-after (point))))
135 (or char
:json-eof
)))
137 (defsubst json-pop
()
138 "Advance past the character at point, returning it."
139 (let ((char (json-peek)))
140 (if (eq char
:json-eof
)
141 (signal 'end-of-file nil
)
145 (defun json-skip-whitespace ()
146 "Skip past the whitespace at point."
147 (skip-chars-forward "\t\r\n\f\b "))
153 (put 'json-error
'error-message
"Unknown JSON error")
154 (put 'json-error
'error-conditions
'(json-error error
))
156 (put 'json-readtable-error
'error-message
"JSON readtable error")
157 (put 'json-readtable-error
'error-conditions
158 '(json-readtable-error json-error error
))
160 (put 'json-unknown-keyword
'error-message
"Unrecognized keyword")
161 (put 'json-unknown-keyword
'error-conditions
162 '(json-unknown-keyword json-error error
))
164 (put 'json-number-format
'error-message
"Invalid number format")
165 (put 'json-number-format
'error-conditions
166 '(json-number-format json-error error
))
168 (put 'json-string-escape
'error-message
"Bad Unicode escape")
169 (put 'json-string-escape
'error-conditions
170 '(json-string-escape json-error error
))
172 (put 'json-string-format
'error-message
"Bad string format")
173 (put 'json-string-format
'error-conditions
174 '(json-string-format json-error error
))
176 (put 'json-key-format
'error-message
"Bad JSON object key")
177 (put 'json-key-format
'error-conditions
178 '(json-key-format json-error error
))
180 (put 'json-object-format
'error-message
"Bad JSON object")
181 (put 'json-object-format
'error-conditions
182 '(json-object-format json-error error
))
188 (defvar json-keywords
'("true" "false" "null")
189 "List of JSON keywords.")
193 (defun json-read-keyword (keyword)
194 "Read a JSON keyword at point.
195 KEYWORD is the keyword expected."
196 (unless (member keyword json-keywords
)
197 (signal 'json-unknown-keyword
(list keyword
)))
199 (unless (char-equal char
(json-peek))
200 (signal 'json-unknown-keyword
201 (list (save-excursion
203 (thing-at-point 'word
)))))
206 (unless (looking-at "\\(\\s-\\|[],}]\\|$\\)")
207 (signal 'json-unknown-keyword
208 (list (save-excursion
210 (thing-at-point 'word
)))))
211 (cond ((string-equal keyword
"true") t
)
212 ((string-equal keyword
"false") json-false
)
213 ((string-equal keyword
"null") json-null
)))
217 (defun json-encode-keyword (keyword)
218 "Encode KEYWORD as a JSON value."
219 (cond ((eq keyword t
) "true")
220 ((eq keyword json-false
) "false")
221 ((eq keyword json-null
) "null")))
227 (defun json-read-number (&optional sign
)
228 "Read the JSON number following point.
229 The optional SIGN argument is for internal use.
231 N.B.: Only numbers which can fit in Emacs Lisp's native number
232 representation will be parsed correctly."
233 ;; If SIGN is non-nil, the number is explicitly signed.
235 "\\([0-9]+\\)?\\(\\.[0-9]+\\)?\\([Ee][+-]?[0-9]+\\)?"))
236 (cond ((and (null sign
) (char-equal (json-peek) ?-
))
238 (- (json-read-number t
)))
239 ((and (null sign
) (char-equal (json-peek) ?
+))
241 (json-read-number t
))
242 ((and (looking-at number-regexp
)
243 (or (match-beginning 1)
244 (match-beginning 2)))
245 (goto-char (match-end 0))
246 (string-to-number (match-string 0)))
247 (t (signal 'json-number-format
(list (point)))))))
251 (defun json-encode-number (number)
252 "Return a JSON representation of NUMBER."
253 (format "%s" number
))
257 (defvar json-special-chars
266 "Characters which are escaped in JSON, with their elisp counterparts.")
270 (defun json-read-escaped-char ()
271 "Read the JSON string escaped character at point."
274 (let* ((char (json-pop))
275 (special (assq char json-special-chars
)))
277 (special (cdr special
))
278 ((not (eq char ?u
)) char
)
279 ((looking-at "[0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f]")
280 (let ((hex (match-string 0)))
282 (json-decode-char0 'ucs
(string-to-number hex
16))))
284 (signal 'json-string-escape
(list (point)))))))
286 (defun json-read-string ()
287 "Read the JSON string at point."
288 (unless (char-equal (json-peek) ?
\")
289 (signal 'json-string-format
(list "doesn't start with '\"'!")))
292 (let ((characters '())
294 (while (not (char-equal char ?
\"))
295 (push (if (char-equal char ?
\\)
296 (json-read-escaped-char)
299 (setq char
(json-peek)))
303 (apply 'string
(nreverse characters
))
308 (defun json-encode-char (char)
309 "Encode CHAR as a JSON string."
310 (setq char
(json-encode-char0 char
'ucs
))
311 (let ((control-char (car (rassoc char json-special-chars
))))
313 ;; Special JSON character (\n, \r, etc.).
315 (format "\\%c" control-char
))
316 ;; ASCIIish printable character.
317 ((and (> char
31) (< char
127))
319 ;; Fallback: UCS code point in \uNNNN form.
321 (format "\\u%04x" char
)))))
323 (defun json-encode-string (string)
324 "Return a JSON representation of STRING."
325 (format "\"%s\"" (mapconcat 'json-encode-char string
"")))
327 (defun json-encode-key (object)
328 "Return a JSON representation of OBJECT.
329 If the resulting JSON object isn't a valid JSON object key,
330 this signals `json-key-format'."
331 (let ((encoded (json-encode object
)))
332 (unless (stringp (json-read-from-string encoded
))
333 (signal 'json-key-format
(list object
)))
338 (defun json-new-object ()
339 "Create a new Elisp object corresponding to a JSON object.
340 Please see the documentation of `json-object-type'."
341 (cond ((eq json-object-type
'hash-table
)
342 (make-hash-table :test
'equal
))
346 (defun json-add-to-object (object key value
)
347 "Add a new KEY -> VALUE association to OBJECT.
348 Returns the updated object, which you should save, e.g.:
349 (setq obj (json-add-to-object obj \"foo\" \"bar\"))
350 Please see the documentation of `json-object-type' and `json-key-type'."
352 (if (eq json-key-type nil
)
353 (cdr (assq json-object-type
'((hash-table . string
)
358 (cond ((eq json-key-type
'string
)
360 ((eq json-key-type
'symbol
)
362 ((eq json-key-type
'keyword
)
363 (intern (concat ":" key
)))))
364 (cond ((eq json-object-type
'hash-table
)
365 (puthash key value object
)
367 ((eq json-object-type
'alist
)
368 (cons (cons key value
) object
))
369 ((eq json-object-type
'plist
)
370 (cons key
(cons value object
))))))
372 ;; JSON object parsing
374 (defun json-read-object ()
375 "Read the JSON object at point."
378 (json-skip-whitespace)
379 ;; read key/value pairs until "}"
380 (let ((elements (json-new-object))
382 (while (not (char-equal (json-peek) ?
}))
383 (json-skip-whitespace)
384 (setq key
(json-read-string))
385 (json-skip-whitespace)
386 (if (char-equal (json-peek) ?
:)
388 (signal 'json-object-format
(list ":" (json-peek))))
389 (setq value
(json-read))
390 (setq elements
(json-add-to-object elements key value
))
391 (json-skip-whitespace)
392 (unless (char-equal (json-peek) ?
})
393 (if (char-equal (json-peek) ?
,)
395 (signal 'json-object-format
(list "," (json-peek))))))
400 ;; Hash table encoding
402 (defun json-encode-hash-table (hash-table)
403 "Return a JSON representation of HASH-TABLE."
409 (push (format "%s:%s"
417 ;; List encoding (including alists and plists)
419 (defun json-encode-alist (alist)
420 "Return a JSON representation of ALIST."
422 (json-join (mapcar (lambda (cons)
424 (json-encode-key (car cons
))
425 (json-encode (cdr cons
))))
429 (defun json-encode-plist (plist)
430 "Return a JSON representation of PLIST."
433 (push (concat (json-encode-key (car plist
))
435 (json-encode (cadr plist
)))
437 (setq plist
(cddr plist
)))
438 (concat "{" (json-join (nreverse result
) ", ") "}")))
440 (defun json-encode-list (list)
441 "Return a JSON representation of LIST.
442 Tries to DWIM: simple lists become JSON arrays, while alists and plists
443 become JSON objects."
444 (cond ((null list
) "null")
445 ((json-alist-p list
) (json-encode-alist list
))
446 ((json-plist-p list
) (json-encode-plist list
))
447 ((listp list
) (json-encode-array list
))
449 (signal 'json-error
(list list
)))))
455 (defun json-read-array ()
456 "Read the JSON array at point."
459 (json-skip-whitespace)
460 ;; read values until "]"
462 (while (not (char-equal (json-peek) ?\
]))
463 (push (json-read) elements
)
464 (json-skip-whitespace)
465 (unless (char-equal (json-peek) ?\
])
466 (if (char-equal (json-peek) ?
,)
468 (signal 'json-error
(list 'bleah
)))))
471 (apply json-array-type
(nreverse elements
))))
475 (defun json-encode-array (array)
476 "Return a JSON representation of ARRAY."
477 (concat "[" (mapconcat 'json-encode array
", ") "]"))
483 (defvar json-readtable
485 '((?t json-read-keyword
"true")
486 (?f json-read-keyword
"false")
487 (?n json-read-keyword
"null")
488 (?
{ json-read-object
)
489 (?\
[ json-read-array
)
490 (?
\" json-read-string
))))
492 (push (list char
'json-read-number
) table
))
493 '(?- ?
+ ?. ?
0 ?
1 ?
2 ?
3 ?
4 ?
5 ?
6 ?
7 ?
8 ?
9))
495 "Readtable for JSON reader.")
498 "Parse and return the JSON object following point.
499 Advances point just past JSON object."
500 (json-skip-whitespace)
501 (let ((char (json-peek)))
502 (if (not (eq char
:json-eof
))
503 (let ((record (cdr (assq char json-readtable
))))
504 (if (functionp (car record
))
505 (apply (car record
) (cdr record
))
506 (signal 'json-readtable-error record
)))
507 (signal 'end-of-file nil
))))
509 ;; Syntactic sugar for the reader
511 (defun json-read-from-string (string)
512 "Read the JSON object contained in STRING and return it."
515 (goto-char (point-min))
518 (defun json-read-file (file)
519 "Read the first JSON object contained in FILE and return it."
521 (insert-file-contents file
)
522 (goto-char (point-min))
529 (defun json-encode (object)
530 "Return a JSON representation of OBJECT as a string."
531 (cond ((memq object
(list t json-null json-false
))
532 (json-encode-keyword object
))
533 ((stringp object
) (json-encode-string object
))
534 ((keywordp object
) (json-encode-string
535 (substring (symbol-name object
) 1)))
536 ((symbolp object
) (json-encode-string
537 (symbol-name object
)))
538 ((numberp object
) (json-encode-number object
))
539 ((arrayp object
) (json-encode-array object
))
540 ((hash-table-p object
) (json-encode-hash-table object
))
541 ((listp object
) (json-encode-list object
))
542 (t (signal 'json-error
(list object
)))))
546 ;;; json.el ends here