Fix MS-Windows build.
[emacs.git] / lisp / json.el
blobaaa7bb0c499a0f012e66cf649e10d35b812a4e45
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>
6 ;; Version: 1.4
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/>.
24 ;;; Commentary:
26 ;; This is a library for parsing and generating JSON (JavaScript Object
27 ;; Notation).
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.
43 ;;; History:
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)
53 ;;; Code:
56 ;; Compatibility code
58 (defalias 'json-encode-char0 'encode-char)
59 (defalias 'json-decode-char0 'decode-char)
62 ;; Parameters
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
79 `json-object-type':
81 If `json-object-type' is: nil will be interpreted as:
82 `hash-table' `string'
83 `alist' `symbol'
84 `plist' `keyword'
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.")
96 (defvar json-null nil
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.")
122 ;;; Utilities
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."
130 (while (consp list)
131 (setq list (if (consp (car list))
132 (cdr list)
133 'not-alist)))
134 (null list))
136 (defun json-plist-p (list)
137 "Non-null if and only if LIST is a plist."
138 (while (consp list)
139 (setq list (if (and (keywordp (car list))
140 (consp (cdr list)))
141 (cddr list)
142 'not-plist)))
143 (null 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)
150 "")))
151 ,body))
153 ;; Reader utilities
155 (defsubst json-advance (&optional n)
156 "Skip past the following N characters."
157 (forward-char n))
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)
169 (json-advance)
170 char)))
172 (defun json-skip-whitespace ()
173 "Skip past the whitespace at point."
174 (skip-chars-forward "\t\r\n\f\b "))
178 ;; Error conditions
180 (define-error 'json-error "Unknown JSON error")
181 (define-error 'json-readtable-error "JSON readtable error" 'json-error)
182 (define-error 'json-unknown-keyword "Unrecognized keyword" 'json-error)
183 (define-error 'json-number-format "Invalid number format" 'json-error)
184 (define-error 'json-string-escape "Bad Unicode escape" 'json-error)
185 (define-error 'json-string-format "Bad string format" 'json-error)
186 (define-error 'json-key-format "Bad JSON object key" 'json-error)
187 (define-error 'json-object-format "Bad JSON object" 'json-error)
191 ;;; Keywords
193 (defvar json-keywords '("true" "false" "null")
194 "List of JSON keywords.")
196 ;; Keyword parsing
198 (defun json-read-keyword (keyword)
199 "Read a JSON keyword at point.
200 KEYWORD is the keyword expected."
201 (unless (member keyword json-keywords)
202 (signal 'json-unknown-keyword (list keyword)))
203 (mapc (lambda (char)
204 (unless (char-equal char (json-peek))
205 (signal 'json-unknown-keyword
206 (list (save-excursion
207 (backward-word 1)
208 (thing-at-point 'word)))))
209 (json-advance))
210 keyword)
211 (unless (looking-at "\\(\\s-\\|[],}]\\|$\\)")
212 (signal 'json-unknown-keyword
213 (list (save-excursion
214 (backward-word 1)
215 (thing-at-point 'word)))))
216 (cond ((string-equal keyword "true") t)
217 ((string-equal keyword "false") json-false)
218 ((string-equal keyword "null") json-null)))
220 ;; Keyword encoding
222 (defun json-encode-keyword (keyword)
223 "Encode KEYWORD as a JSON value."
224 (cond ((eq keyword t) "true")
225 ((eq keyword json-false) "false")
226 ((eq keyword json-null) "null")))
228 ;;; Numbers
230 ;; Number parsing
232 (defun json-read-number (&optional sign)
233 "Read the JSON number following point.
234 The optional SIGN argument is for internal use.
236 N.B.: Only numbers which can fit in Emacs Lisp's native number
237 representation will be parsed correctly."
238 ;; If SIGN is non-nil, the number is explicitly signed.
239 (let ((number-regexp
240 "\\([0-9]+\\)?\\(\\.[0-9]+\\)?\\([Ee][+-]?[0-9]+\\)?"))
241 (cond ((and (null sign) (char-equal (json-peek) ?-))
242 (json-advance)
243 (- (json-read-number t)))
244 ((and (null sign) (char-equal (json-peek) ?+))
245 (json-advance)
246 (json-read-number t))
247 ((and (looking-at number-regexp)
248 (or (match-beginning 1)
249 (match-beginning 2)))
250 (goto-char (match-end 0))
251 (string-to-number (match-string 0)))
252 (t (signal 'json-number-format (list (point)))))))
254 ;; Number encoding
256 (defun json-encode-number (number)
257 "Return a JSON representation of NUMBER."
258 (format "%s" number))
260 ;;; Strings
262 (defvar json-special-chars
263 '((?\" . ?\")
264 (?\\ . ?\\)
265 (?/ . ?/)
266 (?b . ?\b)
267 (?f . ?\f)
268 (?n . ?\n)
269 (?r . ?\r)
270 (?t . ?\t))
271 "Characters which are escaped in JSON, with their elisp counterparts.")
273 ;; String parsing
275 (defun json-read-escaped-char ()
276 "Read the JSON string escaped character at point."
277 ;; Skip over the '\'
278 (json-advance)
279 (let* ((char (json-pop))
280 (special (assq char json-special-chars)))
281 (cond
282 (special (cdr special))
283 ((not (eq char ?u)) char)
284 ((looking-at "[0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f]")
285 (let ((hex (match-string 0)))
286 (json-advance 4)
287 (json-decode-char0 'ucs (string-to-number hex 16))))
289 (signal 'json-string-escape (list (point)))))))
291 (defun json-read-string ()
292 "Read the JSON string at point."
293 (unless (char-equal (json-peek) ?\")
294 (signal 'json-string-format (list "doesn't start with '\"'!")))
295 ;; Skip over the '"'
296 (json-advance)
297 (let ((characters '())
298 (char (json-peek)))
299 (while (not (char-equal char ?\"))
300 (push (if (char-equal char ?\\)
301 (json-read-escaped-char)
302 (json-pop))
303 characters)
304 (setq char (json-peek)))
305 ;; Skip over the '"'
306 (json-advance)
307 (if characters
308 (apply 'string (nreverse characters))
309 "")))
311 ;; String encoding
313 (defun json-encode-char (char)
314 "Encode CHAR as a JSON string."
315 (setq char (json-encode-char0 char 'ucs))
316 (let ((control-char (car (rassoc char json-special-chars))))
317 (cond
318 ;; Special JSON character (\n, \r, etc.).
319 (control-char
320 (format "\\%c" control-char))
321 ;; ASCIIish printable character.
322 ((and (> char 31) (< char 127))
323 (format "%c" char))
324 ;; Fallback: UCS code point in \uNNNN form.
326 (format "\\u%04x" char)))))
328 (defun json-encode-string (string)
329 "Return a JSON representation of STRING."
330 (format "\"%s\"" (mapconcat 'json-encode-char string "")))
332 (defun json-encode-key (object)
333 "Return a JSON representation of OBJECT.
334 If the resulting JSON object isn't a valid JSON object key,
335 this signals `json-key-format'."
336 (let ((encoded (json-encode object)))
337 (unless (stringp (json-read-from-string encoded))
338 (signal 'json-key-format (list object)))
339 encoded))
341 ;;; JSON Objects
343 (defun json-new-object ()
344 "Create a new Elisp object corresponding to a JSON object.
345 Please see the documentation of `json-object-type'."
346 (cond ((eq json-object-type 'hash-table)
347 (make-hash-table :test 'equal))
349 (list))))
351 (defun json-add-to-object (object key value)
352 "Add a new KEY -> VALUE association to OBJECT.
353 Returns the updated object, which you should save, e.g.:
354 (setq obj (json-add-to-object obj \"foo\" \"bar\"))
355 Please see the documentation of `json-object-type' and `json-key-type'."
356 (let ((json-key-type
357 (if (eq json-key-type nil)
358 (cdr (assq json-object-type '((hash-table . string)
359 (alist . symbol)
360 (plist . keyword))))
361 json-key-type)))
362 (setq key
363 (cond ((eq json-key-type 'string)
364 key)
365 ((eq json-key-type 'symbol)
366 (intern key))
367 ((eq json-key-type 'keyword)
368 (intern (concat ":" key)))))
369 (cond ((eq json-object-type 'hash-table)
370 (puthash key value object)
371 object)
372 ((eq json-object-type 'alist)
373 (cons (cons key value) object))
374 ((eq json-object-type 'plist)
375 (cons key (cons value object))))))
377 ;; JSON object parsing
379 (defun json-read-object ()
380 "Read the JSON object at point."
381 ;; Skip over the "{"
382 (json-advance)
383 (json-skip-whitespace)
384 ;; read key/value pairs until "}"
385 (let ((elements (json-new-object))
386 key value)
387 (while (not (char-equal (json-peek) ?}))
388 (json-skip-whitespace)
389 (setq key (json-read-string))
390 (json-skip-whitespace)
391 (if (char-equal (json-peek) ?:)
392 (json-advance)
393 (signal 'json-object-format (list ":" (json-peek))))
394 (setq value (json-read))
395 (setq elements (json-add-to-object elements key value))
396 (json-skip-whitespace)
397 (unless (char-equal (json-peek) ?})
398 (if (char-equal (json-peek) ?,)
399 (json-advance)
400 (signal 'json-object-format (list "," (json-peek))))))
401 ;; Skip over the "}"
402 (json-advance)
403 elements))
405 ;; Hash table encoding
407 (defun json-encode-hash-table (hash-table)
408 "Return a JSON representation of HASH-TABLE."
409 (format "{%s%s}"
410 (json-join
411 (let (r)
412 (json--with-indentation
413 (maphash
414 (lambda (k v)
415 (push (format
416 (if json-encoding-pretty-print
417 "%s%s: %s"
418 "%s%s:%s")
419 json--encoding-current-indentation
420 (json-encode-key k)
421 (json-encode v))
423 hash-table))
425 json-encoding-separator)
426 (if (or (not json-encoding-pretty-print)
427 json-encoding-lisp-style-closings)
429 json--encoding-current-indentation)))
431 ;; List encoding (including alists and plists)
433 (defun json-encode-alist (alist)
434 "Return a JSON representation of ALIST."
435 (format "{%s%s}"
436 (json-join
437 (json--with-indentation
438 (mapcar (lambda (cons)
439 (format (if json-encoding-pretty-print
440 "%s%s: %s"
441 "%s%s:%s")
442 json--encoding-current-indentation
443 (json-encode-key (car cons))
444 (json-encode (cdr cons))))
445 alist))
446 json-encoding-separator)
447 (if (or (not json-encoding-pretty-print)
448 json-encoding-lisp-style-closings)
450 json--encoding-current-indentation)))
452 (defun json-encode-plist (plist)
453 "Return a JSON representation of PLIST."
454 (let (result)
455 (json--with-indentation
456 (while plist
457 (push (concat
458 json--encoding-current-indentation
459 (json-encode-key (car plist))
460 (if json-encoding-pretty-print
461 ": "
462 ":")
463 (json-encode (cadr plist)))
464 result)
465 (setq plist (cddr plist))))
466 (concat "{"
467 (json-join (nreverse result) json-encoding-separator)
468 (if (and json-encoding-pretty-print
469 (not json-encoding-lisp-style-closings))
470 json--encoding-current-indentation
472 "}")))
474 (defun json-encode-list (list)
475 "Return a JSON representation of LIST.
476 Tries to DWIM: simple lists become JSON arrays, while alists and plists
477 become JSON objects."
478 (cond ((null list) "null")
479 ((json-alist-p list) (json-encode-alist list))
480 ((json-plist-p list) (json-encode-plist list))
481 ((listp list) (json-encode-array list))
483 (signal 'json-error (list list)))))
485 ;;; Arrays
487 ;; Array parsing
489 (defun json-read-array ()
490 "Read the JSON array at point."
491 ;; Skip over the "["
492 (json-advance)
493 (json-skip-whitespace)
494 ;; read values until "]"
495 (let (elements)
496 (while (not (char-equal (json-peek) ?\]))
497 (push (json-read) elements)
498 (json-skip-whitespace)
499 (unless (char-equal (json-peek) ?\])
500 (if (char-equal (json-peek) ?,)
501 (json-advance)
502 (signal 'json-error (list 'bleah)))))
503 ;; Skip over the "]"
504 (json-advance)
505 (apply json-array-type (nreverse elements))))
507 ;; Array encoding
509 (defun json-encode-array (array)
510 "Return a JSON representation of ARRAY."
511 (if (and json-encoding-pretty-print
512 (> (length array) 0))
513 (concat
514 (json--with-indentation
515 (concat (format "[%s" json--encoding-current-indentation)
516 (json-join (mapcar 'json-encode array)
517 (format "%s%s"
518 json-encoding-separator
519 json--encoding-current-indentation))))
520 (format "%s]"
521 (if json-encoding-lisp-style-closings
523 json--encoding-current-indentation)))
524 (concat "["
525 (mapconcat 'json-encode array json-encoding-separator)
526 "]")))
530 ;;; JSON reader.
532 (defvar json-readtable
533 (let ((table
534 '((?t json-read-keyword "true")
535 (?f json-read-keyword "false")
536 (?n json-read-keyword "null")
537 (?{ json-read-object)
538 (?\[ json-read-array)
539 (?\" json-read-string))))
540 (mapc (lambda (char)
541 (push (list char 'json-read-number) table))
542 '(?- ?+ ?. ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
543 table)
544 "Readtable for JSON reader.")
546 (defun json-read ()
547 "Parse and return the JSON object following point.
548 Advances point just past JSON object."
549 (json-skip-whitespace)
550 (let ((char (json-peek)))
551 (if (not (eq char :json-eof))
552 (let ((record (cdr (assq char json-readtable))))
553 (if (functionp (car record))
554 (apply (car record) (cdr record))
555 (signal 'json-readtable-error record)))
556 (signal 'end-of-file nil))))
558 ;; Syntactic sugar for the reader
560 (defun json-read-from-string (string)
561 "Read the JSON object contained in STRING and return it."
562 (with-temp-buffer
563 (insert string)
564 (goto-char (point-min))
565 (json-read)))
567 (defun json-read-file (file)
568 "Read the first JSON object contained in FILE and return it."
569 (with-temp-buffer
570 (insert-file-contents file)
571 (goto-char (point-min))
572 (json-read)))
576 ;;; JSON encoder
578 (defun json-encode (object)
579 "Return a JSON representation of OBJECT as a string."
580 (cond ((memq object (list t json-null json-false))
581 (json-encode-keyword object))
582 ((stringp object) (json-encode-string object))
583 ((keywordp object) (json-encode-string
584 (substring (symbol-name object) 1)))
585 ((symbolp object) (json-encode-string
586 (symbol-name object)))
587 ((numberp object) (json-encode-number object))
588 ((arrayp object) (json-encode-array object))
589 ((hash-table-p object) (json-encode-hash-table object))
590 ((listp object) (json-encode-list object))
591 (t (signal 'json-error (list object)))))
593 ;; Pretty printing
595 (defun json-pretty-print-buffer ()
596 "Pretty-print current buffer."
597 (interactive)
598 (json-pretty-print (point-min) (point-max)))
600 (defun json-pretty-print (begin end)
601 "Pretty-print selected region."
602 (interactive "r")
603 (atomic-change-group
604 (let ((json-encoding-pretty-print t)
605 (txt (delete-and-extract-region begin end)))
606 (insert (json-encode (json-read-from-string txt))))))
608 (provide 'json)
610 ;;; json.el ends here