[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to net/json.el
From: |
Michael W. Olson |
Subject: |
[Emacs-diffs] Changes to net/json.el |
Date: |
Fri, 22 Feb 2008 01:14:04 +0000 |
CVSROOT: /sources/emacs
Module name: emacs
Changes by: Michael W. Olson <mwolson> 08/02/22 01:14:03
Index: net/json.el
===================================================================
RCS file: net/json.el
diff -N net/json.el
--- net/json.el 21 Feb 2008 20:28:27 -0000 1.2
+++ /dev/null 1 Jan 1970 00:00:00 -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 <address@hidden>
-;; 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 <address@hidden>.
-;; 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