X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ac3232837188f7e1c4ffe34b76edede0ccb54f5e..0d46b5f12c2e87c1fb2d5f103f2012c2f03a7ba9:/lisp/json.el diff --git a/lisp/json.el b/lisp/json.el index 3d4c02c588..899bff5dc3 100644 --- a/lisp/json.el +++ b/lisp/json.el @@ -1,9 +1,9 @@ ;;; 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 -;; Version: 1.2 +;; Version: 1.4 ;; Keywords: convenience ;; This file is part of GNU Emacs. @@ -47,10 +47,11 @@ ;; other cleanups, bugfixes, and improvements. ;; 2006-12-29 - XEmacs support, from Aidan Kehoe . ;; 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 @@ -62,12 +63,12 @@ (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 @@ -83,21 +84,39 @@ If nil, `json-read' will guess the type based on the value of `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.") + ;;; Utilities @@ -107,27 +126,36 @@ this around your call to `json-read' instead of `setq'ing it.") (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." @@ -144,39 +172,20 @@ this around your call to `json-read' instead of `setq'ing it.") (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 ")) ;; 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) @@ -221,19 +230,27 @@ KEYWORD is the keyword expected." ;; 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 @@ -299,13 +316,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))))) @@ -313,6 +330,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 () @@ -381,41 +407,70 @@ Please see the documentation of `json-object-type' and `json-key-type'." (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. @@ -454,7 +509,22 @@ become JSON objects." (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) + "]"))) @@ -470,7 +540,7 @@ become JSON objects." (?\" 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.") @@ -521,7 +591,21 @@ Advances point just past JSON object." ((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