* net/tramp-adb.el (tramp-adb-handle-file-attributes):
[emacs.git] / lisp / json.el
blob899bff5dc32f7a114b60a941bc9b0abd7c048667
1 ;;; json.el --- JavaScript Object Notation parser / generator
3 ;; Copyright (C) 2006-2014 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 with simple keys."
130 (while (consp list)
131 (setq list (if (and (consp (car list))
132 (atom (caar list)))
133 (cdr list)
134 'not-alist)))
135 (null list))
137 (defun json-plist-p (list)
138 "Non-null if and only if LIST is a plist."
139 (while (consp list)
140 (setq list (if (and (keywordp (car list))
141 (consp (cdr list)))
142 (cddr list)
143 'not-plist)))
144 (null list))
146 (defmacro json--with-indentation (body)
147 `(let ((json--encoding-current-indentation
148 (if json-encoding-pretty-print
149 (concat json--encoding-current-indentation
150 json-encoding-default-indentation)
151 "")))
152 ,body))
154 ;; Reader utilities
156 (defsubst json-advance (&optional n)
157 "Skip past the following N characters."
158 (forward-char n))
160 (defsubst json-peek ()
161 "Return the character at point."
162 (let ((char (char-after (point))))
163 (or char :json-eof)))
165 (defsubst json-pop ()
166 "Advance past the character at point, returning it."
167 (let ((char (json-peek)))
168 (if (eq char :json-eof)
169 (signal 'end-of-file nil)
170 (json-advance)
171 char)))
173 (defun json-skip-whitespace ()
174 "Skip past the whitespace at point."
175 (skip-chars-forward "\t\r\n\f\b "))
179 ;; Error conditions
181 (define-error 'json-error "Unknown JSON error")
182 (define-error 'json-readtable-error "JSON readtable error" 'json-error)
183 (define-error 'json-unknown-keyword "Unrecognized keyword" 'json-error)
184 (define-error 'json-number-format "Invalid number format" 'json-error)
185 (define-error 'json-string-escape "Bad Unicode escape" 'json-error)
186 (define-error 'json-string-format "Bad string format" 'json-error)
187 (define-error 'json-key-format "Bad JSON object key" 'json-error)
188 (define-error 'json-object-format "Bad JSON object" 'json-error)
192 ;;; Keywords
194 (defvar json-keywords '("true" "false" "null")
195 "List of JSON keywords.")
197 ;; Keyword parsing
199 (defun json-read-keyword (keyword)
200 "Read a JSON keyword at point.
201 KEYWORD is the keyword expected."
202 (unless (member keyword json-keywords)
203 (signal 'json-unknown-keyword (list keyword)))
204 (mapc (lambda (char)
205 (unless (char-equal char (json-peek))
206 (signal 'json-unknown-keyword
207 (list (save-excursion
208 (backward-word 1)
209 (thing-at-point 'word)))))
210 (json-advance))
211 keyword)
212 (unless (looking-at "\\(\\s-\\|[],}]\\|$\\)")
213 (signal 'json-unknown-keyword
214 (list (save-excursion
215 (backward-word 1)
216 (thing-at-point 'word)))))
217 (cond ((string-equal keyword "true") t)
218 ((string-equal keyword "false") json-false)
219 ((string-equal keyword "null") json-null)))
221 ;; Keyword encoding
223 (defun json-encode-keyword (keyword)
224 "Encode KEYWORD as a JSON value."
225 (cond ((eq keyword t) "true")
226 ((eq keyword json-false) "false")
227 ((eq keyword json-null) "null")))
229 ;;; Numbers
231 ;; Number parsing
233 (defun json-read-number (&optional sign)
234 "Read the JSON number following point.
235 The optional SIGN argument is for internal use.
237 N.B.: Only numbers which can fit in Emacs Lisp's native number
238 representation will be parsed correctly."
239 ;; If SIGN is non-nil, the number is explicitly signed.
240 (let ((number-regexp
241 "\\([0-9]+\\)?\\(\\.[0-9]+\\)?\\([Ee][+-]?[0-9]+\\)?"))
242 (cond ((and (null sign) (char-equal (json-peek) ?-))
243 (json-advance)
244 (- (json-read-number t)))
245 ((and (null sign) (char-equal (json-peek) ?+))
246 (json-advance)
247 (json-read-number t))
248 ((and (looking-at number-regexp)
249 (or (match-beginning 1)
250 (match-beginning 2)))
251 (goto-char (match-end 0))
252 (string-to-number (match-string 0)))
253 (t (signal 'json-number-format (list (point)))))))
255 ;; Number encoding
257 (defun json-encode-number (number)
258 "Return a JSON representation of NUMBER."
259 (format "%s" number))
261 ;;; Strings
263 (defvar json-special-chars
264 '((?\" . ?\")
265 (?\\ . ?\\)
266 (?/ . ?/)
267 (?b . ?\b)
268 (?f . ?\f)
269 (?n . ?\n)
270 (?r . ?\r)
271 (?t . ?\t))
272 "Characters which are escaped in JSON, with their elisp counterparts.")
274 ;; String parsing
276 (defun json-read-escaped-char ()
277 "Read the JSON string escaped character at point."
278 ;; Skip over the '\'
279 (json-advance)
280 (let* ((char (json-pop))
281 (special (assq char json-special-chars)))
282 (cond
283 (special (cdr special))
284 ((not (eq char ?u)) char)
285 ((looking-at "[0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f]")
286 (let ((hex (match-string 0)))
287 (json-advance 4)
288 (json-decode-char0 'ucs (string-to-number hex 16))))
290 (signal 'json-string-escape (list (point)))))))
292 (defun json-read-string ()
293 "Read the JSON string at point."
294 (unless (char-equal (json-peek) ?\")
295 (signal 'json-string-format (list "doesn't start with '\"'!")))
296 ;; Skip over the '"'
297 (json-advance)
298 (let ((characters '())
299 (char (json-peek)))
300 (while (not (char-equal char ?\"))
301 (push (if (char-equal char ?\\)
302 (json-read-escaped-char)
303 (json-pop))
304 characters)
305 (setq char (json-peek)))
306 ;; Skip over the '"'
307 (json-advance)
308 (if characters
309 (apply 'string (nreverse characters))
310 "")))
312 ;; String encoding
314 (defun json-encode-char (char)
315 "Encode CHAR as a JSON string."
316 (setq char (json-encode-char0 char 'ucs))
317 (let ((control-char (car (rassoc char json-special-chars))))
318 (cond
319 ;; Special JSON character (\n, \r, etc.).
320 (control-char
321 (format "\\%c" control-char))
322 ;; ASCIIish printable character.
323 ((and (> char 31) (< char 127))
324 (format "%c" char))
325 ;; Fallback: UCS code point in \uNNNN form.
327 (format "\\u%04x" char)))))
329 (defun json-encode-string (string)
330 "Return a JSON representation of STRING."
331 (format "\"%s\"" (mapconcat 'json-encode-char string "")))
333 (defun json-encode-key (object)
334 "Return a JSON representation of OBJECT.
335 If the resulting JSON object isn't a valid JSON object key,
336 this signals `json-key-format'."
337 (let ((encoded (json-encode object)))
338 (unless (stringp (json-read-from-string encoded))
339 (signal 'json-key-format (list object)))
340 encoded))
342 ;;; JSON Objects
344 (defun json-new-object ()
345 "Create a new Elisp object corresponding to a JSON object.
346 Please see the documentation of `json-object-type'."
347 (cond ((eq json-object-type 'hash-table)
348 (make-hash-table :test 'equal))
350 (list))))
352 (defun json-add-to-object (object key value)
353 "Add a new KEY -> VALUE association to OBJECT.
354 Returns the updated object, which you should save, e.g.:
355 (setq obj (json-add-to-object obj \"foo\" \"bar\"))
356 Please see the documentation of `json-object-type' and `json-key-type'."
357 (let ((json-key-type
358 (if (eq json-key-type nil)
359 (cdr (assq json-object-type '((hash-table . string)
360 (alist . symbol)
361 (plist . keyword))))
362 json-key-type)))
363 (setq key
364 (cond ((eq json-key-type 'string)
365 key)
366 ((eq json-key-type 'symbol)
367 (intern key))
368 ((eq json-key-type 'keyword)
369 (intern (concat ":" key)))))
370 (cond ((eq json-object-type 'hash-table)
371 (puthash key value object)
372 object)
373 ((eq json-object-type 'alist)
374 (cons (cons key value) object))
375 ((eq json-object-type 'plist)
376 (cons key (cons value object))))))
378 ;; JSON object parsing
380 (defun json-read-object ()
381 "Read the JSON object at point."
382 ;; Skip over the "{"
383 (json-advance)
384 (json-skip-whitespace)
385 ;; read key/value pairs until "}"
386 (let ((elements (json-new-object))
387 key value)
388 (while (not (char-equal (json-peek) ?}))
389 (json-skip-whitespace)
390 (setq key (json-read-string))
391 (json-skip-whitespace)
392 (if (char-equal (json-peek) ?:)
393 (json-advance)
394 (signal 'json-object-format (list ":" (json-peek))))
395 (setq value (json-read))
396 (setq elements (json-add-to-object elements key value))
397 (json-skip-whitespace)
398 (unless (char-equal (json-peek) ?})
399 (if (char-equal (json-peek) ?,)
400 (json-advance)
401 (signal 'json-object-format (list "," (json-peek))))))
402 ;; Skip over the "}"
403 (json-advance)
404 elements))
406 ;; Hash table encoding
408 (defun json-encode-hash-table (hash-table)
409 "Return a JSON representation of HASH-TABLE."
410 (format "{%s%s}"
411 (json-join
412 (let (r)
413 (json--with-indentation
414 (maphash
415 (lambda (k v)
416 (push (format
417 (if json-encoding-pretty-print
418 "%s%s: %s"
419 "%s%s:%s")
420 json--encoding-current-indentation
421 (json-encode-key k)
422 (json-encode v))
424 hash-table))
426 json-encoding-separator)
427 (if (or (not json-encoding-pretty-print)
428 json-encoding-lisp-style-closings)
430 json--encoding-current-indentation)))
432 ;; List encoding (including alists and plists)
434 (defun json-encode-alist (alist)
435 "Return a JSON representation of ALIST."
436 (format "{%s%s}"
437 (json-join
438 (json--with-indentation
439 (mapcar (lambda (cons)
440 (format (if json-encoding-pretty-print
441 "%s%s: %s"
442 "%s%s:%s")
443 json--encoding-current-indentation
444 (json-encode-key (car cons))
445 (json-encode (cdr cons))))
446 alist))
447 json-encoding-separator)
448 (if (or (not json-encoding-pretty-print)
449 json-encoding-lisp-style-closings)
451 json--encoding-current-indentation)))
453 (defun json-encode-plist (plist)
454 "Return a JSON representation of PLIST."
455 (let (result)
456 (json--with-indentation
457 (while plist
458 (push (concat
459 json--encoding-current-indentation
460 (json-encode-key (car plist))
461 (if json-encoding-pretty-print
462 ": "
463 ":")
464 (json-encode (cadr plist)))
465 result)
466 (setq plist (cddr plist))))
467 (concat "{"
468 (json-join (nreverse result) json-encoding-separator)
469 (if (and json-encoding-pretty-print
470 (not json-encoding-lisp-style-closings))
471 json--encoding-current-indentation
473 "}")))
475 (defun json-encode-list (list)
476 "Return a JSON representation of LIST.
477 Tries to DWIM: simple lists become JSON arrays, while alists and plists
478 become JSON objects."
479 (cond ((null list) "null")
480 ((json-alist-p list) (json-encode-alist list))
481 ((json-plist-p list) (json-encode-plist list))
482 ((listp list) (json-encode-array list))
484 (signal 'json-error (list list)))))
486 ;;; Arrays
488 ;; Array parsing
490 (defun json-read-array ()
491 "Read the JSON array at point."
492 ;; Skip over the "["
493 (json-advance)
494 (json-skip-whitespace)
495 ;; read values until "]"
496 (let (elements)
497 (while (not (char-equal (json-peek) ?\]))
498 (push (json-read) elements)
499 (json-skip-whitespace)
500 (unless (char-equal (json-peek) ?\])
501 (if (char-equal (json-peek) ?,)
502 (json-advance)
503 (signal 'json-error (list 'bleah)))))
504 ;; Skip over the "]"
505 (json-advance)
506 (apply json-array-type (nreverse elements))))
508 ;; Array encoding
510 (defun json-encode-array (array)
511 "Return a JSON representation of ARRAY."
512 (if (and json-encoding-pretty-print
513 (> (length array) 0))
514 (concat
515 (json--with-indentation
516 (concat (format "[%s" json--encoding-current-indentation)
517 (json-join (mapcar 'json-encode array)
518 (format "%s%s"
519 json-encoding-separator
520 json--encoding-current-indentation))))
521 (format "%s]"
522 (if json-encoding-lisp-style-closings
524 json--encoding-current-indentation)))
525 (concat "["
526 (mapconcat 'json-encode array json-encoding-separator)
527 "]")))
531 ;;; JSON reader.
533 (defvar json-readtable
534 (let ((table
535 '((?t json-read-keyword "true")
536 (?f json-read-keyword "false")
537 (?n json-read-keyword "null")
538 (?{ json-read-object)
539 (?\[ json-read-array)
540 (?\" json-read-string))))
541 (mapc (lambda (char)
542 (push (list char 'json-read-number) table))
543 '(?- ?+ ?. ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
544 table)
545 "Readtable for JSON reader.")
547 (defun json-read ()
548 "Parse and return the JSON object following point.
549 Advances point just past JSON object."
550 (json-skip-whitespace)
551 (let ((char (json-peek)))
552 (if (not (eq char :json-eof))
553 (let ((record (cdr (assq char json-readtable))))
554 (if (functionp (car record))
555 (apply (car record) (cdr record))
556 (signal 'json-readtable-error record)))
557 (signal 'end-of-file nil))))
559 ;; Syntactic sugar for the reader
561 (defun json-read-from-string (string)
562 "Read the JSON object contained in STRING and return it."
563 (with-temp-buffer
564 (insert string)
565 (goto-char (point-min))
566 (json-read)))
568 (defun json-read-file (file)
569 "Read the first JSON object contained in FILE and return it."
570 (with-temp-buffer
571 (insert-file-contents file)
572 (goto-char (point-min))
573 (json-read)))
577 ;;; JSON encoder
579 (defun json-encode (object)
580 "Return a JSON representation of OBJECT as a string."
581 (cond ((memq object (list t json-null json-false))
582 (json-encode-keyword object))
583 ((stringp object) (json-encode-string object))
584 ((keywordp object) (json-encode-string
585 (substring (symbol-name object) 1)))
586 ((symbolp object) (json-encode-string
587 (symbol-name object)))
588 ((numberp object) (json-encode-number object))
589 ((arrayp object) (json-encode-array object))
590 ((hash-table-p object) (json-encode-hash-table object))
591 ((listp object) (json-encode-list object))
592 (t (signal 'json-error (list object)))))
594 ;; Pretty printing
596 (defun json-pretty-print-buffer ()
597 "Pretty-print current buffer."
598 (interactive)
599 (json-pretty-print (point-min) (point-max)))
601 (defun json-pretty-print (begin end)
602 "Pretty-print selected region."
603 (interactive "r")
604 (atomic-change-group
605 (let ((json-encoding-pretty-print t)
606 (txt (delete-and-extract-region begin end)))
607 (insert (json-encode (json-read-from-string txt))))))
609 (provide 'json)
611 ;;; json.el ends here