;;; json.el --- JavaScript Object Notation parser / generator
-;; Copyright (C) 2006-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
;; Author: Edward O'Connor <ted@oconnor.cx>
-;; Version: 1.2
+;; Version: 1.3
;; 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
;;; Code:
(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)))))
+ (while (consp list)
+ (setq list (if (consp (car 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))
;; Reader utilities
(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-message "Bad Unicode escape")
(put 'json-string-escape 'error-conditions
'(json-string-escape json-error error))
(put 'json-string-format 'error-conditions
'(json-string-format json-error error))
+(put 'json-key-format 'error-message "Bad JSON object key")
+(put 'json-key-format 'error-conditions
+ '(json-key-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))
(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 ()
(maphash
(lambda (k v)
(push (format "%s:%s"
- (json-encode k)
+ (json-encode-key k)
(json-encode v))
r))
hash-table)
(format "{%s}"
(json-join (mapcar (lambda (cons)
(format "%s:%s"
- (json-encode (car cons))
+ (json-encode-key (car cons))
(json-encode (cdr cons))))
alist)
", ")))
"Return a JSON representation of PLIST."
(let (result)
(while plist
- (push (concat (json-encode (car plist))
+ (push (concat (json-encode-key (car plist))
":"
(json-encode (cadr plist)))
result)