2008-02-21 19:41:38 +00:00
|
|
|
|
;;; json.el --- JavaScript Object Notation parser / generator
|
|
|
|
|
|
2012-01-05 09:46:05 +00:00
|
|
|
|
;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
|
2008-02-21 19:41:38 +00:00
|
|
|
|
|
|
|
|
|
;; Author: Edward O'Connor <ted@oconnor.cx>
|
2011-10-17 17:40:27 +00:00
|
|
|
|
;; Version: 1.3
|
2008-02-21 19:41:38 +00:00
|
|
|
|
;; Keywords: convenience
|
|
|
|
|
|
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
|
|
2008-05-06 08:06:51 +00:00
|
|
|
|
;; GNU Emacs is free software: you can redistribute it and/or modify
|
2008-02-21 19:41:38 +00:00
|
|
|
|
;; it under the terms of the GNU General Public License as published by
|
2008-05-06 08:06:51 +00:00
|
|
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
|
|
|
;; (at your option) any later version.
|
2008-02-21 19:41:38 +00:00
|
|
|
|
|
|
|
|
|
;; 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
|
2008-05-06 08:06:51 +00:00
|
|
|
|
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
2008-02-21 19:41:38 +00:00
|
|
|
|
|
|
|
|
|
;;; 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.
|
2011-10-17 17:40:27 +00:00
|
|
|
|
;; 2011-10-17 - Patch `json-alist-p' and `json-plist-p' to avoid recursion -tzz
|
2008-02-21 19:41:38 +00:00
|
|
|
|
|
|
|
|
|
;;; Code:
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; 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.
|
Fix typos in docstrings.
* image-dired.el (image-dired-display-thumbs): Fix typo in docstring.
(image-dired-read-comment): Doc fix.
* json.el (json-object-type, json-array-type, json-key-type, json-false)
(json-null, json-read-number):
* minibuffer.el (completion-in-region-functions):
* calendar/cal-tex.el (cal-tex-daily-end, cal-tex-number-weeks)
(cal-tex-cursor-week):
* emacs-lisp/trace.el (trace-function):
* eshell/em-basic.el (eshell/printnl):
* eshell/em-dirs.el (eshell-last-dir-ring, eshell-parse-drive-letter)
(eshell-read-last-dir-ring, eshell-write-last-dir-ring):
* obsolete/levents.el (allocate-event, event-key, event-object)
(event-point, event-process, event-timestamp, event-to-character)
(event-window, event-x, event-x-pixel, event-y, event-y-pixel):
* textmodes/reftex-vars.el (reftex-index-macros-builtin)
(reftex-section-levels, reftex-auto-recenter-toc, reftex-toc-mode-hook)
(reftex-cite-punctuation, reftex-search-unrecursed-path-first)
(reftex-highlight-selection): Fix typos in docstrings.
2010-03-22 16:50:29 +00:00
|
|
|
|
Must be one of `alist', `plist', or `hash-table'. Consider let-binding
|
2008-02-21 19:41:38 +00:00
|
|
|
|
this around your call to `json-read' instead of `setq'ing it.")
|
|
|
|
|
|
|
|
|
|
(defvar json-array-type 'vector
|
|
|
|
|
"Type to convert JSON arrays to.
|
Fix typos in docstrings.
* image-dired.el (image-dired-display-thumbs): Fix typo in docstring.
(image-dired-read-comment): Doc fix.
* json.el (json-object-type, json-array-type, json-key-type, json-false)
(json-null, json-read-number):
* minibuffer.el (completion-in-region-functions):
* calendar/cal-tex.el (cal-tex-daily-end, cal-tex-number-weeks)
(cal-tex-cursor-week):
* emacs-lisp/trace.el (trace-function):
* eshell/em-basic.el (eshell/printnl):
* eshell/em-dirs.el (eshell-last-dir-ring, eshell-parse-drive-letter)
(eshell-read-last-dir-ring, eshell-write-last-dir-ring):
* obsolete/levents.el (allocate-event, event-key, event-object)
(event-point, event-process, event-timestamp, event-to-character)
(event-window, event-x, event-x-pixel, event-y, event-y-pixel):
* textmodes/reftex-vars.el (reftex-index-macros-builtin)
(reftex-section-levels, reftex-auto-recenter-toc, reftex-toc-mode-hook)
(reftex-cite-punctuation, reftex-search-unrecursed-path-first)
(reftex-highlight-selection): Fix typos in docstrings.
2010-03-22 16:50:29 +00:00
|
|
|
|
Must be one of `vector' or `list'. Consider let-binding this around
|
2008-02-21 19:41:38 +00:00
|
|
|
|
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
|
Fix typos in docstrings.
* image-dired.el (image-dired-display-thumbs): Fix typo in docstring.
(image-dired-read-comment): Doc fix.
* json.el (json-object-type, json-array-type, json-key-type, json-false)
(json-null, json-read-number):
* minibuffer.el (completion-in-region-functions):
* calendar/cal-tex.el (cal-tex-daily-end, cal-tex-number-weeks)
(cal-tex-cursor-week):
* emacs-lisp/trace.el (trace-function):
* eshell/em-basic.el (eshell/printnl):
* eshell/em-dirs.el (eshell-last-dir-ring, eshell-parse-drive-letter)
(eshell-read-last-dir-ring, eshell-write-last-dir-ring):
* obsolete/levents.el (allocate-event, event-key, event-object)
(event-point, event-process, event-timestamp, event-to-character)
(event-window, event-x, event-x-pixel, event-y, event-y-pixel):
* textmodes/reftex-vars.el (reftex-index-macros-builtin)
(reftex-section-levels, reftex-auto-recenter-toc, reftex-toc-mode-hook)
(reftex-cite-punctuation, reftex-search-unrecursed-path-first)
(reftex-highlight-selection): Fix typos in docstrings.
2010-03-22 16:50:29 +00:00
|
|
|
|
Sufficiently Weird keys. Consider let-binding this around your call to
|
2008-02-21 19:41:38 +00:00
|
|
|
|
`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
|
Fix typos in docstrings.
* image-dired.el (image-dired-display-thumbs): Fix typo in docstring.
(image-dired-read-comment): Doc fix.
* json.el (json-object-type, json-array-type, json-key-type, json-false)
(json-null, json-read-number):
* minibuffer.el (completion-in-region-functions):
* calendar/cal-tex.el (cal-tex-daily-end, cal-tex-number-weeks)
(cal-tex-cursor-week):
* emacs-lisp/trace.el (trace-function):
* eshell/em-basic.el (eshell/printnl):
* eshell/em-dirs.el (eshell-last-dir-ring, eshell-parse-drive-letter)
(eshell-read-last-dir-ring, eshell-write-last-dir-ring):
* obsolete/levents.el (allocate-event, event-key, event-object)
(event-point, event-process, event-timestamp, event-to-character)
(event-window, event-x, event-x-pixel, event-y, event-y-pixel):
* textmodes/reftex-vars.el (reftex-index-macros-builtin)
(reftex-section-levels, reftex-auto-recenter-toc, reftex-toc-mode-hook)
(reftex-cite-punctuation, reftex-search-unrecursed-path-first)
(reftex-highlight-selection): Fix typos in docstrings.
2010-03-22 16:50:29 +00:00
|
|
|
|
the difference between `false' and `null'. Consider let-binding this
|
2008-02-21 19:41:38 +00:00
|
|
|
|
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
|
Fix typos in docstrings.
* image-dired.el (image-dired-display-thumbs): Fix typo in docstring.
(image-dired-read-comment): Doc fix.
* json.el (json-object-type, json-array-type, json-key-type, json-false)
(json-null, json-read-number):
* minibuffer.el (completion-in-region-functions):
* calendar/cal-tex.el (cal-tex-daily-end, cal-tex-number-weeks)
(cal-tex-cursor-week):
* emacs-lisp/trace.el (trace-function):
* eshell/em-basic.el (eshell/printnl):
* eshell/em-dirs.el (eshell-last-dir-ring, eshell-parse-drive-letter)
(eshell-read-last-dir-ring, eshell-write-last-dir-ring):
* obsolete/levents.el (allocate-event, event-key, event-object)
(event-point, event-process, event-timestamp, event-to-character)
(event-window, event-x, event-x-pixel, event-y, event-y-pixel):
* textmodes/reftex-vars.el (reftex-index-macros-builtin)
(reftex-section-levels, reftex-auto-recenter-toc, reftex-toc-mode-hook)
(reftex-cite-punctuation, reftex-search-unrecursed-path-first)
(reftex-highlight-selection): Fix typos in docstrings.
2010-03-22 16:50:29 +00:00
|
|
|
|
tell the difference between `false' and `null'. Consider let-binding
|
2008-02-21 19:41:38 +00:00
|
|
|
|
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)
|
2008-05-08 03:37:07 +00:00
|
|
|
|
"Non-null if and only if LIST is an alist."
|
2011-10-17 17:40:27 +00:00
|
|
|
|
(while (consp list)
|
|
|
|
|
(setq list (if (consp (car list))
|
|
|
|
|
(cdr list)
|
|
|
|
|
'not-alist)))
|
|
|
|
|
(null list))
|
2008-02-21 19:41:38 +00:00
|
|
|
|
|
|
|
|
|
(defun json-plist-p (list)
|
2008-05-08 03:37:07 +00:00
|
|
|
|
"Non-null if and only if LIST is a plist."
|
2011-10-17 17:40:27 +00:00
|
|
|
|
(while (consp list)
|
|
|
|
|
(setq list (if (and (keywordp (car list))
|
|
|
|
|
(consp (cdr list)))
|
|
|
|
|
(cddr list)
|
|
|
|
|
'not-plist)))
|
|
|
|
|
(null list))
|
2008-02-21 19:41:38 +00:00
|
|
|
|
|
|
|
|
|
;; Reader utilities
|
|
|
|
|
|
|
|
|
|
(defsubst json-advance (&optional n)
|
|
|
|
|
"Skip past the following N characters."
|
2008-10-07 16:18:22 +00:00
|
|
|
|
(forward-char n))
|
2008-02-21 19:41:38 +00:00
|
|
|
|
|
|
|
|
|
(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."
|
2008-10-08 15:52:43 +00:00
|
|
|
|
(skip-chars-forward "\t\r\n\f\b "))
|
2008-02-21 19:41:38 +00:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; 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))
|
|
|
|
|
|
2011-11-20 19:35:27 +00:00
|
|
|
|
(put 'json-string-escape 'error-message "Bad Unicode escape")
|
2008-02-21 19:41:38 +00:00
|
|
|
|
(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))
|
|
|
|
|
|
2012-08-22 01:29:22 +00:00
|
|
|
|
(put 'json-key-format 'error-message "Bad JSON object key")
|
|
|
|
|
(put 'json-key-format 'error-conditions
|
|
|
|
|
'(json-key-format json-error error))
|
|
|
|
|
|
2008-02-21 19:41:38 +00:00
|
|
|
|
(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)
|
2008-02-22 03:56:25 +00:00
|
|
|
|
(thing-at-point 'word)))))
|
2008-02-21 19:41:38 +00:00
|
|
|
|
(json-advance))
|
|
|
|
|
keyword)
|
|
|
|
|
(unless (looking-at "\\(\\s-\\|[],}]\\|$\\)")
|
|
|
|
|
(signal 'json-unknown-keyword
|
|
|
|
|
(list (save-excursion
|
|
|
|
|
(backward-word 1)
|
2008-02-22 03:56:25 +00:00
|
|
|
|
(thing-at-point 'word)))))
|
2008-02-21 19:41:38 +00:00
|
|
|
|
(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
|
|
|
|
|
|
2008-08-28 20:19:17 +00:00
|
|
|
|
(defun json-read-number (&optional sign)
|
|
|
|
|
"Read the JSON number following point.
|
Fix typos in docstrings.
* image-dired.el (image-dired-display-thumbs): Fix typo in docstring.
(image-dired-read-comment): Doc fix.
* json.el (json-object-type, json-array-type, json-key-type, json-false)
(json-null, json-read-number):
* minibuffer.el (completion-in-region-functions):
* calendar/cal-tex.el (cal-tex-daily-end, cal-tex-number-weeks)
(cal-tex-cursor-week):
* emacs-lisp/trace.el (trace-function):
* eshell/em-basic.el (eshell/printnl):
* eshell/em-dirs.el (eshell-last-dir-ring, eshell-parse-drive-letter)
(eshell-read-last-dir-ring, eshell-write-last-dir-ring):
* obsolete/levents.el (allocate-event, event-key, event-object)
(event-point, event-process, event-timestamp, event-to-character)
(event-window, event-x, event-x-pixel, event-y, event-y-pixel):
* textmodes/reftex-vars.el (reftex-index-macros-builtin)
(reftex-section-levels, reftex-auto-recenter-toc, reftex-toc-mode-hook)
(reftex-cite-punctuation, reftex-search-unrecursed-path-first)
(reftex-highlight-selection): Fix typos in docstrings.
2010-03-22 16:50:29 +00:00
|
|
|
|
The optional SIGN argument is for internal use.
|
2008-08-28 20:19:17 +00:00
|
|
|
|
|
2008-02-21 19:41:38 +00:00
|
|
|
|
N.B.: Only numbers which can fit in Emacs Lisp's native number
|
|
|
|
|
representation will be parsed correctly."
|
2008-08-28 20:19:17 +00:00
|
|
|
|
;; 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)))
|
2008-02-21 19:41:38 +00:00
|
|
|
|
(goto-char (match-end 0))
|
|
|
|
|
(string-to-number (match-string 0)))
|
2008-08-28 20:19:17 +00:00
|
|
|
|
(t (signal 'json-number-format (list (point)))))))
|
2008-02-21 19:41:38 +00:00
|
|
|
|
|
|
|
|
|
;; 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
|
2012-09-27 13:10:54 +00:00
|
|
|
|
;; Special JSON character (\n, \r, etc.).
|
2008-02-21 19:41:38 +00:00
|
|
|
|
(control-char
|
|
|
|
|
(format "\\%c" control-char))
|
2012-09-27 13:10:54 +00:00
|
|
|
|
;; ASCIIish printable character.
|
2012-09-27 22:55:03 +00:00
|
|
|
|
((and (> char 31) (< char 127))
|
2008-02-21 19:41:38 +00:00
|
|
|
|
(format "%c" char))
|
2012-09-27 13:10:54 +00:00
|
|
|
|
;; Fallback: UCS code point in \uNNNN form.
|
2008-02-21 19:41:38 +00:00
|
|
|
|
(t
|
|
|
|
|
(format "\\u%04x" char)))))
|
|
|
|
|
|
|
|
|
|
(defun json-encode-string (string)
|
|
|
|
|
"Return a JSON representation of STRING."
|
|
|
|
|
(format "\"%s\"" (mapconcat 'json-encode-char string "")))
|
|
|
|
|
|
2012-08-22 01:29:22 +00:00
|
|
|
|
(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))
|
|
|
|
|
|
2008-02-21 19:41:38 +00:00
|
|
|
|
;;; 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"
|
2012-08-22 01:29:22 +00:00
|
|
|
|
(json-encode-key k)
|
2008-02-21 19:41:38 +00:00
|
|
|
|
(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"
|
2012-08-22 01:29:22 +00:00
|
|
|
|
(json-encode-key (car cons))
|
2008-02-21 19:41:38 +00:00
|
|
|
|
(json-encode (cdr cons))))
|
|
|
|
|
alist)
|
|
|
|
|
", ")))
|
|
|
|
|
|
|
|
|
|
(defun json-encode-plist (plist)
|
|
|
|
|
"Return a JSON representation of PLIST."
|
|
|
|
|
(let (result)
|
|
|
|
|
(while plist
|
2012-08-22 01:29:22 +00:00
|
|
|
|
(push (concat (json-encode-key (car plist))
|
2008-02-21 19:41:38 +00:00
|
|
|
|
":"
|
|
|
|
|
(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))
|
2008-08-28 20:19:17 +00:00
|
|
|
|
'(?- ?+ ?. ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
|
2008-02-21 19:41:38 +00:00
|
|
|
|
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
|