Be more tolerant to fonts named "Foobar-12"
[emacs.git] / lisp / json.el
blobeaf8596a6dc8649e6e6e01a5a42c2751e77b856f
1 ;;; json.el --- JavaScript Object Notation parser / generator
3 ;; Copyright (C) 2006-2015 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:
55 ;; Parameters
57 (defvar json-object-type 'alist
58 "Type to convert JSON objects to.
59 Must be one of `alist', `plist', or `hash-table'. Consider let-binding
60 this around your call to `json-read' instead of `setq'ing it.")
62 (defvar json-array-type 'vector
63 "Type to convert JSON arrays to.
64 Must be one of `vector' or `list'. Consider let-binding this around
65 your call to `json-read' instead of `setq'ing it.")
67 (defvar json-key-type nil
68 "Type to convert JSON keys to.
69 Must be one of `string', `symbol', `keyword', or nil.
71 If nil, `json-read' will guess the type based on the value of
72 `json-object-type':
74 If `json-object-type' is: nil will be interpreted as:
75 `hash-table' `string'
76 `alist' `symbol'
77 `plist' `keyword'
79 Note that values other than `string' might behave strangely for
80 Sufficiently Weird keys. Consider let-binding this around your call to
81 `json-read' instead of `setq'ing it.")
83 (defvar json-false :json-false
84 "Value to use when reading JSON `false'.
85 If this has the same value as `json-null', you might not be able to tell
86 the difference between `false' and `null'. Consider let-binding this
87 around your call to `json-read' instead of `setq'ing it.")
89 (defvar json-null nil
90 "Value to use when reading JSON `null'.
91 If this has the same value as `json-false', you might not be able to
92 tell the difference between `false' and `null'. Consider let-binding
93 this around your call to `json-read' instead of `setq'ing it.")
95 (defvar json-encoding-separator ","
96 "Value to use as an element separator when encoding.")
98 (defvar json-encoding-default-indentation " "
99 "The default indentation level for encoding.
100 Used only when `json-encoding-pretty-print' is non-nil.")
102 (defvar json--encoding-current-indentation "\n"
103 "Internally used to keep track of the current indentation level of encoding.
104 Used only when `json-encoding-pretty-print' is non-nil.")
106 (defvar json-encoding-pretty-print nil
107 "If non-nil, then the output of `json-encode' will be pretty-printed.")
109 (defvar json-encoding-lisp-style-closings nil
110 "If non-nil, ] and } closings will be formatted lisp-style,
111 without indentation.")
115 ;;; Utilities
117 (defun json-join (strings separator)
118 "Join STRINGS with SEPARATOR."
119 (mapconcat 'identity strings separator))
121 (defun json-alist-p (list)
122 "Non-null if and only if LIST is an alist with simple keys."
123 (while (consp list)
124 (setq list (if (and (consp (car list))
125 (atom (caar list)))
126 (cdr list)
127 'not-alist)))
128 (null list))
130 (defun json-plist-p (list)
131 "Non-null if and only if LIST is a plist."
132 (while (consp list)
133 (setq list (if (and (keywordp (car list))
134 (consp (cdr list)))
135 (cddr list)
136 'not-plist)))
137 (null list))
139 (defmacro json--with-indentation (body)
140 `(let ((json--encoding-current-indentation
141 (if json-encoding-pretty-print
142 (concat json--encoding-current-indentation
143 json-encoding-default-indentation)
144 "")))
145 ,body))
147 ;; Reader utilities
149 (defsubst json-advance (&optional n)
150 "Skip past the following N characters."
151 (forward-char n))
153 (defsubst json-peek ()
154 "Return the character at point."
155 (let ((char (char-after (point))))
156 (or char :json-eof)))
158 (defsubst json-pop ()
159 "Advance past the character at point, returning it."
160 (let ((char (json-peek)))
161 (if (eq char :json-eof)
162 (signal 'json-end-of-file nil)
163 (json-advance)
164 char)))
166 (defun json-skip-whitespace ()
167 "Skip past the whitespace at point."
168 (skip-chars-forward "\t\r\n\f\b "))
172 ;; Error conditions
174 (define-error 'json-error "Unknown JSON error")
175 (define-error 'json-readtable-error "JSON readtable error" 'json-error)
176 (define-error 'json-unknown-keyword "Unrecognized keyword" 'json-error)
177 (define-error 'json-number-format "Invalid number format" 'json-error)
178 (define-error 'json-string-escape "Bad Unicode escape" 'json-error)
179 (define-error 'json-string-format "Bad string format" 'json-error)
180 (define-error 'json-key-format "Bad JSON object key" 'json-error)
181 (define-error 'json-object-format "Bad JSON object" 'json-error)
182 (define-error 'json-end-of-file "End of file while parsing JSON"
183 '(end-of-file json-error))
187 ;;; Keywords
189 (defvar json-keywords '("true" "false" "null")
190 "List of JSON keywords.")
192 ;; Keyword parsing
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)))
199 (mapc (lambda (char)
200 (unless (char-equal char (json-peek))
201 (signal 'json-unknown-keyword
202 (list (save-excursion
203 (backward-word 1)
204 (thing-at-point 'word)))))
205 (json-advance))
206 keyword)
207 (unless (looking-at "\\(\\s-\\|[],}]\\|$\\)")
208 (signal 'json-unknown-keyword
209 (list (save-excursion
210 (backward-word 1)
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)))
216 ;; Keyword encoding
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")))
224 ;;; Numbers
226 ;; Number parsing
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.
235 (let ((number-regexp
236 "\\([0-9]+\\)?\\(\\.[0-9]+\\)?\\([Ee][+-]?[0-9]+\\)?"))
237 (cond ((and (null sign) (char-equal (json-peek) ?-))
238 (json-advance)
239 (- (json-read-number t)))
240 ((and (null sign) (char-equal (json-peek) ?+))
241 (json-advance)
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)))))))
250 ;; Number encoding
252 (defun json-encode-number (number)
253 "Return a JSON representation of NUMBER."
254 (format "%s" number))
256 ;;; Strings
258 (defvar json-special-chars
259 '((?\" . ?\")
260 (?\\ . ?\\)
261 (?b . ?\b)
262 (?f . ?\f)
263 (?n . ?\n)
264 (?r . ?\r)
265 (?t . ?\t))
266 "Characters which are escaped in JSON, with their elisp counterparts.")
268 ;; String parsing
270 (defun json-read-escaped-char ()
271 "Read the JSON string escaped character at point."
272 ;; Skip over the '\'
273 (json-advance)
274 (let* ((char (json-pop))
275 (special (assq char json-special-chars)))
276 (cond
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)))
281 (json-advance 4)
282 (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 '\"'!")))
290 ;; Skip over the '"'
291 (json-advance)
292 (let ((characters '())
293 (char (json-peek)))
294 (while (not (char-equal char ?\"))
295 (push (if (char-equal char ?\\)
296 (json-read-escaped-char)
297 (json-pop))
298 characters)
299 (setq char (json-peek)))
300 ;; Skip over the '"'
301 (json-advance)
302 (if characters
303 (apply 'string (nreverse characters))
304 "")))
306 ;; String encoding
308 (defun json-encode-string (string)
309 "Return a JSON representation of STRING."
310 ;; Reimplement the meat of `replace-regexp-in-string', for
311 ;; performance (bug#20154).
312 (let ((l (length string))
313 (start 0)
314 res mb)
315 ;; Only escape quotation mark, backslash and the control
316 ;; characters U+0000 to U+001F (RFC 4627, ECMA-404).
317 (while (setq mb (string-match "[\"\\[:cntrl:]]" string start))
318 (let* ((c (aref string mb))
319 (special (rassq c json-special-chars)))
320 (push (substring string start mb) res)
321 (push (if special
322 ;; Special JSON character (\n, \r, etc.).
323 (string ?\\ (car special))
324 ;; Fallback: UCS code point in \uNNNN form.
325 (format "\\u%04x" c))
326 res)
327 (setq start (1+ mb))))
328 (push (substring string start l) res)
329 (push "\"" res)
330 (apply #'concat "\"" (nreverse res))))
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 'json-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