]> code.delx.au - gnu-emacs/blobdiff - lisp/json.el
* progmodes/python.el (python-info-current-defun): Fix failed
[gnu-emacs] / lisp / json.el
index e389907414943d8d723afb6252d53587dd98af72..a0cd116279ac0bba3e5a03ad709b92fd34aa92d9 100644 (file)
@@ -1,9 +1,9 @@
 ;;; json.el --- JavaScript Object Notation parser / generator
 
-;; Copyright (C) 2006, 2007, 2008, 2009, 2010, 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.
@@ -47,6 +47,7 @@
 ;;              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:
 
@@ -108,16 +109,20 @@ this around your call to `json-read' instead of `setq'ing it.")
 
 (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
 
@@ -161,7 +166,7 @@ this around your call to `json-read' instead of `setq'ing it.")
 (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))
 
@@ -169,6 +174,10 @@ this around your call to `json-read' instead of `setq'ing it.")
 (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))
@@ -302,13 +311,13 @@ representation will be parsed correctly."
   (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)))))
 
@@ -316,6 +325,15 @@ representation will be parsed correctly."
   "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 ()
@@ -390,7 +408,7 @@ Please see the documentation of `json-object-type' and `json-key-type'."
              (maphash
               (lambda (k v)
                 (push (format "%s:%s"
-                              (json-encode k)
+                              (json-encode-key k)
                               (json-encode v))
                       r))
               hash-table)
@@ -404,7 +422,7 @@ Please see the documentation of `json-object-type' and `json-key-type'."
   (format "{%s}"
           (json-join (mapcar (lambda (cons)
                                (format "%s:%s"
-                                       (json-encode (car cons))
+                                       (json-encode-key (car cons))
                                        (json-encode (cdr cons))))
                              alist)
                      ", ")))
@@ -413,7 +431,7 @@ Please see the documentation of `json-object-type' and `json-key-type'."
   "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)
@@ -526,5 +544,4 @@ Advances point just past JSON object."
 
 (provide 'json)
 
-;; arch-tag: 15f6e4c8-b831-4172-8749-bbc680c50ea1
 ;;; json.el ends here