;;; json.el --- JavaScript Object Notation parser / generator
-;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2014 Free Software Foundation, Inc.
;; Author: Edward O'Connor <ted@oconnor.cx>
-;; Version: 1.2
+;; Version: 1.4
;; Keywords: convenience
;; This file is part of GNU Emacs.
;; other cleanups, bugfixes, and improvements.
;; 2006-12-29 - XEmacs support, from Aidan Kehoe <kehoea@parhasard.net>.
;; 2008-02-21 - Installed in GNU Emacs.
+;; 2011-10-17 - Patch `json-alist-p' and `json-plist-p' to avoid recursion -tzz
+;; 2012-10-25 - Added pretty-printed reformatting -Ryan Crum (ryan@ryancrum.org)
;;; Code:
-(eval-when-compile (require 'cl))
;; Compatibility code
(defvar json-object-type 'alist
"Type to convert JSON objects to.
-Must be one of `alist', `plist', or `hash-table'. Consider let-binding
+Must be one of `alist', `plist', or `hash-table'. Consider let-binding
this around your call to `json-read' instead of `setq'ing it.")
(defvar json-array-type 'vector
"Type to convert JSON arrays to.
-Must be one of `vector' or `list'. Consider let-binding this around
+Must be one of `vector' or `list'. Consider let-binding this around
your call to `json-read' instead of `setq'ing it.")
(defvar json-key-type nil
`plist' `keyword'
Note that values other than `string' might behave strangely for
-Sufficiently Weird keys. Consider let-binding this around your call to
+Sufficiently Weird keys. Consider let-binding this around your call to
`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
-the difference between `false' and `null'. Consider let-binding this
+the difference between `false' and `null'. Consider let-binding this
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
-tell the difference between `false' and `null'. Consider let-binding
+tell the difference between `false' and `null'. Consider let-binding
this around your call to `json-read' instead of `setq'ing it.")
+(defvar json-encoding-separator ","
+ "Value to use as an element separator when encoding.")
+
+(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.")
+
\f
;;; Utilities
(mapconcat 'identity strings separator))
(defun json-alist-p (list)
- "Non-null if and only if LIST is an alist."
- (or (null list)
- (and (consp (car list))
- (json-alist-p (cdr list)))))
+ "Non-null if and only if LIST is an alist with simple keys."
+ (while (consp list)
+ (setq list (if (and (consp (car list))
+ (atom (caar list)))
+ (cdr list)
+ 'not-alist)))
+ (null list))
(defun json-plist-p (list)
"Non-null if and only if LIST is a plist."
- (or (null list)
- (and (keywordp (car list))
- (consp (cdr list))
- (json-plist-p (cddr list)))))
+ (while (consp list)
+ (setq list (if (and (keywordp (car list))
+ (consp (cdr list)))
+ (cddr list)
+ 'not-plist)))
+ (null list))
+
+(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))
;; Reader utilities
(defsubst json-advance (&optional n)
"Skip past the following N characters."
- (unless n (setq n 1))
- (let ((goal (+ (point) n)))
- (goto-char goal)
- (when (< (point) goal)
- (signal 'end-of-file nil))))
+ (forward-char n))
(defsubst json-peek ()
"Return the character at point."
(defun json-skip-whitespace ()
"Skip past the whitespace at point."
- (while (looking-at "[\t\r\n\f\b ]")
- (goto-char (match-end 0))))
+ (skip-chars-forward "\t\r\n\f\b "))
\f
;; Error conditions
-(put 'json-error 'error-message "Unknown JSON error")
-(put 'json-error 'error-conditions '(json-error error))
-
-(put 'json-readtable-error 'error-message "JSON readtable error")
-(put 'json-readtable-error 'error-conditions
- '(json-readtable-error json-error error))
-
-(put 'json-unknown-keyword 'error-message "Unrecognized keyword")
-(put 'json-unknown-keyword 'error-conditions
- '(json-unknown-keyword json-error error))
-
-(put 'json-number-format 'error-message "Invalid number format")
-(put 'json-number-format 'error-conditions
- '(json-number-format json-error error))
-
-(put 'json-string-escape 'error-message "Bad unicode escape")
-(put 'json-string-escape 'error-conditions
- '(json-string-escape json-error error))
-
-(put 'json-string-format 'error-message "Bad string format")
-(put 'json-string-format 'error-conditions
- '(json-string-format json-error error))
-
-(put 'json-object-format 'error-message "Bad JSON object")
-(put 'json-object-format 'error-conditions
- '(json-object-format json-error error))
+(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)
\f
;; Number parsing
-(defun json-read-number ()
- "Read the JSON number following point.
+(defun json-read-number (&optional sign)
+ "Read the JSON number following point.
+The optional SIGN argument is for internal use.
+
N.B.: Only numbers which can fit in Emacs Lisp's native number
representation will be parsed correctly."
- (if (char-equal (json-peek) ?-)
- (progn
- (json-advance)
- (- 0 (json-read-number)))
- (if (looking-at "[0-9]+\\([.][0-9]+\\)?\\([eE][+-]?[0-9]+\\)?")
- (progn
+ ;; If SIGN is non-nil, the number is explicitly signed.
+ (let ((number-regexp
+ "\\([0-9]+\\)?\\(\\.[0-9]+\\)?\\([Ee][+-]?[0-9]+\\)?"))
+ (cond ((and (null sign) (char-equal (json-peek) ?-))
+ (json-advance)
+ (- (json-read-number t)))
+ ((and (null sign) (char-equal (json-peek) ?+))
+ (json-advance)
+ (json-read-number t))
+ ((and (looking-at number-regexp)
+ (or (match-beginning 1)
+ (match-beginning 2)))
(goto-char (match-end 0))
(string-to-number (match-string 0)))
- (signal 'json-number-format (list (point))))))
+ (t (signal 'json-number-format (list (point)))))))
;; Number encoding
(setq char (json-encode-char0 char 'ucs))
(let ((control-char (car (rassoc char json-special-chars))))
(cond
- ;; Special JSON character (\n, \r, etc.)
+ ;; Special JSON character (\n, \r, etc.).
(control-char
(format "\\%c" control-char))
- ;; ASCIIish printable character
- ((and (> char 31) (< char 161))
+ ;; ASCIIish printable character.
+ ((and (> char 31) (< char 127))
(format "%c" char))
- ;; Fallback: UCS code point in \uNNNN form
+ ;; Fallback: UCS code point in \uNNNN form.
(t
(format "\\u%04x" char)))))
"Return a JSON representation of STRING."
(format "\"%s\"" (mapconcat 'json-encode-char string "")))
+(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))
+
;;; JSON Objects
(defun json-new-object ()
(defun json-encode-hash-table (hash-table)
"Return a JSON representation of HASH-TABLE."
- (format "{%s}"
+ (format "{%s%s}"
(json-join
(let (r)
- (maphash
- (lambda (k v)
- (push (format "%s:%s"
- (json-encode k)
- (json-encode v))
- r))
- hash-table)
+ (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)))
;; List encoding (including alists and plists)
(defun json-encode-alist (alist)
"Return a JSON representation of ALIST."
- (format "{%s}"
- (json-join (mapcar (lambda (cons)
- (format "%s:%s"
- (json-encode (car cons))
- (json-encode (cdr cons))))
- alist)
- ", ")))
+ (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)))
(defun json-encode-plist (plist)
"Return a JSON representation of PLIST."
(let (result)
- (while plist
- (push (concat (json-encode (car plist))
- ":"
- (json-encode (cadr plist)))
- result)
- (setq plist (cddr plist)))
- (concat "{" (json-join (nreverse result) ", ") "}")))
+ (json--with-indentation
+ (while plist
+ (push (concat
+ json--encoding-current-indentation
+ (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
+ "")
+ "}")))
(defun json-encode-list (list)
"Return a JSON representation of LIST.
(defun json-encode-array (array)
"Return a JSON representation of ARRAY."
- (concat "[" (mapconcat 'json-encode array ", ") "]"))
+ (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)
+ "]")))
\f
(?\" json-read-string))))
(mapc (lambda (char)
(push (list char 'json-read-number) table))
- '(?- ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
+ '(?- ?+ ?. ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
table)
"Readtable for JSON reader.")
((listp object) (json-encode-list object))
(t (signal 'json-error (list object)))))
+;; 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)
+ (txt (delete-and-extract-region begin end)))
+ (insert (json-encode (json-read-from-string txt))))))
+
(provide 'json)
-;; arch-tag: 15f6e4c8-b831-4172-8749-bbc680c50ea1
;;; json.el ends here