;;; json.el --- JavaScript Object Notation parser / generator
-;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
;; Author: Edward O'Connor <ted@oconnor.cx>
;; Version: 1.4
;;; Code:
-
-;; Compatibility code
-
-(defalias 'json-encode-char0 'encode-char)
-(defalias 'json-decode-char0 'decode-char)
-
-
;; Parameters
(defvar json-object-type 'alist
(mapconcat 'identity strings separator))
(defun json-alist-p (list)
- "Non-null if and only if LIST is an alist."
+ "Non-null if and only if LIST is an alist with simple keys."
(while (consp list)
- (setq list (if (consp (car list))
+ (setq list (if (and (consp (car list))
+ (atom (caar list)))
(cdr list)
'not-alist)))
(null list))
"Advance past the character at point, returning it."
(let ((char (json-peek)))
(if (eq char :json-eof)
- (signal 'end-of-file nil)
+ (signal 'json-end-of-file nil)
(json-advance)
char)))
;; 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-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))
+(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)
+(define-error 'json-end-of-file "End of file while parsing JSON"
+ '(end-of-file json-error))
\f
((looking-at "[0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f]")
(let ((hex (match-string 0)))
(json-advance 4)
- (json-decode-char0 'ucs (string-to-number hex 16))))
+ (string-to-number hex 16)))
(t
(signal 'json-string-escape (list (point)))))))
;; String encoding
-(defun json-encode-char (char)
- "Encode CHAR as a JSON string."
- (setq char (json-encode-char0 char 'ucs))
- (let ((control-char (car (rassoc char json-special-chars))))
- (cond
- ;; Special JSON character (\n, \r, etc.).
- (control-char
- (format "\\%c" control-char))
- ;; ASCIIish printable character.
- ((and (> char 31) (< char 127))
- (format "%c" char))
- ;; Fallback: UCS code point in \uNNNN form.
- (t
- (format "\\u%04x" char)))))
-
(defun json-encode-string (string)
"Return a JSON representation of STRING."
- (format "\"%s\"" (mapconcat 'json-encode-char string "")))
+ ;; Reimplement the meat of `replace-regexp-in-string', for
+ ;; performance (bug#20154).
+ (let ((l (length string))
+ (start 0)
+ res mb)
+ ;; Skip over ASCIIish printable characters.
+ (while (setq mb (string-match "[\"\\/\b\f\n\r\t]\\|[^ -~]" string start))
+ (let* ((c (aref string mb))
+ (special (rassq c json-special-chars)))
+ (push (substring string start mb) res)
+ (push (if special
+ ;; Special JSON character (\n, \r, etc.).
+ (string ?\\ (car special))
+ ;; Fallback: UCS code point in \uNNNN form.
+ (format "\\u%04x" c))
+ res)
+ (setq start (1+ mb))))
+ (push (substring string start l) res)
+ (push "\"" res)
+ (apply #'concat "\"" (nreverse res))))
(defun json-encode-key (object)
"Return a JSON representation of OBJECT.
(if (functionp (car record))
(apply (car record) (cdr record))
(signal 'json-readtable-error record)))
- (signal 'end-of-file nil))))
+ (signal 'json-end-of-file nil))))
;; Syntactic sugar for the reader