Mercurial > emacs
comparison lisp/json.el @ 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 | |
children | 23ee465a6963 |
comparison
equal
deleted
inserted
replaced
92060:fd85a7810d53 | 92061:2b55e8843eff |
---|---|
1 ;;; json.el --- JavaScript Object Notation parser / generator | |
2 | |
3 ;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc. | |
4 | |
5 ;; Author: Edward O'Connor <ted@oconnor.cx> | |
6 ;; Version: 1.2 | |
7 ;; Keywords: convenience | |
8 | |
9 ;; This file is part of GNU Emacs. | |
10 | |
11 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
12 ;; it under the terms of the GNU General Public License as published by | |
13 ;; the Free Software Foundation; either version 3, or (at your option) | |
14 ;; any later version. | |
15 | |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | |
24 ;; Boston, MA 02110-1301, USA. | |
25 | |
26 ;;; Commentary: | |
27 | |
28 ;; This is a library for parsing and generating JSON (JavaScript Object | |
29 ;; Notation). | |
30 | |
31 ;; Learn all about JSON here: <URL:http://json.org/>. | |
32 | |
33 ;; The user-serviceable entry points for the parser are the functions | |
34 ;; `json-read' and `json-read-from-string'. The encoder has a single | |
35 ;; entry point, `json-encode'. | |
36 | |
37 ;; Since there are several natural representations of key-value pair | |
38 ;; mappings in elisp (alist, plist, hash-table), `json-read' allows you | |
39 ;; to specify which you'd prefer (see `json-object-type' and | |
40 ;; `json-array-type'). | |
41 | |
42 ;; Similarly, since `false' and `null' are distinct in JSON, you can | |
43 ;; distinguish them by binding `json-false' and `json-null' as desired. | |
44 | |
45 ;;; History: | |
46 | |
47 ;; 2006-03-11 - Initial version. | |
48 ;; 2006-03-13 - Added JSON generation in addition to parsing. Various | |
49 ;; other cleanups, bugfixes, and improvements. | |
50 ;; 2006-12-29 - XEmacs support, from Aidan Kehoe <kehoea@parhasard.net>. | |
51 ;; 2008-02-21 - Installed in GNU Emacs. | |
52 | |
53 ;;; Code: | |
54 | |
55 (eval-when-compile (require 'cl)) | |
56 (require 'thingatpt) | |
57 | |
58 ;; Compatibility code | |
59 | |
60 (defalias 'json-encode-char0 'encode-char) | |
61 (defalias 'json-decode-char0 'decode-char) | |
62 | |
63 | |
64 ;; Parameters | |
65 | |
66 (defvar json-object-type 'alist | |
67 "Type to convert JSON objects to. | |
68 Must be one of `alist', `plist', or `hash-table'. Consider let-binding | |
69 this around your call to `json-read' instead of `setq'ing it.") | |
70 | |
71 (defvar json-array-type 'vector | |
72 "Type to convert JSON arrays to. | |
73 Must be one of `vector' or `list'. Consider let-binding this around | |
74 your call to `json-read' instead of `setq'ing it.") | |
75 | |
76 (defvar json-key-type nil | |
77 "Type to convert JSON keys to. | |
78 Must be one of `string', `symbol', `keyword', or nil. | |
79 | |
80 If nil, `json-read' will guess the type based on the value of | |
81 `json-object-type': | |
82 | |
83 If `json-object-type' is: nil will be interpreted as: | |
84 `hash-table' `string' | |
85 `alist' `symbol' | |
86 `plist' `keyword' | |
87 | |
88 Note that values other than `string' might behave strangely for | |
89 Sufficiently Weird keys. Consider let-binding this around your call to | |
90 `json-read' instead of `setq'ing it.") | |
91 | |
92 (defvar json-false :json-false | |
93 "Value to use when reading JSON `false'. | |
94 If this has the same value as `json-null', you might not be able to tell | |
95 the difference between `false' and `null'. Consider let-binding this | |
96 around your call to `json-read' instead of `setq'ing it.") | |
97 | |
98 (defvar json-null nil | |
99 "Value to use when reading JSON `null'. | |
100 If this has the same value as `json-false', you might not be able to | |
101 tell the difference between `false' and `null'. Consider let-binding | |
102 this around your call to `json-read' instead of `setq'ing it.") | |
103 | |
104 | |
105 | |
106 ;;; Utilities | |
107 | |
108 (defun json-join (strings separator) | |
109 "Join STRINGS with SEPARATOR." | |
110 (mapconcat 'identity strings separator)) | |
111 | |
112 (defun json-alist-p (list) | |
113 "Non-null iff LIST is an alist." | |
114 (or (null list) | |
115 (and (consp (car list)) | |
116 (json-alist-p (cdr list))))) | |
117 | |
118 (defun json-plist-p (list) | |
119 "Non-null iff LIST is a plist." | |
120 (or (null list) | |
121 (and (keywordp (car list)) | |
122 (consp (cdr list)) | |
123 (json-plist-p (cddr list))))) | |
124 | |
125 ;; Reader utilities | |
126 | |
127 (defsubst json-advance (&optional n) | |
128 "Skip past the following N characters." | |
129 (unless n (setq n 1)) | |
130 (let ((goal (+ (point) n))) | |
131 (goto-char goal) | |
132 (when (< (point) goal) | |
133 (signal 'end-of-file nil)))) | |
134 | |
135 (defsubst json-peek () | |
136 "Return the character at point." | |
137 (let ((char (char-after (point)))) | |
138 (or char :json-eof))) | |
139 | |
140 (defsubst json-pop () | |
141 "Advance past the character at point, returning it." | |
142 (let ((char (json-peek))) | |
143 (if (eq char :json-eof) | |
144 (signal 'end-of-file nil) | |
145 (json-advance) | |
146 char))) | |
147 | |
148 (defun json-skip-whitespace () | |
149 "Skip past the whitespace at point." | |
150 (while (looking-at "[\t\r\n\f\b ]") | |
151 (goto-char (match-end 0)))) | |
152 | |
153 | |
154 | |
155 ;; Error conditions | |
156 | |
157 (put 'json-error 'error-message "Unknown JSON error") | |
158 (put 'json-error 'error-conditions '(json-error error)) | |
159 | |
160 (put 'json-readtable-error 'error-message "JSON readtable error") | |
161 (put 'json-readtable-error 'error-conditions | |
162 '(json-readtable-error json-error error)) | |
163 | |
164 (put 'json-unknown-keyword 'error-message "Unrecognized keyword") | |
165 (put 'json-unknown-keyword 'error-conditions | |
166 '(json-unknown-keyword json-error error)) | |
167 | |
168 (put 'json-number-format 'error-message "Invalid number format") | |
169 (put 'json-number-format 'error-conditions | |
170 '(json-number-format json-error error)) | |
171 | |
172 (put 'json-string-escape 'error-message "Bad unicode escape") | |
173 (put 'json-string-escape 'error-conditions | |
174 '(json-string-escape json-error error)) | |
175 | |
176 (put 'json-string-format 'error-message "Bad string format") | |
177 (put 'json-string-format 'error-conditions | |
178 '(json-string-format json-error error)) | |
179 | |
180 (put 'json-object-format 'error-message "Bad JSON object") | |
181 (put 'json-object-format 'error-conditions | |
182 '(json-object-format json-error error)) | |
183 | |
184 | |
185 | |
186 ;;; Keywords | |
187 | |
188 (defvar json-keywords '("true" "false" "null") | |
189 "List of JSON keywords.") | |
190 | |
191 ;; Keyword parsing | |
192 | |
193 (defun json-read-keyword (keyword) | |
194 "Read a JSON keyword at point. | |
195 KEYWORD is the keyword expected." | |
196 (unless (member keyword json-keywords) | |
197 (signal 'json-unknown-keyword (list keyword))) | |
198 (mapc (lambda (char) | |
199 (unless (char-equal char (json-peek)) | |
200 (signal 'json-unknown-keyword | |
201 (list (save-excursion | |
202 (backward-word 1) | |
203 (word-at-point))))) | |
204 (json-advance)) | |
205 keyword) | |
206 (unless (looking-at "\\(\\s-\\|[],}]\\|$\\)") | |
207 (signal 'json-unknown-keyword | |
208 (list (save-excursion | |
209 (backward-word 1) | |
210 (word-at-point))))) | |
211 (cond ((string-equal keyword "true") t) | |
212 ((string-equal keyword "false") json-false) | |
213 ((string-equal keyword "null") json-null))) | |
214 | |
215 ;; Keyword encoding | |
216 | |
217 (defun json-encode-keyword (keyword) | |
218 "Encode KEYWORD as a JSON value." | |
219 (cond ((eq keyword t) "true") | |
220 ((eq keyword json-false) "false") | |
221 ((eq keyword json-null) "null"))) | |
222 | |
223 ;;; Numbers | |
224 | |
225 ;; Number parsing | |
226 | |
227 (defun json-read-number () | |
228 "Read the JSON number following point. | |
229 N.B.: Only numbers which can fit in Emacs Lisp's native number | |
230 representation will be parsed correctly." | |
231 (if (char-equal (json-peek) ?-) | |
232 (progn | |
233 (json-advance) | |
234 (- 0 (json-read-number))) | |
235 (if (looking-at "[0-9]+\\([.][0-9]+\\)?\\([eE][+-]?[0-9]+\\)?") | |
236 (progn | |
237 (goto-char (match-end 0)) | |
238 (string-to-number (match-string 0))) | |
239 (signal 'json-number-format (list (point)))))) | |
240 | |
241 ;; Number encoding | |
242 | |
243 (defun json-encode-number (number) | |
244 "Return a JSON representation of NUMBER." | |
245 (format "%s" number)) | |
246 | |
247 ;;; Strings | |
248 | |
249 (defvar json-special-chars | |
250 '((?\" . ?\") | |
251 (?\\ . ?\\) | |
252 (?/ . ?/) | |
253 (?b . ?\b) | |
254 (?f . ?\f) | |
255 (?n . ?\n) | |
256 (?r . ?\r) | |
257 (?t . ?\t)) | |
258 "Characters which are escaped in JSON, with their elisp counterparts.") | |
259 | |
260 ;; String parsing | |
261 | |
262 (defun json-read-escaped-char () | |
263 "Read the JSON string escaped character at point." | |
264 ;; Skip over the '\' | |
265 (json-advance) | |
266 (let* ((char (json-pop)) | |
267 (special (assq char json-special-chars))) | |
268 (cond | |
269 (special (cdr special)) | |
270 ((not (eq char ?u)) char) | |
271 ((looking-at "[0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f]") | |
272 (let ((hex (match-string 0))) | |
273 (json-advance 4) | |
274 (json-decode-char0 'ucs (string-to-number hex 16)))) | |
275 (t | |
276 (signal 'json-string-escape (list (point))))))) | |
277 | |
278 (defun json-read-string () | |
279 "Read the JSON string at point." | |
280 (unless (char-equal (json-peek) ?\") | |
281 (signal 'json-string-format (list "doesn't start with '\"'!"))) | |
282 ;; Skip over the '"' | |
283 (json-advance) | |
284 (let ((characters '()) | |
285 (char (json-peek))) | |
286 (while (not (char-equal char ?\")) | |
287 (push (if (char-equal char ?\\) | |
288 (json-read-escaped-char) | |
289 (json-pop)) | |
290 characters) | |
291 (setq char (json-peek))) | |
292 ;; Skip over the '"' | |
293 (json-advance) | |
294 (if characters | |
295 (apply 'string (nreverse characters)) | |
296 ""))) | |
297 | |
298 ;; String encoding | |
299 | |
300 (defun json-encode-char (char) | |
301 "Encode CHAR as a JSON string." | |
302 (setq char (json-encode-char0 char 'ucs)) | |
303 (let ((control-char (car (rassoc char json-special-chars)))) | |
304 (cond | |
305 ;; Special JSON character (\n, \r, etc.) | |
306 (control-char | |
307 (format "\\%c" control-char)) | |
308 ;; ASCIIish printable character | |
309 ((and (> char 31) (< char 161)) | |
310 (format "%c" char)) | |
311 ;; Fallback: UCS code point in \uNNNN form | |
312 (t | |
313 (format "\\u%04x" char))))) | |
314 | |
315 (defun json-encode-string (string) | |
316 "Return a JSON representation of STRING." | |
317 (format "\"%s\"" (mapconcat 'json-encode-char string ""))) | |
318 | |
319 ;;; JSON Objects | |
320 | |
321 (defun json-new-object () | |
322 "Create a new Elisp object corresponding to a JSON object. | |
323 Please see the documentation of `json-object-type'." | |
324 (cond ((eq json-object-type 'hash-table) | |
325 (make-hash-table :test 'equal)) | |
326 (t | |
327 (list)))) | |
328 | |
329 (defun json-add-to-object (object key value) | |
330 "Add a new KEY -> VALUE association to OBJECT. | |
331 Returns the updated object, which you should save, e.g.: | |
332 (setq obj (json-add-to-object obj \"foo\" \"bar\")) | |
333 Please see the documentation of `json-object-type' and `json-key-type'." | |
334 (let ((json-key-type | |
335 (if (eq json-key-type nil) | |
336 (cdr (assq json-object-type '((hash-table . string) | |
337 (alist . symbol) | |
338 (plist . keyword)))) | |
339 json-key-type))) | |
340 (setq key | |
341 (cond ((eq json-key-type 'string) | |
342 key) | |
343 ((eq json-key-type 'symbol) | |
344 (intern key)) | |
345 ((eq json-key-type 'keyword) | |
346 (intern (concat ":" key))))) | |
347 (cond ((eq json-object-type 'hash-table) | |
348 (puthash key value object) | |
349 object) | |
350 ((eq json-object-type 'alist) | |
351 (cons (cons key value) object)) | |
352 ((eq json-object-type 'plist) | |
353 (cons key (cons value object)))))) | |
354 | |
355 ;; JSON object parsing | |
356 | |
357 (defun json-read-object () | |
358 "Read the JSON object at point." | |
359 ;; Skip over the "{" | |
360 (json-advance) | |
361 (json-skip-whitespace) | |
362 ;; read key/value pairs until "}" | |
363 (let ((elements (json-new-object)) | |
364 key value) | |
365 (while (not (char-equal (json-peek) ?})) | |
366 (json-skip-whitespace) | |
367 (setq key (json-read-string)) | |
368 (json-skip-whitespace) | |
369 (if (char-equal (json-peek) ?:) | |
370 (json-advance) | |
371 (signal 'json-object-format (list ":" (json-peek)))) | |
372 (setq value (json-read)) | |
373 (setq elements (json-add-to-object elements key value)) | |
374 (json-skip-whitespace) | |
375 (unless (char-equal (json-peek) ?}) | |
376 (if (char-equal (json-peek) ?,) | |
377 (json-advance) | |
378 (signal 'json-object-format (list "," (json-peek)))))) | |
379 ;; Skip over the "}" | |
380 (json-advance) | |
381 elements)) | |
382 | |
383 ;; Hash table encoding | |
384 | |
385 (defun json-encode-hash-table (hash-table) | |
386 "Return a JSON representation of HASH-TABLE." | |
387 (format "{%s}" | |
388 (json-join | |
389 (let (r) | |
390 (maphash | |
391 (lambda (k v) | |
392 (push (format "%s:%s" | |
393 (json-encode k) | |
394 (json-encode v)) | |
395 r)) | |
396 hash-table) | |
397 r) | |
398 ", "))) | |
399 | |
400 ;; List encoding (including alists and plists) | |
401 | |
402 (defun json-encode-alist (alist) | |
403 "Return a JSON representation of ALIST." | |
404 (format "{%s}" | |
405 (json-join (mapcar (lambda (cons) | |
406 (format "%s:%s" | |
407 (json-encode (car cons)) | |
408 (json-encode (cdr cons)))) | |
409 alist) | |
410 ", "))) | |
411 | |
412 (defun json-encode-plist (plist) | |
413 "Return a JSON representation of PLIST." | |
414 (let (result) | |
415 (while plist | |
416 (push (concat (json-encode (car plist)) | |
417 ":" | |
418 (json-encode (cadr plist))) | |
419 result) | |
420 (setq plist (cddr plist))) | |
421 (concat "{" (json-join (nreverse result) ", ") "}"))) | |
422 | |
423 (defun json-encode-list (list) | |
424 "Return a JSON representation of LIST. | |
425 Tries to DWIM: simple lists become JSON arrays, while alists and plists | |
426 become JSON objects." | |
427 (cond ((null list) "null") | |
428 ((json-alist-p list) (json-encode-alist list)) | |
429 ((json-plist-p list) (json-encode-plist list)) | |
430 ((listp list) (json-encode-array list)) | |
431 (t | |
432 (signal 'json-error (list list))))) | |
433 | |
434 ;;; Arrays | |
435 | |
436 ;; Array parsing | |
437 | |
438 (defun json-read-array () | |
439 "Read the JSON array at point." | |
440 ;; Skip over the "[" | |
441 (json-advance) | |
442 (json-skip-whitespace) | |
443 ;; read values until "]" | |
444 (let (elements) | |
445 (while (not (char-equal (json-peek) ?\])) | |
446 (push (json-read) elements) | |
447 (json-skip-whitespace) | |
448 (unless (char-equal (json-peek) ?\]) | |
449 (if (char-equal (json-peek) ?,) | |
450 (json-advance) | |
451 (signal 'json-error (list 'bleah))))) | |
452 ;; Skip over the "]" | |
453 (json-advance) | |
454 (apply json-array-type (nreverse elements)))) | |
455 | |
456 ;; Array encoding | |
457 | |
458 (defun json-encode-array (array) | |
459 "Return a JSON representation of ARRAY." | |
460 (concat "[" (mapconcat 'json-encode array ", ") "]")) | |
461 | |
462 | |
463 | |
464 ;;; JSON reader. | |
465 | |
466 (defvar json-readtable | |
467 (let ((table | |
468 '((?t json-read-keyword "true") | |
469 (?f json-read-keyword "false") | |
470 (?n json-read-keyword "null") | |
471 (?{ json-read-object) | |
472 (?\[ json-read-array) | |
473 (?\" json-read-string)))) | |
474 (mapc (lambda (char) | |
475 (push (list char 'json-read-number) table)) | |
476 '(?- ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) | |
477 table) | |
478 "Readtable for JSON reader.") | |
479 | |
480 (defun json-read () | |
481 "Parse and return the JSON object following point. | |
482 Advances point just past JSON object." | |
483 (json-skip-whitespace) | |
484 (let ((char (json-peek))) | |
485 (if (not (eq char :json-eof)) | |
486 (let ((record (cdr (assq char json-readtable)))) | |
487 (if (functionp (car record)) | |
488 (apply (car record) (cdr record)) | |
489 (signal 'json-readtable-error record))) | |
490 (signal 'end-of-file nil)))) | |
491 | |
492 ;; Syntactic sugar for the reader | |
493 | |
494 (defun json-read-from-string (string) | |
495 "Read the JSON object contained in STRING and return it." | |
496 (with-temp-buffer | |
497 (insert string) | |
498 (goto-char (point-min)) | |
499 (json-read))) | |
500 | |
501 (defun json-read-file (file) | |
502 "Read the first JSON object contained in FILE and return it." | |
503 (with-temp-buffer | |
504 (insert-file-contents file) | |
505 (goto-char (point-min)) | |
506 (json-read))) | |
507 | |
508 | |
509 | |
510 ;;; JSON encoder | |
511 | |
512 (defun json-encode (object) | |
513 "Return a JSON representation of OBJECT as a string." | |
514 (cond ((memq object (list t json-null json-false)) | |
515 (json-encode-keyword object)) | |
516 ((stringp object) (json-encode-string object)) | |
517 ((keywordp object) (json-encode-string | |
518 (substring (symbol-name object) 1))) | |
519 ((symbolp object) (json-encode-string | |
520 (symbol-name object))) | |
521 ((numberp object) (json-encode-number object)) | |
522 ((arrayp object) (json-encode-array object)) | |
523 ((hash-table-p object) (json-encode-hash-table object)) | |
524 ((listp object) (json-encode-list object)) | |
525 (t (signal 'json-error (list object))))) | |
526 | |
527 (provide 'json) | |
528 | |
529 ;;; json.el ends here |