strict key encoding for json.el

Ref: http://lists.gnu.org/archive/html/emacs-devel/2012-08/msg00642.html

* lisp/json.el (json-key-format): Add error properties.
(json-encode-key): New function.
(json-encode-hash-table, json-encode-alist, json-encode-plist):
Use json-encode-key.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 748fab9dbe04ddcc621df02ed200481e21a86e4d..4f8de2291dbfd7d7c023f0fb52ff828864868b91 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,10 @@
+2012-08-22  Edward O'Connor  <hober0@gmail.com>
+
+       * json.el (json-key-format): Add error properties.
+       (json-encode-key): New function.
+       (json-encode-hash-table, json-encode-alist, json-encode-plist):
+       Use json-encode-key.
+
 2012-08-22  Glenn Morris  <rgm@gnu.org>
 
        * calendar/cal-tex.el (cal-tex-longday): New function, replacing...

diff --git a/lisp/json.el b/lisp/json.el
index 468358ccd1a0906769f89d56d4f7c431fe138fe1..f1ee3a5203215ea0129c85dbeddd35c0ea317351 100644 (file)
--- a/lisp/json.el
+++ b/lisp/json.el
@@ -174,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))
@@ -321,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 ()
@@ -395,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)
@@ -409,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)
                      ", ")))
@@ -418,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)