code.delx.au - gnu-emacs/blob - lisp/json.el

   1 ;;; json.el --- JavaScript Object Notation parser / generator
   2
   3 ;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
   4
   5 ;; Author: Edward O'Connor <ted@oconnor.cx>
   6 ;; Version: 1.4
   7 ;; Keywords: convenience
   8
   9 ;; This file is part of GNU Emacs.
  10
  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.
  15
  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.
  20
  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/>.
  23
  24 ;;; Commentary:
  25
  26 ;; This is a library for parsing and generating JSON (JavaScript Object
  27 ;; Notation).
  28
  29 ;; Learn all about JSON here: <URL:http://json.org/>.
  30
  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'.
  34
  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').
  39
  40 ;; Similarly, since `false' and `null' are distinct in JSON, you can
  41 ;; distinguish them by binding `json-false' and `json-null' as desired.
  42
  43 ;;; History:
  44
  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)
  52
  53 ;;; Code:
  54
  55 ;; Parameters
  56
  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.  Ordering
  61 is maintained for `alist' and `plist', but not for `hash-table'.")
  62
  63 (defvar json-array-type 'vector
  64   "Type to convert JSON arrays to.
  65 Must be one of `vector' or `list'.  Consider let-binding this around
  66 your call to `json-read' instead of `setq'ing it.")
  67
  68 (defvar json-key-type nil
  69   "Type to convert JSON keys to.
  70 Must be one of `string', `symbol', `keyword', or nil.
  71
  72 If nil, `json-read' will guess the type based on the value of
  73 `json-object-type':
  74
  75     If `json-object-type' is:   nil will be interpreted as:
  76       `hash-table'                `string'
  77       `alist'                     `symbol'
  78       `plist'                     `keyword'
  79
  80 Note that values other than `string' might behave strangely for
  81 Sufficiently Weird keys.  Consider let-binding this around your call to
  82 `json-read' instead of `setq'ing it.")
  83
  84 (defvar json-false :json-false
  85   "Value to use when reading JSON `false'.
  86 If this has the same value as `json-null', you might not be able to tell
  87 the difference between `false' and `null'.  Consider let-binding this
  88 around your call to `json-read' instead of `setq'ing it.")
  89
  90 (defvar json-null nil
  91   "Value to use when reading JSON `null'.
  92 If this has the same value as `json-false', you might not be able to
  93 tell the difference between `false' and `null'.  Consider let-binding
  94 this around your call to `json-read' instead of `setq'ing it.")
  95
  96 (defvar json-encoding-separator ","
  97   "Value to use as an element separator when encoding.")
  98
  99 (defvar json-encoding-default-indentation "  "
 100   "The default indentation level for encoding.
 101 Used only when `json-encoding-pretty-print' is non-nil.")
 102
 103 (defvar json--encoding-current-indentation "\n"
 104   "Internally used to keep track of the current indentation level of encoding.
 105 Used only when `json-encoding-pretty-print' is non-nil.")
 106
 107 (defvar json-encoding-pretty-print nil
 108   "If non-nil, then the output of `json-encode' will be pretty-printed.")
 109
 110 (defvar json-encoding-lisp-style-closings nil
 111   "If non-nil, ] and } closings will be formatted lisp-style,
 112 without indentation.")
 113
 114 (defvar json-pre-element-read-function nil
 115   "Function called (if non-nil) by `json-read-array' and
 116 `json-read-object' right before reading a JSON array or object,
 117 respectively.  The function is called with one argument, which is
 118 the current JSON key.")
 119
 120 (defvar json-post-element-read-function nil
 121   "Function called (if non-nil) by `json-read-array' and
 122 `json-read-object' right after reading a JSON array or object,
 123 respectively.")
 124
 125 \f
 126
 127 ;;; Utilities
 128
 129 (defun json-join (strings separator)
 130   "Join STRINGS with SEPARATOR."
 131   (mapconcat 'identity strings separator))
 132
 133 (defun json-alist-p (list)
 134   "Non-null if and only if LIST is an alist with simple keys."
 135   (while (consp list)
 136     (setq list (if (and (consp (car list))
 137                         (atom (caar list)))
 138                    (cdr list)
 139                  'not-alist)))
 140   (null list))
 141
 142 (defun json-plist-p (list)
 143   "Non-null if and only if LIST is a plist."
 144   (while (consp list)
 145     (setq list (if (and (keywordp (car list))
 146                         (consp (cdr list)))
 147                    (cddr list)
 148                  'not-plist)))
 149   (null list))
 150
 151 (defun json--plist-reverse (plist)
 152   "Return a copy of PLIST in reverse order.
 153 Unlike `reverse', this keeps the property-value pairs intact."
 154   (let (res)
 155     (while plist
 156       (let ((prop (pop plist))
 157             (val (pop plist)))
 158         (push val res)
 159         (push prop res)))
 160     res))
 161
 162 (defmacro json--with-indentation (body)
 163   `(let ((json--encoding-current-indentation
 164           (if json-encoding-pretty-print
 165               (concat json--encoding-current-indentation
 166                       json-encoding-default-indentation)
 167             "")))
 168      ,body))
 169
 170 ;; Reader utilities
 171
 172 (defsubst json-advance (&optional n)
 173   "Skip past the following N characters."
 174   (forward-char n))
 175
 176 (defsubst json-peek ()
 177   "Return the character at point."
 178   (let ((char (char-after (point))))
 179     (or char :json-eof)))
 180
 181 (defsubst json-pop ()
 182   "Advance past the character at point, returning it."
 183   (let ((char (json-peek)))
 184     (if (eq char :json-eof)
 185         (signal 'json-end-of-file nil)
 186       (json-advance)
 187       char)))
 188
 189 (defun json-skip-whitespace ()
 190   "Skip past the whitespace at point."
 191   (skip-chars-forward "\t\r\n\f\b "))
 192
 193 \f
 194
 195 ;; Error conditions
 196
 197 (define-error 'json-error "Unknown JSON error")
 198 (define-error 'json-readtable-error "JSON readtable error" 'json-error)
 199 (define-error 'json-unknown-keyword "Unrecognized keyword" 'json-error)
 200 (define-error 'json-number-format "Invalid number format" 'json-error)
 201 (define-error 'json-string-escape "Bad Unicode escape" 'json-error)
 202 (define-error 'json-string-format "Bad string format" 'json-error)
 203 (define-error 'json-key-format "Bad JSON object key" 'json-error)
 204 (define-error 'json-object-format "Bad JSON object" 'json-error)
 205 (define-error 'json-end-of-file "End of file while parsing JSON"
 206   '(end-of-file json-error))
 207
 208 \f
 209
 210 ;;; Paths
 211
 212 (defvar json--path '()
 213   "Used internally by `json-path-to-position' to keep track of
 214 the path during recursive calls to `json-read'.")
 215
 216 (defun json--record-path (key)
 217   "Record the KEY to the current JSON path.
 218 Used internally by `json-path-to-position'."
 219   (push (cons (point) key) json--path))
 220
 221 (defun json--check-position (position)
 222   "Check if the last parsed JSON structure passed POSITION.
 223 Used internally by `json-path-to-position'."
 224   (let ((start (caar json--path)))
 225     (when (< start position (+ (point) 1))
 226       (throw :json-path (list :path (nreverse (mapcar #'cdr json--path))
 227                               :match-start start
 228                               :match-end (point)))))
 229   (pop json--path))
 230
 231 (defun json-path-to-position (position &optional string)
 232   "Return the path to the JSON element at POSITION.
 233
 234 When STRING is provided, return the path to the position in the
 235 string, else to the position in the current buffer.
 236
 237 The return value is a property list with the following
 238 properties:
 239
 240 :path        -- A list of strings and numbers forming the path to
 241                 the JSON element at the given position.  Strings
 242                 denote object names, while numbers denote array
 243                 indexes.
 244
 245 :match-start -- Position where the matched JSON element begins.
 246
 247 :match-end   -- Position where the matched JSON element ends.
 248
 249 This can for instance be useful to determine the path to a JSON
 250 element in a deeply nested structure."
 251   (save-excursion
 252     (unless string
 253       (goto-char (point-min)))
 254     (let* ((json--path '())
 255            (json-pre-element-read-function #'json--record-path)
 256            (json-post-element-read-function
 257             (apply-partially #'json--check-position position))
 258            (path (catch :json-path
 259                    (if string
 260                        (json-read-from-string string)
 261                      (json-read)))))
 262       (when (plist-get path :path)
 263         path))))
 264
 265 ;;; Keywords
 266
 267 (defvar json-keywords '("true" "false" "null")
 268   "List of JSON keywords.")
 269
 270 ;; Keyword parsing
 271
 272 (defun json-read-keyword (keyword)
 273   "Read a JSON keyword at point.
 274 KEYWORD is the keyword expected."
 275   (unless (member keyword json-keywords)
 276     (signal 'json-unknown-keyword (list keyword)))
 277   (mapc (lambda (char)
 278           (unless (char-equal char (json-peek))
 279             (signal 'json-unknown-keyword
 280                     (list (save-excursion
 281                             (backward-word 1)
 282                             (thing-at-point 'word)))))
 283           (json-advance))
 284         keyword)
 285   (unless (looking-at "\\(\\s-\\|[],}]\\|$\\)")
 286     (signal 'json-unknown-keyword
 287             (list (save-excursion
 288                     (backward-word 1)
 289                     (thing-at-point 'word)))))
 290   (cond ((string-equal keyword "true") t)
 291         ((string-equal keyword "false") json-false)
 292         ((string-equal keyword "null") json-null)))
 293
 294 ;; Keyword encoding
 295
 296 (defun json-encode-keyword (keyword)
 297   "Encode KEYWORD as a JSON value."
 298   (cond ((eq keyword t)          "true")
 299         ((eq keyword json-false) "false")
 300         ((eq keyword json-null)  "null")))
 301
 302 ;;; Numbers
 303
 304 ;; Number parsing
 305
 306 (defun json-read-number (&optional sign)
 307  "Read the JSON number following point.
 308 The optional SIGN argument is for internal use.
 309
 310 N.B.: Only numbers which can fit in Emacs Lisp's native number
 311 representation will be parsed correctly."
 312  ;; If SIGN is non-nil, the number is explicitly signed.
 313  (let ((number-regexp
 314         "\\([0-9]+\\)?\\(\\.[0-9]+\\)?\\([Ee][+-]?[0-9]+\\)?"))
 315    (cond ((and (null sign) (char-equal (json-peek) ?-))
 316           (json-advance)
 317           (- (json-read-number t)))
 318          ((and (null sign) (char-equal (json-peek) ?+))
 319           (json-advance)
 320           (json-read-number t))
 321          ((and (looking-at number-regexp)
 322                (or (match-beginning 1)
 323                    (match-beginning 2)))
 324           (goto-char (match-end 0))
 325           (string-to-number (match-string 0)))
 326          (t (signal 'json-number-format (list (point)))))))
 327
 328 ;; Number encoding
 329
 330 (defun json-encode-number (number)
 331   "Return a JSON representation of NUMBER."
 332   (format "%s" number))
 333
 334 ;;; Strings
 335
 336 (defvar json-special-chars
 337   '((?\" . ?\")
 338     (?\\ . ?\\)
 339     (?b . ?\b)
 340     (?f . ?\f)
 341     (?n . ?\n)
 342     (?r . ?\r)
 343     (?t . ?\t))
 344   "Characters which are escaped in JSON, with their elisp counterparts.")
 345
 346 ;; String parsing
 347
 348 (defun json-read-escaped-char ()
 349   "Read the JSON string escaped character at point."
 350   ;; Skip over the '\'
 351   (json-advance)
 352   (let* ((char (json-pop))
 353          (special (assq char json-special-chars)))
 354     (cond
 355      (special (cdr special))
 356      ((not (eq char ?u)) char)
 357      ((looking-at "[0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f]")
 358       (let ((hex (match-string 0)))
 359         (json-advance 4)
 360         (string-to-number hex 16)))
 361      (t
 362       (signal 'json-string-escape (list (point)))))))
 363
 364 (defun json-read-string ()
 365   "Read the JSON string at point."
 366   (unless (char-equal (json-peek) ?\")
 367     (signal 'json-string-format (list "doesn't start with `\"'!")))
 368   ;; Skip over the '"'
 369   (json-advance)
 370   (let ((characters '())
 371         (char (json-peek)))
 372     (while (not (char-equal char ?\"))
 373       (push (if (char-equal char ?\\)
 374                 (json-read-escaped-char)
 375               (json-pop))
 376             characters)
 377       (setq char (json-peek)))
 378     ;; Skip over the '"'
 379     (json-advance)
 380     (if characters
 381         (apply 'string (nreverse characters))
 382       "")))
 383
 384 ;; String encoding
 385
 386 (defun json-encode-string (string)
 387   "Return a JSON representation of STRING."
 388   ;; Reimplement the meat of `replace-regexp-in-string', for
 389   ;; performance (bug#20154).
 390   (let ((l (length string))
 391         (start 0)
 392         res mb)
 393     ;; Only escape quotation mark, backslash and the control
 394     ;; characters U+0000 to U+001F (RFC 4627, ECMA-404).
 395     (while (setq mb (string-match "[\"\\[:cntrl:]]" string start))
 396       (let* ((c (aref string mb))
 397              (special (rassq c json-special-chars)))
 398         (push (substring string start mb) res)
 399         (push (if special
 400                   ;; Special JSON character (\n, \r, etc.).
 401                   (string ?\\ (car special))
 402                 ;; Fallback: UCS code point in \uNNNN form.
 403                 (format "\\u%04x" c))
 404               res)
 405         (setq start (1+ mb))))
 406     (push (substring string start l) res)
 407     (push "\"" res)
 408     (apply #'concat "\"" (nreverse res))))
 409
 410 (defun json-encode-key (object)
 411   "Return a JSON representation of OBJECT.
 412 If the resulting JSON object isn't a valid JSON object key,
 413 this signals `json-key-format'."
 414   (let ((encoded (json-encode object)))
 415     (unless (stringp (json-read-from-string encoded))
 416       (signal 'json-key-format (list object)))
 417     encoded))
 418
 419 ;;; JSON Objects
 420
 421 (defun json-new-object ()
 422   "Create a new Elisp object corresponding to a JSON object.
 423 Please see the documentation of `json-object-type'."
 424   (cond ((eq json-object-type 'hash-table)
 425          (make-hash-table :test 'equal))
 426         (t
 427          ())))
 428
 429 (defun json-add-to-object (object key value)
 430   "Add a new KEY -> VALUE association to OBJECT.
 431 Returns the updated object, which you should save, e.g.:
 432     (setq obj (json-add-to-object obj \"foo\" \"bar\"))
 433 Please see the documentation of `json-object-type' and `json-key-type'."
 434   (let ((json-key-type
 435          (if (eq json-key-type nil)
 436              (cdr (assq json-object-type '((hash-table . string)
 437                                            (alist . symbol)
 438                                            (plist . keyword))))
 439            json-key-type)))
 440     (setq key
 441           (cond ((eq json-key-type 'string)
 442                  key)
 443                 ((eq json-key-type 'symbol)
 444                  (intern key))
 445                 ((eq json-key-type 'keyword)
 446                  (intern (concat ":" key)))))
 447     (cond ((eq json-object-type 'hash-table)
 448            (puthash key value object)
 449            object)
 450           ((eq json-object-type 'alist)
 451            (cons (cons key value) object))
 452           ((eq json-object-type 'plist)
 453            (cons key (cons value object))))))
 454
 455 ;; JSON object parsing
 456
 457 (defun json-read-object ()
 458   "Read the JSON object at point."
 459   ;; Skip over the "{"
 460   (json-advance)
 461   (json-skip-whitespace)
 462   ;; read key/value pairs until "}"
 463   (let ((elements (json-new-object))
 464         key value)
 465     (while (not (char-equal (json-peek) ?}))
 466       (json-skip-whitespace)
 467       (setq key (json-read-string))
 468       (json-skip-whitespace)
 469       (if (char-equal (json-peek) ?:)
 470           (json-advance)
 471         (signal 'json-object-format (list ":" (json-peek))))
 472       (json-skip-whitespace)
 473       (when json-pre-element-read-function
 474         (funcall json-pre-element-read-function key))
 475       (setq value (json-read))
 476       (when json-post-element-read-function
 477         (funcall json-post-element-read-function))
 478       (setq elements (json-add-to-object elements key value))
 479       (json-skip-whitespace)
 480       (unless (char-equal (json-peek) ?})
 481         (if (char-equal (json-peek) ?,)
 482             (json-advance)
 483           (signal 'json-object-format (list "," (json-peek))))))
 484     ;; Skip over the "}"
 485     (json-advance)
 486     (pcase json-object-type
 487       (`alist (nreverse elements))
 488       (`plist (json--plist-reverse elements))
 489       (_ elements))))
 490
 491 ;; Hash table encoding
 492
 493 (defun json-encode-hash-table (hash-table)
 494   "Return a JSON representation of HASH-TABLE."
 495   (format "{%s%s}"
 496           (json-join
 497            (let (r)
 498              (json--with-indentation
 499               (maphash
 500                (lambda (k v)
 501                  (push (format
 502                         (if json-encoding-pretty-print
 503                             "%s%s: %s"
 504                           "%s%s:%s")
 505                         json--encoding-current-indentation
 506                         (json-encode-key k)
 507                         (json-encode v))
 508                        r))
 509                hash-table))
 510              r)
 511            json-encoding-separator)
 512           (if (or (not json-encoding-pretty-print)
 513                   json-encoding-lisp-style-closings)
 514               ""
 515             json--encoding-current-indentation)))
 516
 517 ;; List encoding (including alists and plists)
 518
 519 (defun json-encode-alist (alist)
 520   "Return a JSON representation of ALIST."
 521   (format "{%s%s}"
 522           (json-join
 523            (json--with-indentation
 524             (mapcar (lambda (cons)
 525                       (format (if json-encoding-pretty-print
 526                                   "%s%s: %s"
 527                                 "%s%s:%s")
 528                               json--encoding-current-indentation
 529                               (json-encode-key (car cons))
 530                               (json-encode (cdr cons))))
 531                     alist))
 532            json-encoding-separator)
 533           (if (or (not json-encoding-pretty-print)
 534                   json-encoding-lisp-style-closings)
 535               ""
 536             json--encoding-current-indentation)))
 537
 538 (defun json-encode-plist (plist)
 539   "Return a JSON representation of PLIST."
 540   (let (result)
 541     (json--with-indentation
 542       (while plist
 543         (push (concat
 544                json--encoding-current-indentation
 545                (json-encode-key (car plist))
 546                (if json-encoding-pretty-print
 547                    ": "
 548                  ":")
 549                (json-encode (cadr plist)))
 550               result)
 551         (setq plist (cddr plist))))
 552     (concat "{"
 553             (json-join (nreverse result) json-encoding-separator)
 554             (if (and json-encoding-pretty-print
 555                      (not json-encoding-lisp-style-closings))
 556                 json--encoding-current-indentation
 557               "")
 558             "}")))
 559
 560 (defun json-encode-list (list)
 561   "Return a JSON representation of LIST.
 562 Tries to DWIM: simple lists become JSON arrays, while alists and plists
 563 become JSON objects."
 564   (cond ((null list)         "null")
 565         ((json-alist-p list) (json-encode-alist list))
 566         ((json-plist-p list) (json-encode-plist list))
 567         ((listp list)        (json-encode-array list))
 568         (t
 569          (signal 'json-error (list list)))))
 570
 571 ;;; Arrays
 572
 573 ;; Array parsing
 574
 575 (defun json-read-array ()
 576   "Read the JSON array at point."
 577   ;; Skip over the "["
 578   (json-advance)
 579   (json-skip-whitespace)
 580   ;; read values until "]"
 581   (let (elements)
 582     (while (not (char-equal (json-peek) ?\]))
 583       (json-skip-whitespace)
 584       (when json-pre-element-read-function
 585         (funcall json-pre-element-read-function (length elements)))
 586       (push (json-read) elements)
 587       (when json-post-element-read-function
 588         (funcall json-post-element-read-function))
 589       (json-skip-whitespace)
 590       (unless (char-equal (json-peek) ?\])
 591         (if (char-equal (json-peek) ?,)
 592             (json-advance)
 593           (signal 'json-error (list 'bleah)))))
 594     ;; Skip over the "]"
 595     (json-advance)
 596     (apply json-array-type (nreverse elements))))
 597
 598 ;; Array encoding
 599
 600 (defun json-encode-array (array)
 601   "Return a JSON representation of ARRAY."
 602   (if (and json-encoding-pretty-print
 603            (> (length array) 0))
 604       (concat
 605        (json--with-indentation
 606          (concat (format "[%s" json--encoding-current-indentation)
 607                  (json-join (mapcar 'json-encode array)
 608                             (format "%s%s"
 609                                     json-encoding-separator
 610                                     json--encoding-current-indentation))))
 611        (format "%s]"
 612                (if json-encoding-lisp-style-closings
 613                    ""
 614                  json--encoding-current-indentation)))
 615     (concat "["
 616             (mapconcat 'json-encode array json-encoding-separator)
 617             "]")))
 618
 619 \f
 620
 621 ;;; JSON reader.
 622
 623 (defvar json-readtable
 624   (let ((table
 625          '((?t json-read-keyword "true")
 626            (?f json-read-keyword "false")
 627            (?n json-read-keyword "null")
 628            (?{ json-read-object)
 629            (?\[ json-read-array)
 630            (?\" json-read-string))))
 631     (mapc (lambda (char)
 632             (push (list char 'json-read-number) table))
 633           '(?- ?+ ?. ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
 634     table)
 635   "Readtable for JSON reader.")
 636
 637 (defun json-read ()
 638   "Parse and return the JSON object following point.
 639 Advances point just past JSON object."
 640   (json-skip-whitespace)
 641   (let ((char (json-peek)))
 642     (if (not (eq char :json-eof))
 643         (let ((record (cdr (assq char json-readtable))))
 644           (if (functionp (car record))
 645               (apply (car record) (cdr record))
 646             (signal 'json-readtable-error record)))
 647       (signal 'json-end-of-file nil))))
 648
 649 ;; Syntactic sugar for the reader
 650
 651 (defun json-read-from-string (string)
 652   "Read the JSON object contained in STRING and return it."
 653   (with-temp-buffer
 654     (insert string)
 655     (goto-char (point-min))
 656     (json-read)))
 657
 658 (defun json-read-file (file)
 659   "Read the first JSON object contained in FILE and return it."
 660   (with-temp-buffer
 661     (insert-file-contents file)
 662     (goto-char (point-min))
 663     (json-read)))
 664
 665 \f
 666
 667 ;;; JSON encoder
 668
 669 (defun json-encode (object)
 670   "Return a JSON representation of OBJECT as a string."
 671   (cond ((memq object (list t json-null json-false))
 672          (json-encode-keyword object))
 673         ((stringp object)      (json-encode-string object))
 674         ((keywordp object)     (json-encode-string
 675                                 (substring (symbol-name object) 1)))
 676         ((symbolp object)      (json-encode-string
 677                                 (symbol-name object)))
 678         ((numberp object)      (json-encode-number object))
 679         ((arrayp object)       (json-encode-array object))
 680         ((hash-table-p object) (json-encode-hash-table object))
 681         ((listp object)        (json-encode-list object))
 682         (t                     (signal 'json-error (list object)))))
 683
 684 ;; Pretty printing
 685
 686 (defun json-pretty-print-buffer ()
 687   "Pretty-print current buffer."
 688   (interactive)
 689   (json-pretty-print (point-min) (point-max)))
 690
 691 (defun json-pretty-print (begin end)
 692   "Pretty-print selected region."
 693   (interactive "r")
 694   (atomic-change-group
 695     (let ((json-encoding-pretty-print t)
 696           ;; Ensure that ordering is maintained
 697           (json-object-type 'alist)
 698           (txt (delete-and-extract-region begin end)))
 699       (insert (json-encode (json-read-from-string txt))))))
 700
 701 (provide 'json)
 702
 703 ;;; json.el ends here