json.el 25.2 KB
Newer Older
1
;;; json.el --- JavaScript Object Notation parser / generator -*- lexical-binding: t -*-
2

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 2006-2017 Free Software Foundation, Inc.
4

Glenn Morris's avatar
Glenn Morris committed
5
;; Author: Theresa O'Connor <ted@oconnor.cx>
6
;; Version: 1.4
7 8 9 10
;; Keywords: convenience

;; 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 14
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
15 16 17 18 19 20 21

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; 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/>.
23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49

;;; Commentary:

;; This is a library for parsing and generating JSON (JavaScript Object
;; Notation).

;; Learn all about JSON here: <URL:http://json.org/>.

;; The user-serviceable entry points for the parser are the functions
;; `json-read' and `json-read-from-string'. The encoder has a single
;; entry point, `json-encode'.

;; Since there are several natural representations of key-value pair
;; mappings in elisp (alist, plist, hash-table), `json-read' allows you
;; to specify which you'd prefer (see `json-object-type' and
;; `json-array-type').

;; Similarly, since `false' and `null' are distinct in JSON, you can
;; distinguish them by binding `json-false' and `json-null' as desired.

;;; History:

;; 2006-03-11 - Initial version.
;; 2006-03-13 - Added JSON generation in addition to parsing. Various
;;              other cleanups, bugfixes, and improvements.
;; 2006-12-29 - XEmacs support, from Aidan Kehoe <kehoea@parhasard.net>.
;; 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)
52 53 54

;;; Code:

