Mercurial > emacs
view lisp/json.el @ 110523:a5ad4f188e19
Synch Semantic to CEDET 1.0.
Move CEDET ChangeLog entries to new file lisp/cedet/ChangeLog.
* semantic.el (semantic-version): Update to 2.0.
(semantic-mode-map): Add "," and "m" bindings.
(navigate-menu): Update.
* semantic/symref.el (semantic-symref-calculate-rootdir):
New function.
(semantic-symref-detect-symref-tool): Use it.
* semantic/symref/grep.el (semantic-symref-grep-shell): New var.
(semantic-symref-perform-search): Use it. Calculate root dir with
semantic-symref-calculate-rootdir.
(semantic-symref-derive-find-filepatterns): Improve error message.
* semantic/symref/list.el
(semantic-symref-results-mode-map): New bindings.
(semantic-symref-auto-expand-results): New option.
(semantic-symref-results-dump): Obey auto-expand.
(semantic-symref-list-expand-all, semantic-symref-regexp)
(semantic-symref-list-contract-all)
(semantic-symref-list-map-open-hits)
(semantic-symref-list-update-open-hits)
(semantic-symref-list-create-macro-on-open-hit)
(semantic-symref-list-call-macro-on-open-hits): New functions.
(semantic-symref-list-menu-entries)
(semantic-symref-list-menu): New vars.
(semantic-symref-list-map-open-hits): Move cursor to beginning of
match before calling the mapped function.
* semantic/doc.el
(semantic-documentation-comment-preceeding-tag): Do nothing if the
mode doesn't provide comment-start-skip.
* semantic/scope.el
(semantic-analyze-scope-nested-tags-default): Strip duplicates.
(semantic-analyze-scoped-inherited-tag-map): Take the tag we are
looking for as part of the scoped tags list.
* semantic/html.el (semantic-default-html-setup): Add
senator-step-at-tag-classes.
* semantic/decorate/include.el
(semantic-decoration-on-unknown-includes): Change light bgcolor.
(semantic-decoration-on-includes-highlight-default): Check that
the include tag has a postion.
* semantic/complete.el (semantic-collector-local-members):
(semantic-complete-read-tag-local-members)
(semantic-complete-jump-local-members): New class and functions.
(semantic-complete-self-insert): Save excursion before completing.
* semantic/analyze/complete.el
(semantic-analyze-possible-completions-default): If no completions
are found, return the raw by-name-only completion list. Add FLAGS
arguments. Add support for 'no-tc (type constraint) and
'no-unique, or no stripping duplicates.
(semantic-analyze-possible-completions-default): Add FLAGS arg.
* semantic/util-modes.el
(semantic-stickyfunc-show-only-functions-p): New option.
(semantic-stickyfunc-fetch-stickyline): Don't show stickytext for
the very first line in a buffer.
* semantic/util.el (semantic-hack-search)
(semantic-recursive-find-nonterminal-by-name)
(semantic-current-tag-interactive): Deleted.
(semantic-describe-buffer): Fix expand-nonterminal. Add
lex-syntax-mods, type relation separator char, and command
separation char.
(semantic-sanity-check): Only message if called interactively.
* semantic/tag.el (semantic-tag-deep-copy-one-tag): Copy the
:filename property and the tag position.
* semantic/lex-spp.el (semantic-lex-spp-lex-text-string):
Add recursion limit.
* semantic/imenu.el (semantic-imenu-bucketize-type-members):
Make this buffer local, not the obsoleted variable.
* semantic/idle.el: Add breadcrumbs support.
(semantic-idle-summary-current-symbol-info-default)
(semantic-idle-tag-highlight)
(semantic-idle-completion-list-default): Use
semanticdb-without-unloaded-file-searches for speed, and to
conform to the controls that specify if the idle timer is supposed
to be parsing unparsed includes.
(semantic-idle-symbol-highlight-face)
(semantic-idle-symbol-maybe-highlight): Rename from *-summary-*.
Callers changed.
(semantic-idle-work-parse-neighboring-files-flag): Default to nil.
(semantic-idle-work-update-headers-flag): New var.
(semantic-idle-work-for-one-buffer): Use it.
(semantic-idle-local-symbol-highlight): Rename from
semantic-idle-tag-highlight.
(semantic-idle-truncate-long-summaries): New option.
* semantic/ia.el (semantic-ia-cache)
(semantic-ia-get-completions): Deleted. Callers changed.
(semantic-ia-show-variants): New command.
(semantic-ia-show-doc): If doc is empty, don't make a temp buffer.
(semantic-ia-show-summary): If there isn't anything to show, say so.
* semantic/grammar.el (semantic-grammar-create-package):
Save the buffer even in batch mode.
* semantic/fw.el
(semanticdb-without-unloaded-file-searches): New macro.
* semantic/dep.el (semantic-dependency-find-file-on-path):
Fix case dereferencing ede-object when it is a list.
* semantic/db-typecache.el (semanticdb-expand-nested-tag)
(semanticdb-typecache-faux-namespace): New functions.
(semanticdb-typecache-file-tags)
(semanticdb-typecache-merge-streams): Use them.
(semanticdb-typecache-file-tags): When deriving tags from a file,
give the mode a chance to monkey with the tag copy.
(semanticdb-typecache-find-default): Wrap find in save-excursion.
(semanticdb-typecache-find-by-name-helper): Merge found names down.
* semantic/db-global.el
(semanticdb-enable-gnu-global-in-buffer): Don't show messages if
GNU Global is not available and we don't want to throw an error.
* semantic/db-find.el (semanticdb-find-result-nth-in-buffer):
When trying to normalize the tag to a buffer, don't error if
set-buffer method doesn't exist.
* semantic/db-file.el (semanticdb-save-db): Simplify msg.
* semantic/db.el (semanticdb-refresh-table): If forcing a
refresh on a file not in a buffer, use semantic-find-file-noselect
and delete the buffer after use.
(semanticdb-current-database-list): When calculating root via
hooks, force it through true-filename and skip the list of
possible roots.
* semantic/ctxt.el (semantic-ctxt-imported-packages): New.
* semantic/analyze/debug.el
(semantic-analyzer-debug-insert-tag): Reset standard output to
current buffer.
(semantic-analyzer-debug-global-symbol)
(semantic-analyzer-debug-missing-innertype): Change "prefix" to
"symbol" in messages.
* semantic/analyze/refs.el: (semantic-analyze-refs-impl)
(semantic-analyze-refs-proto): When calculating value, make sure
the found tag is 'similar' to the originating tag.
(semantic--analyze-refs-find-tags-with-parent): Attempt to
identify matches via imported symbols of parents.
(semantic--analyze-refs-full-lookup-with-parents): Do a deep
search during the brute search.
* semantic/analyze.el
(semantic-analyze-find-tag-sequence-default): Be robust to
calculated scopes being nil.
* semantic/bovine/c.el (semantic-c-describe-environment): Add
project macro symbol array.
(semantic-c-parse-lexical-token): Add recursion limit.
(semantic-ctxt-imported-packages, semanticdb-expand-nested-tag):
New overrides.
(semantic-expand-c-tag-namelist): Split a full type from a typedef
out to its own tag.
(semantic-expand-c-tag-namelist): Do not split out a typedef'd
inline type if it is an anonymous type.
(semantic-c-reconstitute-token): Use the optional initializers as
a clue that some function is probably a constructor. When
defining the type of these constructors, split the parent name,
and use only the class part, if applicable.
* semantic/bovine/c-by.el:
* semantic/wisent/python-wy.el: Regenerate.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Sat, 18 Sep 2010 22:49:54 -0400 |
parents | ed16fdd2685a |
children | 376148b31b5e |
line wrap: on
line source
;;; json.el --- JavaScript Object Notation parser / generator ;; Copyright (C) 2006, 2007, 2008, 2009, 2010 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 of the License, 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. If not, see <http://www.gnu.org/licenses/>. ;;; 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)) ;; 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 if and only if LIST is an alist." (or (null list) (and (consp (car list)) (json-alist-p (cdr 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))))) ;; Reader utilities (defsubst json-advance (&optional n) "Skip past the following N characters." (forward-char n)) (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." (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)) ;;; 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) (thing-at-point 'word))))) (json-advance)) keyword) (unless (looking-at "\\(\\s-\\|[],}]\\|$\\)") (signal 'json-unknown-keyword (list (save-excursion (backward-word 1) (thing-at-point 'word))))) (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 (&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 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))) (t (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) ;; arch-tag: 15f6e4c8-b831-4172-8749-bbc680c50ea1 ;;; json.el ends here