Mercurial > emacs
changeset 92061:2b55e8843eff
Move lisp/net/json.el to lisp/json.el.
| author | Michael Olson <mwolson@gnu.org> |
|---|---|
| date | Fri, 22 Feb 2008 01:14:03 +0000 |
| parents | fd85a7810d53 |
| children | 02b3089c33d5 |
| files | lisp/json.el lisp/net/json.el |
| diffstat | 2 files changed, 529 insertions(+), 529 deletions(-) [+] |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/json.el Fri Feb 22 01:14:03 2008 +0000 @@ -0,0 +1,529 @@ +;;; json.el --- JavaScript Object Notation parser / generator + +;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc. + +;; Author: Edward O'Connor <ted@oconnor.cx> +;; Version: 1.2 +;; Keywords: convenience + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This is a library for parsing and generating JSON (JavaScript Object +;; Notation). + +;; Learn all about JSON here: <URL:http://json.org/>. + +;; The user-serviceable entry points for the parser are the functions +;; `json-read' and `json-read-from-string'. The encoder has a single +;; entry point, `json-encode'. + +;; Since there are several natural representations of key-value pair +;; mappings in elisp (alist, plist, hash-table), `json-read' allows you +;; to specify which you'd prefer (see `json-object-type' and +;; `json-array-type'). + +;; Similarly, since `false' and `null' are distinct in JSON, you can +;; distinguish them by binding `json-false' and `json-null' as desired. + +;;; History: + +;; 2006-03-11 - Initial version. +;; 2006-03-13 - Added JSON generation in addition to parsing. Various +;; other cleanups, bugfixes, and improvements. +;; 2006-12-29 - XEmacs support, from Aidan Kehoe <kehoea@parhasard.net>. +;; 2008-02-21 - Installed in GNU Emacs. + +;;; Code: + +(eval-when-compile (require 'cl)) +(require 'thingatpt) + +;; Compatibility code + +(defalias 'json-encode-char0 'encode-char) +(defalias 'json-decode-char0 'decode-char) + + +;; Parameters + +(defvar json-object-type 'alist + "Type to convert JSON objects to. +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 +your call to `json-read' instead of `setq'ing it.") + +(defvar json-key-type nil + "Type to convert JSON keys to. +Must be one of `string', `symbol', `keyword', or nil. + +If nil, `json-read' will guess the type based on the value of +`json-object-type': + + If `json-object-type' is: nil will be interpreted as: + `hash-table' `string' + `alist' `symbol' + `plist' `keyword' + +Note that values other than `string' might behave strangely for +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 +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 +this around your call to `json-read' instead of `setq'ing it.") + + + +;;; Utilities + +(defun json-join (strings separator) + "Join STRINGS with SEPARATOR." + (mapconcat 'identity strings separator)) + +(defun json-alist-p (list) + "Non-null iff LIST is an alist." + (or (null list) + (and (consp (car list)) + (json-alist-p (cdr list))))) + +(defun json-plist-p (list) + "Non-null iff LIST is a plist." + (or (null list) + (and (keywordp (car list)) + (consp (cdr list)) + (json-plist-p (cddr list))))) + +;; 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)))) + +(defsubst json-peek () + "Return the character at point." + (let ((char (char-after (point)))) + (or char :json-eof))) + +(defsubst json-pop () + "Advance past the character at point, returning it." + (let ((char (json-peek))) + (if (eq char :json-eof) + (signal 'end-of-file nil) + (json-advance) + char))) + +(defun json-skip-whitespace () + "Skip past the whitespace at point." + (while (looking-at "[\t\r\n\f\b ]") + (goto-char (match-end 0)))) + + + +;; 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)) + + + +;;; Keywords + +(defvar json-keywords '("true" "false" "null") + "List of JSON keywords.") + +;; Keyword parsing + +(defun json-read-keyword (keyword) + "Read a JSON keyword at point. +KEYWORD is the keyword expected." + (unless (member keyword json-keywords) + (signal 'json-unknown-keyword (list keyword))) + (mapc (lambda (char) + (unless (char-equal char (json-peek)) + (signal 'json-unknown-keyword + (list (save-excursion + (backward-word 1) + (word-at-point))))) + (json-advance)) + keyword) + (unless (looking-at "\\(\\s-\\|[],}]\\|$\\)") + (signal 'json-unknown-keyword + (list (save-excursion + (backward-word 1) + (word-at-point))))) + (cond ((string-equal keyword "true") t) + ((string-equal keyword "false") json-false) + ((string-equal keyword "null") json-null))) + +;; Keyword encoding + +(defun json-encode-keyword (keyword) + "Encode KEYWORD as a JSON value." + (cond ((eq keyword t) "true") + ((eq keyword json-false) "false") + ((eq keyword json-null) "null"))) + +;;; Numbers + +;; Number parsing + +(defun json-read-number () + "Read the JSON number following point. +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 + (goto-char (match-end 0)) + (string-to-number (match-string 0))) + (signal 'json-number-format (list (point)))))) + +;; Number encoding + +(defun json-encode-number (number) + "Return a JSON representation of NUMBER." + (format "%s" number)) + +;;; Strings + +(defvar json-special-chars + '((?\" . ?\") + (?\\ . ?\\) + (?/ . ?/) + (?b . ?\b) + (?f . ?\f) + (?n . ?\n) + (?r . ?\r) + (?t . ?\t)) + "Characters which are escaped in JSON, with their elisp counterparts.") + +;; String parsing + +(defun json-read-escaped-char () + "Read the JSON string escaped character at point." + ;; Skip over the '\' + (json-advance) + (let* ((char (json-pop)) + (special (assq char json-special-chars))) + (cond + (special (cdr special)) + ((not (eq char ?u)) char) + ((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)))) + (t + (signal 'json-string-escape (list (point))))))) + +(defun json-read-string () + "Read the JSON string at point." + (unless (char-equal (json-peek) ?\") + (signal 'json-string-format (list "doesn't start with '\"'!"))) + ;; Skip over the '"' + (json-advance) + (let ((characters '()) + (char (json-peek))) + (while (not (char-equal char ?\")) + (push (if (char-equal char ?\\) + (json-read-escaped-char) + (json-pop)) + characters) + (setq char (json-peek))) + ;; Skip over the '"' + (json-advance) + (if characters + (apply 'string (nreverse characters)) + ""))) + +;; 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 161)) + (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 ""))) + +;;; JSON Objects + +(defun json-new-object () + "Create a new Elisp object corresponding to a JSON object. +Please see the documentation of `json-object-type'." + (cond ((eq json-object-type 'hash-table) + (make-hash-table :test 'equal)) + (t + (list)))) + +(defun json-add-to-object (object key value) + "Add a new KEY -> VALUE association to OBJECT. +Returns the updated object, which you should save, e.g.: + (setq obj (json-add-to-object obj \"foo\" \"bar\")) +Please see the documentation of `json-object-type' and `json-key-type'." + (let ((json-key-type + (if (eq json-key-type nil) + (cdr (assq json-object-type '((hash-table . string) + (alist . symbol) + (plist . keyword)))) + json-key-type))) + (setq key + (cond ((eq json-key-type 'string) + key) + ((eq json-key-type 'symbol) + (intern key)) + ((eq json-key-type 'keyword) + (intern (concat ":" key))))) + (cond ((eq json-object-type 'hash-table) + (puthash key value object) + object) + ((eq json-object-type 'alist) + (cons (cons key value) object)) + ((eq json-object-type 'plist) + (cons key (cons value object)))))) + +;; JSON object parsing + +(defun json-read-object () + "Read the JSON object at point." + ;; Skip over the "{" + (json-advance) + (json-skip-whitespace) + ;; read key/value pairs until "}" + (let ((elements (json-new-object)) + key value) + (while (not (char-equal (json-peek) ?})) + (json-skip-whitespace) + (setq key (json-read-string)) + (json-skip-whitespace) + (if (char-equal (json-peek) ?:) + (json-advance) + (signal 'json-object-format (list ":" (json-peek)))) + (setq value (json-read)) + (setq elements (json-add-to-object elements key value)) + (json-skip-whitespace) + (unless (char-equal (json-peek) ?}) + (if (char-equal (json-peek) ?,) + (json-advance) + (signal 'json-object-format (list "," (json-peek)))))) + ;; Skip over the "}" + (json-advance) + elements)) + +;; Hash table encoding + +(defun json-encode-hash-table (hash-table) + "Return a JSON representation of HASH-TABLE." + (format "{%s}" + (json-join + (let (r) + (maphash + (lambda (k v) + (push (format "%s:%s" + (json-encode k) + (json-encode v)) + r)) + hash-table) + r) + ", "))) + +;; 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) + ", "))) + +(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) ", ") "}"))) + +(defun json-encode-list (list) + "Return a JSON representation of LIST. +Tries to DWIM: simple lists become JSON arrays, while alists and plists +become JSON objects." + (cond ((null list) "null") + ((json-alist-p list) (json-encode-alist list)) + ((json-plist-p list) (json-encode-plist list)) + ((listp list) (json-encode-array list)) + (t + (signal 'json-error (list list))))) + +;;; Arrays + +;; Array parsing + +(defun json-read-array () + "Read the JSON array at point." + ;; Skip over the "[" + (json-advance) + (json-skip-whitespace) + ;; read values until "]" + (let (elements) + (while (not (char-equal (json-peek) ?\])) + (push (json-read) elements) + (json-skip-whitespace) + (unless (char-equal (json-peek) ?\]) + (if (char-equal (json-peek) ?,) + (json-advance) + (signal 'json-error (list 'bleah))))) + ;; Skip over the "]" + (json-advance) + (apply json-array-type (nreverse elements)))) + +;; Array encoding + +(defun json-encode-array (array) + "Return a JSON representation of ARRAY." + (concat "[" (mapconcat 'json-encode array ", ") "]")) + + + +;;; JSON reader. + +(defvar json-readtable + (let ((table + '((?t json-read-keyword "true") + (?f json-read-keyword "false") + (?n json-read-keyword "null") + (?{ json-read-object) + (?\[ json-read-array) + (?\" json-read-string)))) + (mapc (lambda (char) + (push (list char 'json-read-number) table)) + '(?- ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) + table) + "Readtable for JSON reader.") + +(defun json-read () + "Parse and return the JSON object following point. +Advances point just past JSON object." + (json-skip-whitespace) + (let ((char (json-peek))) + (if (not (eq char :json-eof)) + (let ((record (cdr (assq char json-readtable)))) + (if (functionp (car record)) + (apply (car record) (cdr record)) + (signal 'json-readtable-error record))) + (signal 'end-of-file nil)))) + +;; Syntactic sugar for the reader + +(defun json-read-from-string (string) + "Read the JSON object contained in STRING and return it." + (with-temp-buffer + (insert string) + (goto-char (point-min)) + (json-read))) + +(defun json-read-file (file) + "Read the first JSON object contained in FILE and return it." + (with-temp-buffer + (insert-file-contents file) + (goto-char (point-min)) + (json-read))) + + + +;;; JSON encoder + +(defun json-encode (object) + "Return a JSON representation of OBJECT as a string." + (cond ((memq object (list t json-null json-false)) + (json-encode-keyword object)) + ((stringp object) (json-encode-string object)) + ((keywordp object) (json-encode-string + (substring (symbol-name object) 1))) + ((symbolp object) (json-encode-string + (symbol-name object))) + ((numberp object) (json-encode-number object)) + ((arrayp object) (json-encode-array object)) + ((hash-table-p object) (json-encode-hash-table object)) + ((listp object) (json-encode-list object)) + (t (signal 'json-error (list object))))) + +(provide 'json) + +;;; json.el ends here
--- a/lisp/net/json.el Thu Feb 21 22:28:13 2008 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,529 +0,0 @@ -;;; json.el --- JavaScript Object Notation parser / generator - -;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Edward O'Connor <ted@oconnor.cx> -;; Version: 1.2 -;; Keywords: convenience - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; This is a library for parsing and generating JSON (JavaScript Object -;; Notation). - -;; Learn all about JSON here: <URL:http://json.org/>. - -;; The user-serviceable entry points for the parser are the functions -;; `json-read' and `json-read-from-string'. The encoder has a single -;; entry point, `json-encode'. - -;; Since there are several natural representations of key-value pair -;; mappings in elisp (alist, plist, hash-table), `json-read' allows you -;; to specify which you'd prefer (see `json-object-type' and -;; `json-array-type'). - -;; Similarly, since `false' and `null' are distinct in JSON, you can -;; distinguish them by binding `json-false' and `json-null' as desired. - -;;; History: - -;; 2006-03-11 - Initial version. -;; 2006-03-13 - Added JSON generation in addition to parsing. Various -;; other cleanups, bugfixes, and improvements. -;; 2006-12-29 - XEmacs support, from Aidan Kehoe <kehoea@parhasard.net>. -;; 2008-02-21 - Installed in GNU Emacs. - -;;; Code: - -(eval-when-compile (require 'cl)) -(require 'thingatpt) - -;; Compatibility code - -(defalias 'json-encode-char0 'encode-char) -(defalias 'json-decode-char0 'decode-char) - - -;; Parameters - -(defvar json-object-type 'alist - "Type to convert JSON objects to. -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 -your call to `json-read' instead of `setq'ing it.") - -(defvar json-key-type nil - "Type to convert JSON keys to. -Must be one of `string', `symbol', `keyword', or nil. - -If nil, `json-read' will guess the type based on the value of -`json-object-type': - - If `json-object-type' is: nil will be interpreted as: - `hash-table' `string' - `alist' `symbol' - `plist' `keyword' - -Note that values other than `string' might behave strangely for -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 -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 -this around your call to `json-read' instead of `setq'ing it.") - - - -;;; Utilities - -(defun json-join (strings separator) - "Join STRINGS with SEPARATOR." - (mapconcat 'identity strings separator)) - -(defun json-alist-p (list) - "Non-null iff LIST is an alist." - (or (null list) - (and (consp (car list)) - (json-alist-p (cdr list))))) - -(defun json-plist-p (list) - "Non-null iff LIST is a plist." - (or (null list) - (and (keywordp (car list)) - (consp (cdr list)) - (json-plist-p (cddr list))))) - -;; 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)))) - -(defsubst json-peek () - "Return the character at point." - (let ((char (char-after (point)))) - (or char :json-eof))) - -(defsubst json-pop () - "Advance past the character at point, returning it." - (let ((char (json-peek))) - (if (eq char :json-eof) - (signal 'end-of-file nil) - (json-advance) - char))) - -(defun json-skip-whitespace () - "Skip past the whitespace at point." - (while (looking-at "[\t\r\n\f\b ]") - (goto-char (match-end 0)))) - - - -;; 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)) - - - -;;; Keywords - -(defvar json-keywords '("true" "false" "null") - "List of JSON keywords.") - -;; Keyword parsing - -(defun json-read-keyword (keyword) - "Read a JSON keyword at point. -KEYWORD is the keyword expected." - (unless (member keyword json-keywords) - (signal 'json-unknown-keyword (list keyword))) - (mapc (lambda (char) - (unless (char-equal char (json-peek)) - (signal 'json-unknown-keyword - (list (save-excursion - (backward-word 1) - (word-at-point))))) - (json-advance)) - keyword) - (unless (looking-at "\\(\\s-\\|[],}]\\|$\\)") - (signal 'json-unknown-keyword - (list (save-excursion - (backward-word 1) - (word-at-point))))) - (cond ((string-equal keyword "true") t) - ((string-equal keyword "false") json-false) - ((string-equal keyword "null") json-null))) - -;; Keyword encoding - -(defun json-encode-keyword (keyword) - "Encode KEYWORD as a JSON value." - (cond ((eq keyword t) "true") - ((eq keyword json-false) "false") - ((eq keyword json-null) "null"))) - -;;; Numbers - -;; Number parsing - -(defun json-read-number () - "Read the JSON number following point. -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 - (goto-char (match-end 0)) - (string-to-number (match-string 0))) - (signal 'json-number-format (list (point)))))) - -;; Number encoding - -(defun json-encode-number (number) - "Return a JSON representation of NUMBER." - (format "%s" number)) - -;;; Strings - -(defvar json-special-chars - '((?\" . ?\") - (?\\ . ?\\) - (?/ . ?/) - (?b . ?\b) - (?f . ?\f) - (?n . ?\n) - (?r . ?\r) - (?t . ?\t)) - "Characters which are escaped in JSON, with their elisp counterparts.") - -;; String parsing - -(defun json-read-escaped-char () - "Read the JSON string escaped character at point." - ;; Skip over the '\' - (json-advance) - (let* ((char (json-pop)) - (special (assq char json-special-chars))) - (cond - (special (cdr special)) - ((not (eq char ?u)) char) - ((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)))) - (t - (signal 'json-string-escape (list (point))))))) - -(defun json-read-string () - "Read the JSON string at point." - (unless (char-equal (json-peek) ?\") - (signal 'json-string-format (list "doesn't start with '\"'!"))) - ;; Skip over the '"' - (json-advance) - (let ((characters '()) - (char (json-peek))) - (while (not (char-equal char ?\")) - (push (if (char-equal char ?\\) - (json-read-escaped-char) - (json-pop)) - characters) - (setq char (json-peek))) - ;; Skip over the '"' - (json-advance) - (if characters - (apply 'string (nreverse characters)) - ""))) - -;; 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 161)) - (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 ""))) - -;;; JSON Objects - -(defun json-new-object () - "Create a new Elisp object corresponding to a JSON object. -Please see the documentation of `json-object-type'." - (cond ((eq json-object-type 'hash-table) - (make-hash-table :test 'equal)) - (t - (list)))) - -(defun json-add-to-object (object key value) - "Add a new KEY -> VALUE association to OBJECT. -Returns the updated object, which you should save, e.g.: - (setq obj (json-add-to-object obj \"foo\" \"bar\")) -Please see the documentation of `json-object-type' and `json-key-type'." - (let ((json-key-type - (if (eq json-key-type nil) - (cdr (assq json-object-type '((hash-table . string) - (alist . symbol) - (plist . keyword)))) - json-key-type))) - (setq key - (cond ((eq json-key-type 'string) - key) - ((eq json-key-type 'symbol) - (intern key)) - ((eq json-key-type 'keyword) - (intern (concat ":" key))))) - (cond ((eq json-object-type 'hash-table) - (puthash key value object) - object) - ((eq json-object-type 'alist) - (cons (cons key value) object)) - ((eq json-object-type 'plist) - (cons key (cons value object)))))) - -;; JSON object parsing - -(defun json-read-object () - "Read the JSON object at point." - ;; Skip over the "{" - (json-advance) - (json-skip-whitespace) - ;; read key/value pairs until "}" - (let ((elements (json-new-object)) - key value) - (while (not (char-equal (json-peek) ?})) - (json-skip-whitespace) - (setq key (json-read-string)) - (json-skip-whitespace) - (if (char-equal (json-peek) ?:) - (json-advance) - (signal 'json-object-format (list ":" (json-peek)))) - (setq value (json-read)) - (setq elements (json-add-to-object elements key value)) - (json-skip-whitespace) - (unless (char-equal (json-peek) ?}) - (if (char-equal (json-peek) ?,) - (json-advance) - (signal 'json-object-format (list "," (json-peek)))))) - ;; Skip over the "}" - (json-advance) - elements)) - -;; Hash table encoding - -(defun json-encode-hash-table (hash-table) - "Return a JSON representation of HASH-TABLE." - (format "{%s}" - (json-join - (let (r) - (maphash - (lambda (k v) - (push (format "%s:%s" - (json-encode k) - (json-encode v)) - r)) - hash-table) - r) - ", "))) - -;; 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) - ", "))) - -(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) ", ") "}"))) - -(defun json-encode-list (list) - "Return a JSON representation of LIST. -Tries to DWIM: simple lists become JSON arrays, while alists and plists -become JSON objects." - (cond ((null list) "null") - ((json-alist-p list) (json-encode-alist list)) - ((json-plist-p list) (json-encode-plist list)) - ((listp list) (json-encode-array list)) - (t - (signal 'json-error (list list))))) - -;;; Arrays - -;; Array parsing - -(defun json-read-array () - "Read the JSON array at point." - ;; Skip over the "[" - (json-advance) - (json-skip-whitespace) - ;; read values until "]" - (let (elements) - (while (not (char-equal (json-peek) ?\])) - (push (json-read) elements) - (json-skip-whitespace) - (unless (char-equal (json-peek) ?\]) - (if (char-equal (json-peek) ?,) - (json-advance) - (signal 'json-error (list 'bleah))))) - ;; Skip over the "]" - (json-advance) - (apply json-array-type (nreverse elements)))) - -;; Array encoding - -(defun json-encode-array (array) - "Return a JSON representation of ARRAY." - (concat "[" (mapconcat 'json-encode array ", ") "]")) - - - -;;; JSON reader. - -(defvar json-readtable - (let ((table - '((?t json-read-keyword "true") - (?f json-read-keyword "false") - (?n json-read-keyword "null") - (?{ json-read-object) - (?\[ json-read-array) - (?\" json-read-string)))) - (mapc (lambda (char) - (push (list char 'json-read-number) table)) - '(?- ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) - table) - "Readtable for JSON reader.") - -(defun json-read () - "Parse and return the JSON object following point. -Advances point just past JSON object." - (json-skip-whitespace) - (let ((char (json-peek))) - (if (not (eq char :json-eof)) - (let ((record (cdr (assq char json-readtable)))) - (if (functionp (car record)) - (apply (car record) (cdr record)) - (signal 'json-readtable-error record))) - (signal 'end-of-file nil)))) - -;; Syntactic sugar for the reader - -(defun json-read-from-string (string) - "Read the JSON object contained in STRING and return it." - (with-temp-buffer - (insert string) - (goto-char (point-min)) - (json-read))) - -(defun json-read-file (file) - "Read the first JSON object contained in FILE and return it." - (with-temp-buffer - (insert-file-contents file) - (goto-char (point-min)) - (json-read))) - - - -;;; JSON encoder - -(defun json-encode (object) - "Return a JSON representation of OBJECT as a string." - (cond ((memq object (list t json-null json-false)) - (json-encode-keyword object)) - ((stringp object) (json-encode-string object)) - ((keywordp object) (json-encode-string - (substring (symbol-name object) 1))) - ((symbolp object) (json-encode-string - (symbol-name object))) - ((numberp object) (json-encode-number object)) - ((arrayp object) (json-encode-array object)) - ((hash-table-p object) (json-encode-hash-table object)) - ((listp object) (json-encode-list object)) - (t (signal 'json-error (list object))))) - -(provide 'json) - -;;; json.el ends here