55 56
(require 'map)

57 58 59 60
;; Parameters

(defvar json-object-type 'alist
  "Type to convert JSON objects to.
Juanma Barranquero's avatar
Juanma Barranquero committed
61
Must be one of `alist', `plist', or `hash-table'.  Consider let-binding
62 63
this around your call to `json-read' instead of `setq'ing it.  Ordering
is maintained for `alist' and `plist', but not for `hash-table'.")
64 65 66

(defvar json-array-type 'vector
  "Type to convert JSON arrays to.
Juanma Barranquero's avatar
Juanma Barranquero committed
67
Must be one of `vector' or `list'.  Consider let-binding this around
68 69 70 71 72 73 74 75 76 77 78 79 80 81 82
your call to `json-read' instead of `setq'ing it.")

(defvar json-key-type nil
  "Type to convert JSON keys to.
Must be one of `string', `symbol', `keyword', or nil.

If nil, `json-read' will guess the type based on the value of
`json-object-type':

    If `json-object-type' is:   nil will be interpreted as:
      `hash-table'                `string'
      `alist'                     `symbol'
      `plist'                     `keyword'

Note that values other than `string' might behave strangely for
Juanma Barranquero's avatar
Juanma Barranquero committed
83
Sufficiently Weird keys.  Consider let-binding this around your call to
84 85 86 87 88
`json-read' instead of `setq'ing it.")

(defvar json-false :json-false
  "Value to use when reading JSON `false'.
If this has the same value as `json-null', you might not be able to tell
Juanma Barranquero's avatar
Juanma Barranquero committed
89
the difference between `false' and `null'.  Consider let-binding this
90 91 92 93 94
around your call to `json-read' instead of `setq'ing it.")

(defvar json-null nil
  "Value to use when reading JSON `null'.
If this has the same value as `json-false', you might not be able to
Juanma Barranquero's avatar
Juanma Barranquero committed
95
tell the difference between `false' and `null'.  Consider let-binding
96 97
this around your call to `json-read' instead of `setq'ing it.")

98
(defvar json-encoding-separator ","
Paul Eggert's avatar
Paul Eggert committed
99
  "Value to use as an element separator when encoding.")
100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115

(defvar json-encoding-default-indentation "  "
  "The default indentation level for encoding.
Used only when `json-encoding-pretty-print' is non-nil.")

(defvar json--encoding-current-indentation "\n"
  "Internally used to keep track of the current indentation level of encoding.
Used only when `json-encoding-pretty-print' is non-nil.")

(defvar json-encoding-pretty-print nil
  "If non-nil, then the output of `json-encode' will be pretty-printed.")

(defvar json-encoding-lisp-style-closings nil
  "If non-nil, ] and } closings will be formatted lisp-style,
without indentation.")

116 117 118 119 120 121 122
(defvar json-encoding-object-sort-predicate nil
  "Sorting predicate for JSON object keys during encoding.
If nil, no sorting is performed.  Else, JSON object keys are
ordered by the specified sort predicate during encoding.  For
instance, setting this to `string<' will have JSON object keys
ordered alphabetically.")

123 124 125 126 127 128 129 130 131 132 133
(defvar json-pre-element-read-function nil
  "Function called (if non-nil) by `json-read-array' and
`json-read-object' right before reading a JSON array or object,
respectively.  The function is called with one argument, which is
the current JSON key.")

(defvar json-post-element-read-function nil
  "Function called (if non-nil) by `json-read-array' and
`json-read-object' right after reading a JSON array or object,
respectively.")

134 135 136 137 138 139 140 141 142


;;; Utilities

(defun json-join (strings separator)
  "Join STRINGS with SEPARATOR."
  (mapconcat 'identity strings separator))

(defun json-alist-p (list)
143
  "Non-null if and only if LIST is an alist with simple keys."
144
  (while (consp list)
145 146
    (setq list (if (and (consp (car list))
                        (atom (caar list)))
147 148 149
                   (cdr list)
                 'not-alist)))
  (null list))
150 151

(defun json-plist-p (list)
152
  "Non-null if and only if LIST is a plist with keyword keys."
153 154 155 156 157 158
  (while (consp list)
    (setq list (if (and (keywordp (car list))
                        (consp (cdr list)))
                   (cddr list)
                 'not-plist)))
  (null list))
159

160 161 162 163 164 165 166 167 168 169 170
(defun json--plist-reverse (plist)
  "Return a copy of PLIST in reverse order.
Unlike `reverse', this keeps the property-value pairs intact."
  (let (res)
    (while plist
      (let ((prop (pop plist))
            (val (pop plist)))
        (push val res)
        (push prop res)))
    res))

171 172 173 174 175 176 177 178 179
(defun json--plist-to-alist (plist)
  "Return an alist of the property-value pairs in PLIST."
  (let (res)
    (while plist
      (let ((prop (pop plist))
            (val (pop plist)))
        (push (cons prop val) res)))
    (nreverse res)))

180 181 182 183 184 185 186 187
(defmacro json--with-indentation (body)
  `(let ((json--encoding-current-indentation
          (if json-encoding-pretty-print
              (concat json--encoding-current-indentation
                      json-encoding-default-indentation)
            "")))
     ,body))

188 189 190
;; Reader utilities

(defsubst json-advance (&optional n)
Mark Oteiza's avatar
Mark Oteiza committed
191
  "Advance N characters forward."
192
  (forward-char n))
193 194 195 196 197 198 199 200 201 202

(defsubst json-peek ()
  "Return the character at point."
  (let ((char (char-after (point))))
    (or char :json-eof)))

(defsubst json-pop ()
  "Advance past the character at point, returning it."
  (let ((char (json-peek)))
    (if (eq char :json-eof)
203
        (signal 'json-end-of-file nil)
204 205 206 207 208
      (json-advance)
      char)))

(defun json-skip-whitespace ()
  "Skip past the whitespace at point."
209 210 211 212 213
  ;; See
  ;; https://www.ecma-international.org/publications/files/ECMA-ST/ECMA-404.pdf
  ;; or https://tools.ietf.org/html/rfc7159#section-2 for the
  ;; definition of whitespace in JSON.
  (skip-chars-forward "\t\r\n "))
214 215 216 217 218



;; Error conditions

219 220 221 222 223 224 225 226
(define-error 'json-error "Unknown JSON error")
(define-error 'json-readtable-error "JSON readtable error" 'json-error)
(define-error 'json-unknown-keyword "Unrecognized keyword" 'json-error)
(define-error 'json-number-format "Invalid number format" 'json-error)
(define-error 'json-string-escape "Bad Unicode escape" 'json-error)
(define-error 'json-string-format "Bad string format" 'json-error)
(define-error 'json-key-format "Bad JSON object key" 'json-error)
(define-error 'json-object-format "Bad JSON object" 'json-error)
227 228
(define-error 'json-end-of-file "End of file while parsing JSON"
  '(end-of-file json-error))
229 230 231



232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286
;;; Paths

(defvar json--path '()
  "Used internally by `json-path-to-position' to keep track of
the path during recursive calls to `json-read'.")

(defun json--record-path (key)
  "Record the KEY to the current JSON path.
Used internally by `json-path-to-position'."
  (push (cons (point) key) json--path))

(defun json--check-position (position)
  "Check if the last parsed JSON structure passed POSITION.
Used internally by `json-path-to-position'."
  (let ((start (caar json--path)))
    (when (< start position (+ (point) 1))
      (throw :json-path (list :path (nreverse (mapcar #'cdr json--path))
                              :match-start start
                              :match-end (point)))))
  (pop json--path))

(defun json-path-to-position (position &optional string)
  "Return the path to the JSON element at POSITION.

When STRING is provided, return the path to the position in the
string, else to the position in the current buffer.

The return value is a property list with the following
properties:

:path        -- A list of strings and numbers forming the path to
                the JSON element at the given position.  Strings
                denote object names, while numbers denote array
                indexes.

:match-start -- Position where the matched JSON element begins.

:match-end   -- Position where the matched JSON element ends.

This can for instance be useful to determine the path to a JSON
element in a deeply nested structure."
  (save-excursion
    (unless string
      (goto-char (point-min)))
    (let* ((json--path '())
           (json-pre-element-read-function #'json--record-path)
           (json-post-element-read-function
            (apply-partially #'json--check-position position))
           (path (catch :json-path
                   (if string
                       (json-read-from-string string)
                     (json-read)))))
      (when (plist-get path :path)
        path))))

287 288 289 290 291 292 293 294 295 296 297 298 299
;;; Keywords

(defvar json-keywords '("true" "false" "null")
  "List of JSON keywords.")

;; Keyword parsing

(defun json-read-keyword (keyword)
  "Read a JSON keyword at point.
KEYWORD is the keyword expected."
  (unless (member keyword json-keywords)
    (signal 'json-unknown-keyword (list keyword)))
  (mapc (lambda (char)
Mark Oteiza's avatar
Mark Oteiza committed
300
          (when (/= char (json-peek))
301 302
            (signal 'json-unknown-keyword
                    (list (save-excursion
303
                            (backward-word-strictly 1)
304
                            (thing-at-point 'word)))))
305 306 307 308 309
          (json-advance))
        keyword)
  (unless (looking-at "\\(\\s-\\|[],}]\\|$\\)")
    (signal 'json-unknown-keyword
            (list (save-excursion
310
                    (backward-word-strictly 1)
311
                    (thing-at-point 'word)))))
312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327
  (cond ((string-equal keyword "true") t)
        ((string-equal keyword "false") json-false)
        ((string-equal keyword "null") json-null)))

;; Keyword encoding

(defun json-encode-keyword (keyword)
  "Encode KEYWORD as a JSON value."
  (cond ((eq keyword t)          "true")
        ((eq keyword json-false) "false")
        ((eq keyword json-null)  "null")))

;;; Numbers

;; Number parsing

328 329
(defun json-read-number (&optional sign)
 "Read the JSON number following point.
Juanma Barranquero's avatar
Juanma Barranquero committed
330
The optional SIGN argument is for internal use.
331

332 333
N.B.: Only numbers which can fit in Emacs Lisp's native number
representation will be parsed correctly."
334 335 336
 ;; If SIGN is non-nil, the number is explicitly signed.
 (let ((number-regexp
        "\\([0-9]+\\)?\\(\\.[0-9]+\\)?\\([Ee][+-]?[0-9]+\\)?"))
Mark Oteiza's avatar
Mark Oteiza committed
337
   (cond ((and (null sign) (= (json-peek) ?-))
338 339
          (json-advance)
          (- (json-read-number t)))
Mark Oteiza's avatar
Mark Oteiza committed
340
         ((and (null sign) (= (json-peek) ?+))
341 342 343 344 345
          (json-advance)
          (json-read-number t))
         ((and (looking-at number-regexp)
               (or (match-beginning 1)
                   (match-beginning 2)))
346 347
          (goto-char (match-end 0))
          (string-to-number (match-string 0)))
348
         (t (signal 'json-number-format (list (point)))))))
349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369

;; Number encoding

(defun json-encode-number (number)
  "Return a JSON representation of NUMBER."
  (format "%s" number))

;;; Strings

(defvar json-special-chars
  '((?\" . ?\")
    (?\\ . ?\\)
    (?b . ?\b)
    (?f . ?\f)
    (?n . ?\n)
    (?r . ?\r)
    (?t . ?\t))
  "Characters which are escaped in JSON, with their elisp counterparts.")

;; String parsing

370 371 372 373
(defun json--decode-utf-16-surrogates (high low)
  "Return the code point represented by the UTF-16 surrogates HIGH and LOW."
  (+ (lsh (- high #xD800) 10) (- low #xDC00) #x10000))

374 375 376 377 378 379 380 381 382
(defun json-read-escaped-char ()
  "Read the JSON string escaped character at point."
  ;; Skip over the '\'
  (json-advance)
  (let* ((char (json-pop))
         (special (assq char json-special-chars)))
    (cond
     (special (cdr special))
     ((not (eq char ?u)) char)
383 384 385 386 387
     ;; Special-case UTF-16 surrogate pairs,
     ;; cf. https://tools.ietf.org/html/rfc7159#section-7.  Note that
     ;; this clause overlaps with the next one and therefore has to
     ;; come first.
     ((looking-at
Mark Oteiza's avatar
Mark Oteiza committed
388 389
       (rx (group (any "Dd") (any "89ABab") (= 2 (any xdigit)))
           "\\u" (group (any "Dd") (any "C-Fc-f") (= 2 (any xdigit)))))
390 391 392 393
      (json-advance 10)
      (json--decode-utf-16-surrogates
       (string-to-number (match-string 1) 16)
       (string-to-number (match-string 2) 16)))
Mark Oteiza's avatar
Mark Oteiza committed
394
     ((looking-at (rx (= 4 xdigit)))
395 396
      (let ((hex (match-string 0)))
        (json-advance 4)
397
        (string-to-number hex 16)))
398 399 400 401 402
     (t
      (signal 'json-string-escape (list (point)))))))

(defun json-read-string ()
  "Read the JSON string at point."
Mark Oteiza's avatar
Mark Oteiza committed
403
  (unless (= (json-peek) ?\")
404
    (signal 'json-string-format (list "doesn't start with `\"'!")))
405 406 407 408
  ;; Skip over the '"'
  (json-advance)
  (let ((characters '())
        (char (json-peek)))
Mark Oteiza's avatar
Mark Oteiza committed
409 410
    (while (not (= char ?\"))
      (push (if (= char ?\\)
411 412 413 414 415 416 417 418 419 420 421 422 423 424
                (json-read-escaped-char)
              (json-pop))
            characters)
      (setq char (json-peek)))
    ;; Skip over the '"'
    (json-advance)
    (if characters
        (apply 'string (nreverse characters))
      "")))

;; String encoding

(defun json-encode-string (string)
  "Return a JSON representation of STRING."
Dmitry Gutov's avatar
Dmitry Gutov committed
425 426 427 428 429
  ;; Reimplement the meat of `replace-regexp-in-string', for
  ;; performance (bug#20154).
  (let ((l (length string))
        (start 0)
        res mb)
430 431 432
    ;; Only escape quotation mark, backslash and the control
    ;; characters U+0000 to U+001F (RFC 4627, ECMA-404).
    (while (setq mb (string-match "[\"\\[:cntrl:]]" string start))
Dmitry Gutov's avatar
Dmitry Gutov committed
433 434 435 436 437 438 439 440 441 442 443 444 445
      (let* ((c (aref string mb))
             (special (rassq c json-special-chars)))
        (push (substring string start mb) res)
        (push (if special
                  ;; Special JSON character (\n, \r, etc.).
                  (string ?\\ (car special))
                ;; Fallback: UCS code point in \uNNNN form.
                (format "\\u%04x" c))
              res)
        (setq start (1+ mb))))
    (push (substring string start l) res)
    (push "\"" res)
    (apply #'concat "\"" (nreverse res))))
446

447 448 449 450 451 452 453 454 455
(defun json-encode-key (object)
  "Return a JSON representation of OBJECT.
If the resulting JSON object isn't a valid JSON object key,
this signals `json-key-format'."
  (let ((encoded (json-encode object)))
    (unless (stringp (json-read-from-string encoded))
      (signal 'json-key-format (list object)))
    encoded))

456 457 458 459 460 461 462 463
;;; JSON Objects

(defun json-new-object ()
  "Create a new Elisp object corresponding to a JSON object.
Please see the documentation of `json-object-type'."
  (cond ((eq json-object-type 'hash-table)
         (make-hash-table :test 'equal))
        (t
464
         ())))
465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501

(defun json-add-to-object (object key value)
  "Add a new KEY -> VALUE association to OBJECT.
Returns the updated object, which you should save, e.g.:
    (setq obj (json-add-to-object obj \"foo\" \"bar\"))
Please see the documentation of `json-object-type' and `json-key-type'."
  (let ((json-key-type
         (if (eq json-key-type nil)
             (cdr (assq json-object-type '((hash-table . string)
                                           (alist . symbol)
                                           (plist . keyword))))
           json-key-type)))
    (setq key
          (cond ((eq json-key-type 'string)
                 key)
                ((eq json-key-type 'symbol)
                 (intern key))
                ((eq json-key-type 'keyword)
                 (intern (concat ":" key)))))
    (cond ((eq json-object-type 'hash-table)
           (puthash key value object)
           object)
          ((eq json-object-type 'alist)
           (cons (cons key value) object))
          ((eq json-object-type 'plist)
           (cons key (cons value object))))))

;; JSON object parsing

(defun json-read-object ()
  "Read the JSON object at point."
  ;; Skip over the "{"
  (json-advance)
  (json-skip-whitespace)
  ;; read key/value pairs until "}"
  (let ((elements (json-new-object))
        key value)
Mark Oteiza's avatar
Mark Oteiza committed
502
    (while (not (= (json-peek) ?}))
503 504 505
      (json-skip-whitespace)
      (setq key (json-read-string))
      (json-skip-whitespace)
Mark Oteiza's avatar
Mark Oteiza committed
506
      (if (= (json-peek) ?:)
507 508
          (json-advance)
        (signal 'json-object-format (list ":" (json-peek))))
509 510 511
      (json-skip-whitespace)
      (when json-pre-element-read-function
        (funcall json-pre-element-read-function key))
512
      (setq value (json-read))
513 514
      (when json-post-element-read-function
        (funcall json-post-element-read-function))
515 516
      (setq elements (json-add-to-object elements key value))
      (json-skip-whitespace)
Mark Oteiza's avatar
Mark Oteiza committed
517 518
      (when (/= (json-peek) ?})
        (if (= (json-peek) ?,)
519 520 521 522
            (json-advance)
          (signal 'json-object-format (list "," (json-peek))))))
    ;; Skip over the "}"
    (json-advance)
523 524 525 526
    (pcase json-object-type
      (`alist (nreverse elements))
      (`plist (json--plist-reverse elements))
      (_ elements))))
527 528 529 530 531

;; Hash table encoding

(defun json-encode-hash-table (hash-table)
  "Return a JSON representation of HASH-TABLE."
532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554
  (if json-encoding-object-sort-predicate
      (json-encode-alist (map-into hash-table 'list))
    (format "{%s%s}"
            (json-join
             (let (r)
               (json--with-indentation
                (maphash
                 (lambda (k v)
                   (push (format
                          (if json-encoding-pretty-print
                              "%s%s: %s"
                            "%s%s:%s")
                          json--encoding-current-indentation
                          (json-encode-key k)
                          (json-encode v))
                         r))
                 hash-table))
               r)
             json-encoding-separator)
            (if (or (not json-encoding-pretty-print)
                    json-encoding-lisp-style-closings)
                ""
              json--encoding-current-indentation))))
555 556 557 558 559

;; List encoding (including alists and plists)

(defun json-encode-alist (alist)
  "Return a JSON representation of ALIST."
560 561 562 563 564
  (when json-encoding-object-sort-predicate
    (setq alist
          (sort alist (lambda (a b)
                        (funcall json-encoding-object-sort-predicate
                                 (car a) (car b))))))
565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580
  (format "{%s%s}"
          (json-join
           (json--with-indentation
            (mapcar (lambda (cons)
                      (format (if json-encoding-pretty-print
                                  "%s%s: %s"
                                "%s%s:%s")
                              json--encoding-current-indentation
                              (json-encode-key (car cons))
                              (json-encode (cdr cons))))
                    alist))
           json-encoding-separator)
          (if (or (not json-encoding-pretty-print)
                  json-encoding-lisp-style-closings)
              ""
            json--encoding-current-indentation)))
581 582 583

(defun json-encode-plist (plist)
  "Return a JSON representation of PLIST."
584 585 586 587 588 589
  (if json-encoding-object-sort-predicate
      (json-encode-alist (json--plist-to-alist plist))
    (let (result)
      (json--with-indentation
       (while plist
         (push (concat
590
                json--encoding-current-indentation
591 592 593 594 595 596 597 598 599 600 601 602 603 604
                (json-encode-key (car plist))
                (if json-encoding-pretty-print
                    ": "
                  ":")
                (json-encode (cadr plist)))
               result)
         (setq plist (cddr plist))))
      (concat "{"
              (json-join (nreverse result) json-encoding-separator)
              (if (and json-encoding-pretty-print
                       (not json-encoding-lisp-style-closings))
                  json--encoding-current-indentation
                "")
              "}"))))
605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627

(defun json-encode-list (list)
  "Return a JSON representation of LIST.
Tries to DWIM: simple lists become JSON arrays, while alists and plists
become JSON objects."
  (cond ((null list)         "null")
        ((json-alist-p list) (json-encode-alist list))
        ((json-plist-p list) (json-encode-plist list))
        ((listp list)        (json-encode-array list))
        (t
         (signal 'json-error (list list)))))

;;; Arrays

;; Array parsing

(defun json-read-array ()
  "Read the JSON array at point."
  ;; Skip over the "["
  (json-advance)
  (json-skip-whitespace)
  ;; read values until "]"
  (let (elements)
Mark Oteiza's avatar
Mark Oteiza committed
628
    (while (not (= (json-peek) ?\]))
629 630 631
      (json-skip-whitespace)
      (when json-pre-element-read-function
        (funcall json-pre-element-read-function (length elements)))
632
      (push (json-read) elements)
633 634
      (when json-post-element-read-function
        (funcall json-post-element-read-function))
635
      (json-skip-whitespace)
Mark Oteiza's avatar
Mark Oteiza committed
636 637
      (when (/= (json-peek) ?\])
        (if (= (json-peek) ?,)
638 639 640 641 642 643 644 645 646 647
            (json-advance)
          (signal 'json-error (list 'bleah)))))
    ;; Skip over the "]"
    (json-advance)
    (apply json-array-type (nreverse elements))))

;; Array encoding

(defun json-encode-array (array)
  "Return a JSON representation of ARRAY."
648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663
  (if (and json-encoding-pretty-print
           (> (length array) 0))
      (concat
       (json--with-indentation
         (concat (format "[%s" json--encoding-current-indentation)
                 (json-join (mapcar 'json-encode array)
                            (format "%s%s"
                                    json-encoding-separator
                                    json--encoding-current-indentation))))
       (format "%s]"
               (if json-encoding-lisp-style-closings
                   ""
                 json--encoding-current-indentation)))
    (concat "["
            (mapconcat 'json-encode array json-encoding-separator)
            "]")))
664 665 666 667 668 669 670 671 672 673 674 675 676 677 678



;;; JSON reader.

(defvar json-readtable
  (let ((table
         '((?t json-read-keyword "true")
           (?f json-read-keyword "false")
           (?n json-read-keyword "null")
           (?{ json-read-object)
           (?\[ json-read-array)
           (?\" json-read-string))))
    (mapc (lambda (char)
            (push (list char 'json-read-number) table))
679
          '(?- ?+ ?. ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
680 681 682 683 684 685 686 687 688 689 690 691 692
    table)
  "Readtable for JSON reader.")

(defun json-read ()
  "Parse and return the JSON object following point.
Advances point just past JSON object."
  (json-skip-whitespace)
  (let ((char (json-peek)))
    (if (not (eq char :json-eof))
        (let ((record (cdr (assq char json-readtable))))
          (if (functionp (car record))
              (apply (car record) (cdr record))
            (signal 'json-readtable-error record)))
693
      (signal 'json-end-of-file nil))))
694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729

;; Syntactic sugar for the reader

(defun json-read-from-string (string)
  "Read the JSON object contained in STRING and return it."
  (with-temp-buffer
    (insert string)
    (goto-char (point-min))
    (json-read)))

(defun json-read-file (file)
  "Read the first JSON object contained in FILE and return it."
  (with-temp-buffer
    (insert-file-contents file)
    (goto-char (point-min))
    (json-read)))



;;; JSON encoder

(defun json-encode (object)
  "Return a JSON representation of OBJECT as a string."
  (cond ((memq object (list t json-null json-false))
         (json-encode-keyword object))
        ((stringp object)      (json-encode-string object))
        ((keywordp object)     (json-encode-string
                                (substring (symbol-name object) 1)))
        ((symbolp object)      (json-encode-string
                                (symbol-name object)))
        ((numberp object)      (json-encode-number object))
        ((arrayp object)       (json-encode-array object))
        ((hash-table-p object) (json-encode-hash-table object))
        ((listp object)        (json-encode-list object))
        (t                     (signal 'json-error (list object)))))

730 731 732 733 734 735 736 737 738 739 740 741
;; Pretty printing

(defun json-pretty-print-buffer ()
  "Pretty-print current buffer."
  (interactive)
  (json-pretty-print (point-min) (point-max)))

(defun json-pretty-print (begin end)
  "Pretty-print selected region."
  (interactive "r")
  (atomic-change-group
    (let ((json-encoding-pretty-print t)
742 743
          ;; Ensure that ordering is maintained
          (json-object-type 'alist)
744 745 746
          (txt (delete-and-extract-region begin end)))
      (insert (json-encode (json-read-from-string txt))))))

747 748 749 750 751 752 753 754 755 756 757 758
(defun json-pretty-print-buffer-ordered ()
  "Pretty-print current buffer with object keys ordered."
  (interactive)
  (let ((json-encoding-object-sort-predicate 'string<))
    (json-pretty-print-buffer)))

(defun json-pretty-print-ordered (begin end)
  "Pretty-print the region with object keys ordered."
  (interactive "r")
  (let ((json-encoding-object-sort-predicate 'string<))
    (json-pretty-print begin end)))

759 760 761
(provide 'json)

;;; json.el ends here