1 ;;; json.el --- JavaScript Object Notation parser / generator
3 ;; Copyright (C) 2006, 2007, 2008 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, or (at your option)
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; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24 ;; Boston, MA 02110-1301, USA.
28 ;; This is a library for parsing and generating JSON (JavaScript Object
31 ;; Learn all about JSON here: <URL:http://json.org/>.
33 ;; The user-serviceable entry points for the parser are the functions
34 ;; `json-read' and `json-read-from-string'. The encoder has a single
35 ;; entry point, `json-encode'.
37 ;; Since there are several natural representations of key-value pair
38 ;; mappings in elisp (alist, plist, hash-table), `json-read' allows you
39 ;; to specify which you'd prefer (see `json-object-type' and
40 ;; `json-array-type').
42 ;; Similarly, since `false' and `null' are distinct in JSON, you can
43 ;; distinguish them by binding `json-false' and `json-null' as desired.
47 ;; 2006-03-11 - Initial version.
48 ;; 2006-03-13 - Added JSON generation in addition to parsing. Various
49 ;; other cleanups, bugfixes, and improvements.
50 ;; 2006-12-29 - XEmacs support, from Aidan Kehoe <kehoea@parhasard.net>.
51 ;; 2008-02-21 - Installed in GNU Emacs.
55 (eval-when-compile (require 'cl))
59 (defalias 'json-encode-char0 'encode-char)
60 (defalias 'json-decode-char0 'decode-char)
65 (defvar json-object-type 'alist
66 "Type to convert JSON objects to.
67 Must be one of `alist', `plist', or `hash-table'. Consider let-binding
68 this around your call to `json-read' instead of `setq'ing it.")
70 (defvar json-array-type 'vector
71 "Type to convert JSON arrays to.
72 Must be one of `vector' or `list'. Consider let-binding this around
73 your call to `json-read' instead of `setq'ing it.")
75 (defvar json-key-type nil
76 "Type to convert JSON keys to.
77 Must be one of `string', `symbol', `keyword', or nil.
79 If nil, `json-read' will guess the type based on the value of
82 If `json-object-type' is: nil will be interpreted as:
87 Note that values other than `string' might behave strangely for
88 Sufficiently Weird keys. Consider let-binding this around your call to
89 `json-read' instead of `setq'ing it.")
91 (defvar json-false :json-false
92 "Value to use when reading JSON `false'.
93 If this has the same value as `json-null', you might not be able to tell
94 the difference between `false' and `null'. Consider let-binding this
95 around your call to `json-read' instead of `setq'ing it.")
98 "Value to use when reading JSON `null'.
99 If this has the same value as `json-false', you might not be able to
100 tell the difference between `false' and `null'. Consider let-binding
101 this around your call to `json-read' instead of `setq'ing it.")
107 (defun json-join (strings separator)
108 "Join STRINGS with SEPARATOR."
109 (mapconcat 'identity strings separator))
111 (defun json-alist-p (list)
112 "Non-null iff LIST is an alist."
114 (and (consp (car list))
115 (json-alist-p (cdr list)))))
117 (defun json-plist-p (list)
118 "Non-null iff LIST is a plist."
120 (and (keywordp (car list))
122 (json-plist-p (cddr list)))))
126 (defsubst json-advance (&optional n)
127 "Skip past the following N characters."
128 (unless n (setq n 1))
129 (let ((goal (+ (point) n)))
131 (when (< (point) goal)
132 (signal 'end-of-file nil))))
134 (defsubst json-peek ()
135 "Return the character at point."
136 (let ((char (char-after (point))))
137 (or char :json-eof)))
139 (defsubst json-pop ()
140 "Advance past the character at point, returning it."
141 (let ((char (json-peek)))
142 (if (eq char :json-eof)
143 (signal 'end-of-file nil)
147 (defun json-skip-whitespace ()
148 "Skip past the whitespace at point."
149 (while (looking-at "[\t\r\n\f\b ]")
150 (goto-char (match-end 0))))
156 (put 'json-error 'error-message "Unknown JSON error")
157 (put 'json-error 'error-conditions '(json-error error))
159 (put 'json-readtable-error 'error-message "JSON readtable error")
160 (put 'json-readtable-error 'error-conditions
161 '(json-readtable-error json-error error))
163 (put 'json-unknown-keyword 'error-message "Unrecognized keyword")
164 (put 'json-unknown-keyword 'error-conditions
165 '(json-unknown-keyword json-error error))
167 (put 'json-number-format 'error-message "Invalid number format")
168 (put 'json-number-format 'error-conditions
169 '(json-number-format json-error error))
171 (put 'json-string-escape 'error-message "Bad unicode escape")
172 (put 'json-string-escape 'error-conditions
173 '(json-string-escape json-error error))
175 (put 'json-string-format 'error-message "Bad string format")
176 (put 'json-string-format 'error-conditions
177 '(json-string-format json-error error))
179 (put 'json-object-format 'error-message "Bad JSON object")
180 (put 'json-object-format 'error-conditions
181 '(json-object-format json-error error))
187 (defvar json-keywords '("true" "false" "null")
188 "List of JSON keywords.")
192 (defun json-read-keyword (keyword)
193 "Read a JSON keyword at point.
194 KEYWORD is the keyword expected."
195 (unless (member keyword json-keywords)
196 (signal 'json-unknown-keyword (list keyword)))
198 (unless (char-equal char (json-peek))
199 (signal 'json-unknown-keyword
200 (list (save-excursion
202 (thing-at-point 'word)))))
205 (unless (looking-at "\\(\\s-\\|[],}]\\|$\\)")
206 (signal 'json-unknown-keyword
207 (list (save-excursion
209 (thing-at-point 'word)))))
210 (cond ((string-equal keyword "true") t)
211 ((string-equal keyword "false") json-false)
212 ((string-equal keyword "null") json-null)))
216 (defun json-encode-keyword (keyword)
217 "Encode KEYWORD as a JSON value."
218 (cond ((eq keyword t) "true")
219 ((eq keyword json-false) "false")
220 ((eq keyword json-null) "null")))
226 (defun json-read-number ()
227 "Read the JSON number following point.
228 N.B.: Only numbers which can fit in Emacs Lisp's native number
229 representation will be parsed correctly."
230 (if (char-equal (json-peek) ?-)
233 (- 0 (json-read-number)))
234 (if (looking-at "[0-9]+\\([.][0-9]+\\)?\\([eE][+-]?[0-9]+\\)?")
236 (goto-char (match-end 0))
237 (string-to-number (match-string 0)))
238 (signal 'json-number-format (list (point))))))
242 (defun json-encode-number (number)
243 "Return a JSON representation of NUMBER."
244 (format "%s" number))
248 (defvar json-special-chars
257 "Characters which are escaped in JSON, with their elisp counterparts.")
261 (defun json-read-escaped-char ()
262 "Read the JSON string escaped character at point."
265 (let* ((char (json-pop))
266 (special (assq char json-special-chars)))
268 (special (cdr special))
269 ((not (eq char ?u)) char)
270 ((looking-at "[0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f]")
271 (let ((hex (match-string 0)))
273 (json-decode-char0 'ucs (string-to-number hex 16))))
275 (signal 'json-string-escape (list (point)))))))
277 (defun json-read-string ()
278 "Read the JSON string at point."
279 (unless (char-equal (json-peek) ?\")
280 (signal 'json-string-format (list "doesn't start with '\"'!")))
283 (let ((characters '())
285 (while (not (char-equal char ?\"))
286 (push (if (char-equal char ?\\)
287 (json-read-escaped-char)
290 (setq char (json-peek)))
294 (apply 'string (nreverse characters))
299 (defun json-encode-char (char)
300 "Encode CHAR as a JSON string."
301 (setq char (json-encode-char0 char 'ucs))
302 (let ((control-char (car (rassoc char json-special-chars))))
304 ;; Special JSON character (\n, \r, etc.)
306 (format "\\%c" control-char))
307 ;; ASCIIish printable character
308 ((and (> char 31) (< char 161))
310 ;; Fallback: UCS code point in \uNNNN form
312 (format "\\u%04x" char)))))
314 (defun json-encode-string (string)
315 "Return a JSON representation of STRING."
316 (format "\"%s\"" (mapconcat 'json-encode-char string "")))
320 (defun json-new-object ()
321 "Create a new Elisp object corresponding to a JSON object.
322 Please see the documentation of `json-object-type'."
323 (cond ((eq json-object-type 'hash-table)
324 (make-hash-table :test 'equal))
328 (defun json-add-to-object (object key value)
329 "Add a new KEY -> VALUE association to OBJECT.
330 Returns the updated object, which you should save, e.g.:
331 (setq obj (json-add-to-object obj \"foo\" \"bar\"))
332 Please see the documentation of `json-object-type' and `json-key-type'."
334 (if (eq json-key-type nil)
335 (cdr (assq json-object-type '((hash-table . string)
340 (cond ((eq json-key-type 'string)
342 ((eq json-key-type 'symbol)
344 ((eq json-key-type 'keyword)
345 (intern (concat ":" key)))))
346 (cond ((eq json-object-type 'hash-table)
347 (puthash key value object)
349 ((eq json-object-type 'alist)
350 (cons (cons key value) object))
351 ((eq json-object-type 'plist)
352 (cons key (cons value object))))))
354 ;; JSON object parsing
356 (defun json-read-object ()
357 "Read the JSON object at point."
360 (json-skip-whitespace)
361 ;; read key/value pairs until "}"
362 (let ((elements (json-new-object))
364 (while (not (char-equal (json-peek) ?}))
365 (json-skip-whitespace)
366 (setq key (json-read-string))
367 (json-skip-whitespace)
368 (if (char-equal (json-peek) ?:)
370 (signal 'json-object-format (list ":" (json-peek))))
371 (setq value (json-read))
372 (setq elements (json-add-to-object elements key value))
373 (json-skip-whitespace)
374 (unless (char-equal (json-peek) ?})
375 (if (char-equal (json-peek) ?,)
377 (signal 'json-object-format (list "," (json-peek))))))
382 ;; Hash table encoding
384 (defun json-encode-hash-table (hash-table)
385 "Return a JSON representation of HASH-TABLE."
391 (push (format "%s:%s"
399 ;; List encoding (including alists and plists)
401 (defun json-encode-alist (alist)
402 "Return a JSON representation of ALIST."
404 (json-join (mapcar (lambda (cons)
406 (json-encode (car cons))
407 (json-encode (cdr cons))))
411 (defun json-encode-plist (plist)
412 "Return a JSON representation of PLIST."
415 (push (concat (json-encode (car plist))
417 (json-encode (cadr plist)))
419 (setq plist (cddr plist)))
420 (concat "{" (json-join (nreverse result) ", ") "}")))
422 (defun json-encode-list (list)
423 "Return a JSON representation of LIST.
424 Tries to DWIM: simple lists become JSON arrays, while alists and plists
425 become JSON objects."
426 (cond ((null list) "null")
427 ((json-alist-p list) (json-encode-alist list))
428 ((json-plist-p list) (json-encode-plist list))
429 ((listp list) (json-encode-array list))
431 (signal 'json-error (list list)))))
437 (defun json-read-array ()
438 "Read the JSON array at point."
441 (json-skip-whitespace)
442 ;; read values until "]"
444 (while (not (char-equal (json-peek) ?\]))
445 (push (json-read) elements)
446 (json-skip-whitespace)
447 (unless (char-equal (json-peek) ?\])
448 (if (char-equal (json-peek) ?,)
450 (signal 'json-error (list 'bleah)))))
453 (apply json-array-type (nreverse elements))))
457 (defun json-encode-array (array)
458 "Return a JSON representation of ARRAY."
459 (concat "[" (mapconcat 'json-encode array ", ") "]"))
465 (defvar json-readtable
467 '((?t json-read-keyword "true")
468 (?f json-read-keyword "false")
469 (?n json-read-keyword "null")
470 (?{ json-read-object)
471 (?\[ json-read-array)
472 (?\" json-read-string))))
474 (push (list char 'json-read-number) table))
475 '(?- ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
477 "Readtable for JSON reader.")
480 "Parse and return the JSON object following point.
481 Advances point just past JSON object."
482 (json-skip-whitespace)
483 (let ((char (json-peek)))
484 (if (not (eq char :json-eof))
485 (let ((record (cdr (assq char json-readtable))))
486 (if (functionp (car record))
487 (apply (car record) (cdr record))
488 (signal 'json-readtable-error record)))
489 (signal 'end-of-file nil))))
491 ;; Syntactic sugar for the reader
493 (defun json-read-from-string (string)
494 "Read the JSON object contained in STRING and return it."
497 (goto-char (point-min))
500 (defun json-read-file (file)
501 "Read the first JSON object contained in FILE and return it."
503 (insert-file-contents file)
504 (goto-char (point-min))
511 (defun json-encode (object)
512 "Return a JSON representation of OBJECT as a string."
513 (cond ((memq object (list t json-null json-false))
514 (json-encode-keyword object))
515 ((stringp object) (json-encode-string object))
516 ((keywordp object) (json-encode-string
517 (substring (symbol-name object) 1)))
518 ((symbolp object) (json-encode-string
519 (symbol-name object)))
520 ((numberp object) (json-encode-number object))
521 ((arrayp object) (json-encode-array object))
522 ((hash-table-p object) (json-encode-hash-table object))
523 ((listp object) (json-encode-list object))
524 (t (signal 'json-error (list object)))))
528 ;; arch-tag: 15f6e4c8-b831-4172-8749-bbc680c50ea1
529 ;;; json.el ends here