a7/e0a8a2fe52d63827b64ae3b9acdfc5cdd2c2b5

   1 Return-Path: <amdragon@mit.edu>\r
   2 X-Original-To: notmuch@notmuchmail.org\r
   3 Delivered-To: notmuch@notmuchmail.org\r
   4 Received: from localhost (localhost [127.0.0.1])\r
   5         by olra.theworths.org (Postfix) with ESMTP id EE5BF431FD0\r
   6         for <notmuch@notmuchmail.org>; Wed, 20 Jul 2011 13:50:24 -0700 (PDT)\r
   7 X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
   8 X-Spam-Flag: NO\r
   9 X-Spam-Score: -0.7\r
  10 X-Spam-Level: \r
  11 X-Spam-Status: No, score=-0.7 tagged_above=-999 required=5\r
  12         tests=[RCVD_IN_DNSWL_LOW=-0.7] autolearn=disabled\r
  13 Received: from olra.theworths.org ([127.0.0.1])\r
  14         by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)\r
  15         with ESMTP id 27QeVyQwmBVx for <notmuch@notmuchmail.org>;\r
  16         Wed, 20 Jul 2011 13:50:22 -0700 (PDT)\r
  17 Received: from dmz-mailsec-scanner-5.mit.edu (DMZ-MAILSEC-SCANNER-5.MIT.EDU\r
  18         [18.7.68.34])\r
  19         by olra.theworths.org (Postfix) with ESMTP id 8D394431FB6\r
  20         for <notmuch@notmuchmail.org>; Wed, 20 Jul 2011 13:50:22 -0700 (PDT)\r
  21 X-AuditID: 12074422-b7ba7ae000000a14-a6-4e273f7e061b\r
  22 Received: from mailhub-auth-4.mit.edu ( [18.7.62.39])\r
  23         by dmz-mailsec-scanner-5.mit.edu (Symantec Messaging Gateway) with SMTP\r
  24         id 1D.A7.02580.E7F372E4; Wed, 20 Jul 2011 16:50:06 -0400 (EDT)\r
  25 Received: from outgoing.mit.edu (OUTGOING-AUTH.MIT.EDU [18.7.22.103])\r
  26         by mailhub-auth-4.mit.edu (8.13.8/8.9.2) with ESMTP id p6KKoLmr011903; \r
  27         Wed, 20 Jul 2011 16:50:21 -0400\r
  28 Received: from awakening.csail.mit.edu (awakening.csail.mit.edu [18.26.4.91])\r
  29         (authenticated bits=0)\r
  30         (User authenticated as amdragon@ATHENA.MIT.EDU)\r
  31         by outgoing.mit.edu (8.13.6/8.12.4) with ESMTP id p6KKoJHH001367\r
  32         (version=TLSv1/SSLv3 cipher=AES256-SHA bits=256 verify=NOT);\r
  33         Wed, 20 Jul 2011 16:50:20 -0400 (EDT)\r
  34 Received: from amthrax by awakening.csail.mit.edu with local (Exim 4.72)\r
  35         (envelope-from <amdragon@mit.edu>)\r
  36         id 1QjdiZ-0007Ee-Tb; Wed, 20 Jul 2011 16:50:07 -0400\r
  37 Date: Wed, 20 Jul 2011 16:50:07 -0400\r
  38 From: Austin Clements <amdragon@MIT.EDU>\r
  39 To: Pieter Praet <pieter@praet.org>\r
  40 Subject: JSON parsing performance (was Re: [PATCH v2] emacs: bad regexp @\r
  41         `notmuch-search-process-filter')\r
  42 Message-ID: <20110720205007.GB21316@mit.edu>\r
  43 References: <20110705214234.GA15360@mit.edu>\r
  44         <1310416993-31031-1-git-send-email-pieter@praet.org>\r
  45         <20110711210532.GC25558@mit.edu> <878vs28dvo.fsf@praet.org>\r
  46         <20110713185721.GI25558@mit.edu>\r
  47 MIME-Version: 1.0\r
  48 Content-Type: multipart/mixed; boundary="/04w6evG8XlLl3ft"\r
  49 Content-Disposition: inline\r
  50 In-Reply-To: <20110713185721.GI25558@mit.edu>\r
  51 User-Agent: Mutt/1.5.20 (2009-06-14)\r
  52 X-Brightmail-Tracker:\r
  53  H4sIAAAAAAAAA+NgFvrIKsWRmVeSWpSXmKPExsUixG6nrltnr+5ncHmrqsW+O1uYLK7fnMls\r
  54         8fv1DWaLpb92szmweOx6/pfJY+esu+wez1bdYvbo2HeZNYAlissmJTUnsyy1SN8ugStj5u6n\r
  55         7AWr/zBW3G84zdbAuG4PYxcjJ4eEgInExHvv2SFsMYkL99azdTFycQgJ7GOUWLjyMyuEs4FR\r
  56         4uOOT8wQzkkmiaU3DkFlljBKfF67C6yfRUBV4vfJNiYQm01AQ2Lb/uVgO0QElCVOP/kJVMPB\r
  57         wSxQKLHkWiVIWFggR6Lh4VdmEJtXQEdiz6t1YLaQwDFGiX1LYiDighInZz5hAbGZBawkfv6Z\r
  58         wAgxRlpi+T8OEJNTQFdi6aR4kApRARWJa/vb2SYwCs1C0jwLSfMshGaIsJbEjX8vmXAKg9gW\r
  59         Ej9+P2XDFDeW2HZ4LuMCRs5VjLIpuVW6uYmZOcWpybrFyYl5ealFuqZ6uZkleqkppZsYwfHo\r
  60         orSD8edBpUOMAhyMSjy8DnzqfkKsiWXFlbmHGCU5mJREeafaAYX4kvJTKjMSizPii0pzUosP\r
  61         MUpwMCuJ8Cr+U/MT4k1JrKxKLcqHSUlzsCiJ85Z4//cVEkhPLEnNTk0tSC2CycpwcChJ8IoD\r
  62         046QYFFqempFWmZOCUKaiYMTZDgP0HBtkBre4oLE3OLMdIj8KUZjjvu37x9h5Lj+FEgKseTl\r
  63         56VKifO+ALlRAKQ0ozQPbhospb5iFAd6Tpj3DUgVDzAdw817BbSKCWhVi7oqyKqSRISUVANj\r
  64         4l4bltdqfb++PTWNKGasSf1lweD64LSoZtcaGZ+0moNHrX7bfWbmm+n0N3B5c2ClCLPYH/W3\r
  65         J5SClDctN1juzrCkj7Exk9lnf4dKlskdZ/nHbdH/Hkx+4rclyG/RLSVb3y1pO6ojMxWsrV36\r
  66         5mrU8pW/0O7YdK6Gb+fToylbzZ4bxbILzlBiKc5INNRiLipOBACOvzSrhAMAAA==\r
  67 Cc: servilio <servilio@gmail.com>, Notmuch Mail <notmuch@notmuchmail.org>,\r
  68         David Edmondson <dme@dme.org>\r
  69 X-BeenThere: notmuch@notmuchmail.org\r
  70 X-Mailman-Version: 2.1.13\r
  71 Precedence: list\r
  72 List-Id: "Use and development of the notmuch mail system."\r
  73         <notmuch.notmuchmail.org>\r
  74 List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
  75         <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
  76 List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
  77 List-Post: <mailto:notmuch@notmuchmail.org>\r
  78 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
  79 List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
  80         <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
  81 X-List-Received-Date: Wed, 20 Jul 2011 20:50:25 -0000\r
  82 \r
  83 \r
  84 --/04w6evG8XlLl3ft\r
  85 Content-Type: text/plain; charset=us-ascii\r
  86 Content-Disposition: inline\r
  87 \r
  88 Quoth myself on Jul 13 at  2:57 pm:\r
  89 > Quoth Pieter Praet on Jul 13 at  4:16 pm:\r
  90 > > Jamie Zawinski once said/wrote [1]:\r
  91 > >   'Some people, when confronted with a problem, think "I know,\r
  92 > >   I'll use regular expressions." Now they have two problems.'\r
  93 > > \r
  94 > > With this in mind, I set out to get rid of this whole regex mess altogether,\r
  95 > > by populating the search buffer using Notmuch's JSON output instead of doing\r
  96 > > brittle text matching tricks.\r
  97 > > \r
  98 > > Looking for some documentation, I stumbled upon a long-forgotten gem [2].\r
  99 > > \r
 100 > > David's already done pretty much all of the work for us!\r
 101 > \r
 102 > Yes, similar thoughts were running through my head as I futzed with\r
 103 > the formatting for this.  My concern with moving to JSON for search\r
 104 > buffers is that parsing it is about *30 times slower* than the current\r
 105 > regexp-based approach (0.6 seconds versus 0.02 seconds for a mere 1413\r
 106 > result search buffer).  I think JSON makes a lot of sense for show\r
 107 > buffers because there's generally less data and it has a lot of\r
 108 > complicated structure.  Search results, on the other hand, have a very\r
 109 > simple, regular, and constrained structure, so JSON doesn't buy us\r
 110 > nearly as much.\r
 111 > \r
 112 > JSON is hard to parse because, like the text search output, it's\r
 113 > designed for human consumption (of course, unlike the text search\r
 114 > output, it's also designed for computer consumption).  There's\r
 115 > something to be said for the debuggability and generality of this and\r
 116 > JSON is very good for exchanging small objects, but it's a remarkably\r
 117 > inefficient way to exchange large amounts of data between two\r
 118 > programs.\r
 119 > \r
 120 > I guess what I'm getting at, though it pains me to say it, is perhaps\r
 121 > search needs a fast, computer-readable interchange format.  The\r
 122 > structure of the data is so simple and constrained that this could be\r
 123 > altogether trivial.\r
 124 > \r
 125 > Or maybe I need a faster computer.\r
 126 \r
 127 Or maybe I need to un-lame my benchmark.\r
 128 \r
 129 TL;DR: We should use JSON for search results, but possibly not the\r
 130 json.el shipped with Emacs.\r
 131 \r
 132 I realized that my text benchmark didn't capture the cost of\r
 133 extracting the match strings.  re-search-forward records matches as\r
 134 buffer positions, which don't get realized into strings until you call\r
 135 match-string.  Hence, match-string is quite expensive.\r
 136 \r
 137 Also, Emacs' json.el is slow, so I perked it up.  My modified json.el\r
 138 is ~3X faster, particularly for string-heavy output like notmuch's.\r
 139 Though now I'm well into the realm of "eq is faster than =" and "M-x\r
 140 disassemble", so unless I missed something big, this is as fast as it\r
 141 gets.\r
 142 \r
 143 While I was still thinking about new IPC formats, I realized that the\r
 144 text format and the Emacs UI are already tightly coupled, so why not\r
 145 go all the way and use S-expressions for IPC?  I now think JSON is\r
 146 fast enough to use, but S-expressions still have a certain appeal.\r
 147 They share most of the benefits of JSON; structure and extensibility\r
 148 in particular.  Further, while the content of some ad-hoc format could\r
 149 easily diverge from both the text and JSON formats, S-expressions\r
 150 could exactly parallel the JSON content (with a little more\r
 151 abstraction, they could even share the same format code).  For kicks,\r
 152 I included an S-expression benchmark.  It beats out the text parser by\r
 153 a factor of two and the optimized JSON parser by a factor of three.\r
 154 \r
 155 Here are the results for my 1,413 result search buffer and timeworn\r
 156 computer\r
 157 \r
 158                  Time   Normalized\r
 159 --format=text   0.148s     1.00x\r
 160 --format=json   0.598s     4.04x\r
 161 custom json.el  0.209s     1.41x\r
 162  + string keys  0.195s     1.32x\r
 163 S-expressions   0.066s     0.45x\r
 164 \r
 165 I don't have time right now, but next week I might be able to look\r
 166 through and update dme's JSON-based search code.\r
 167 \r
 168 \r
 169 The benchmark and modified json.el are attached.\r
 170 \r
 171 The benchmark is written so you can open it and eval-buffer, then C-x\r
 172 C-e the various calls in the comments.  You can either\r
 173 make-text/make-json, or run notmuch manually, pipe the results into\r
 174 files "text" and "json", and open them in Emacs.\r
 175 \r
 176 Please excuse the modified json.el code; it's gone through zero\r
 177 cleanup.\r
 178 \r
 179 --/04w6evG8XlLl3ft\r
 180 Content-Type: text/plain; charset=us-ascii\r
 181 Content-Disposition: attachment; filename="timeparse.el"\r
 182 \r
 183 (defmacro time-it (repeat &rest body)\r
 184   (declare (indent 1))\r
 185   (when (not (numberp repeat))\r
 186     (push repeat body)\r
 187     (setq repeat 1))\r
 188   (let ((start-time (gensym)) (i (gensym)))\r
 189     `(let ((,start-time (get-internal-run-time)))\r
 190        (dotimes (,i ,repeat)\r
 191          ,@body)\r
 192        (/ (float-time (time-subtract (get-internal-run-time) ,start-time))\r
 193           ,repeat))))\r
 194 \r
 195 ;; Text\r
 196 \r
 197 (defun make-text ()\r
 198   (with-current-buffer (get-buffer-create "text")\r
 199     (erase-buffer)\r
 200     (call-process "notmuch" nil t nil "search" "--format=text" "--" "tag:x/notmuch")))\r
 201 \r
 202 (defun time-text ()\r
 203   (with-current-buffer "text"\r
 204     (time-it 10\r
 205       (goto-char (point-min))\r
 206       (while (re-search-forward "^\\(thread:[0-9A-Fa-f]*\\) \\([^][]*\\) \\(\\[[0-9/]*\\]\\) \\([^;]*\\); \\(.*\\) (\\([^()]*\\))$" nil t)\r
 207         (let* ((thread-id (match-string 1))\r
 208                (date (match-string 2))\r
 209                (count (match-string 3))\r
 210                (authors (match-string 4))\r
 211                (subject (match-string 5))\r
 212                (tags (match-string 6))\r
 213                (tag-list (if tags (save-match-data (split-string tags)))))\r
 214           t)))))\r
 215 \r
 216 (byte-compile 'time-text)\r
 217 ;; (make-text)\r
 218 ;; (time-text)\r
 219 \r
 220 ;; JSON\r
 221 \r
 222 (defun load-custom-json ()\r
 223   (byte-compile-file "json.el")\r
 224   (load-file "./json.elc"))\r
 225 \r
 226 (defun make-json ()\r
 227   (with-current-buffer (get-buffer-create "json")\r
 228     (erase-buffer)\r
 229     (call-process "notmuch" nil t nil "search" "--format=json" "--" "tag:x/notmuch")))\r
 230 \r
 231 (defun time-json (&optional buf)\r
 232   (with-current-buffer (or buf "json")\r
 233     (let ((json-array-type 'list)\r
 234           (json-object-type 'alist)\r
 235           (json-key-type 'symbol))\r
 236       (time-it 10\r
 237         (goto-char (point-min))\r
 238         (dolist (ent (json-read))\r
 239           ;; (Surprisingly, traversing the structure has no noticeable\r
 240           ;; impact to performance)\r
 241           (let ((thread-id (assq 'thread ent))\r
 242                 (date (assq 'timestamp ent))\r
 243                 (matched (assq 'matched ent))\r
 244                 (total (assq 'total ent))\r
 245                 (authors (assq 'authors ent))\r
 246                 (subject (assq 'subject ent))\r
 247                 (tag-list (assq 'tags ent)))\r
 248             t))))))\r
 249 \r
 250 (defun time-json-string-keys (&optional buf)\r
 251   (with-current-buffer (or buf "json")\r
 252     (let ((json-array-type 'list)\r
 253           (json-object-type 'alist)\r
 254           (json-key-type 'string))\r
 255       (time-it 10\r
 256         (goto-char (point-min))\r
 257         (dolist (ent (json-read))\r
 258           (let ((thread-id (assoc "thread" ent))\r
 259                 (date (assoc "timestamp" ent))\r
 260                 (matched (assoc "matched" ent))\r
 261                 (total (assoc "total" ent))\r
 262                 (authors (assoc "authors" ent))\r
 263                 (subject (assoc "subject" ent))\r
 264                 (tag-list (assoc "tags" ent)))\r
 265             t))))))\r
 266 \r
 267 (byte-compile 'time-json)\r
 268 (byte-compile 'time-json-string-keys)\r
 269 ;; (make-json)\r
 270 ;; (time-json)\r
 271 ;; (time-json-string-keys)\r
 272 ;; (load-custom-json)\r
 273 \r
 274 ;; S-expression\r
 275 \r
 276 (defun make-sexp ()\r
 277   (with-current-buffer (get-buffer-create "sexp")\r
 278     (erase-buffer))\r
 279   (print\r
 280    (with-current-buffer "json"\r
 281      (let ((json-array-type 'list)\r
 282            (json-object-type 'alist)\r
 283            (json-key-type 'symbol))\r
 284        (goto-char (point-min))\r
 285        (json-read)))\r
 286    (get-buffer "sexp"))\r
 287   t)\r
 288 \r
 289 (defun time-sexp ()\r
 290   (with-current-buffer "sexp"\r
 291     (let ((buf (current-buffer)))\r
 292       (time-it 10 (goto-char (point-min)) (read buf)))))\r
 293 \r
 294 (byte-compile 'time-sexp)\r
 295 ;; (make-sexp)\r
 296 ;; (time-sexp)\r
 297 \r
 298 ;; Packed JSON\r
 299 \r
 300 (defun make-packed-json ()\r
 301   (let ((buf (get-buffer-create "packed-json")))\r
 302     (with-current-buffer "json"\r
 303       (copy-to-buffer buf (point-min) (point-max)))\r
 304     (with-current-buffer buf\r
 305       (while (re-search-forward "^\\([^\"]*\"[^\"]+\"\\): \\([[\"0-9]\\)" nil t)\r
 306         (replace-match "\\1:\\2" nil nil))\r
 307       (goto-char (point-min))\r
 308       (while (re-search-forward "\\([\"0-9]\\),\n" nil t)\r
 309         (replace-match "\\1," nil nil)))))\r
 310 \r
 311 (defun time-packed-json ()\r
 312   (time-json "packed-json"))\r
 313 \r
 314 ;; (make-packed-json)\r
 315 ;; (time-packed-json)\r
 316 \r
 317 --/04w6evG8XlLl3ft\r
 318 Content-Type: text/plain; charset=us-ascii\r
 319 Content-Disposition: attachment; filename="json.el"\r
 320 \r
 321 ;;; json.el --- JavaScript Object Notation parser / generator\r
 322 \r
 323 ;; Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.\r
 324 \r
 325 ;; Author: Edward O'Connor <ted@oconnor.cx>\r
 326 ;; Version: 1.2\r
 327 ;; Keywords: convenience\r
 328 \r
 329 ;; This file is part of GNU Emacs.\r
 330 \r
 331 ;; GNU Emacs is free software: you can redistribute it and/or modify\r
 332 ;; it under the terms of the GNU General Public License as published by\r
 333 ;; the Free Software Foundation, either version 3 of the License, or\r
 334 ;; (at your option) any later version.\r
 335 \r
 336 ;; GNU Emacs is distributed in the hope that it will be useful,\r
 337 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of\r
 338 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\r
 339 ;; GNU General Public License for more details.\r
 340 \r
 341 ;; You should have received a copy of the GNU General Public License\r
 342 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.\r
 343 \r
 344 ;;; Commentary:\r
 345 \r
 346 ;; This is a library for parsing and generating JSON (JavaScript Object\r
 347 ;; Notation).\r
 348 \r
 349 ;; Learn all about JSON here: <URL:http://json.org/>.\r
 350 \r
 351 ;; The user-serviceable entry points for the parser are the functions\r
 352 ;; `json-read' and `json-read-from-string'. The encoder has a single\r
 353 ;; entry point, `json-encode'.\r
 354 \r
 355 ;; Since there are several natural representations of key-value pair\r
 356 ;; mappings in elisp (alist, plist, hash-table), `json-read' allows you\r
 357 ;; to specify which you'd prefer (see `json-object-type' and\r
 358 ;; `json-array-type').\r
 359 \r
 360 ;; Similarly, since `false' and `null' are distinct in JSON, you can\r
 361 ;; distinguish them by binding `json-false' and `json-null' as desired.\r
 362 \r
 363 ;;; History:\r
 364 \r
 365 ;; 2011-07-20 - Optimized by Austin Clements <aclements@csail.mit.edu>.\r
 366 ;; 2006-03-11 - Initial version.\r
 367 ;; 2006-03-13 - Added JSON generation in addition to parsing. Various\r
 368 ;;              other cleanups, bugfixes, and improvements.\r
 369 ;; 2006-12-29 - XEmacs support, from Aidan Kehoe <kehoea@parhasard.net>.\r
 370 ;; 2008-02-21 - Installed in GNU Emacs.\r
 371 \r
 372 ;;; Code:\r
 373 \r
 374 (eval-when-compile (require 'cl))\r
 375 \r
 376 ;; Compatibility code\r
 377 \r
 378 (defalias 'json-encode-char0 'encode-char)\r
 379 (defalias 'json-decode-char0 'decode-char)\r
 380 \r
 381 \r
 382 ;; Parameters\r
 383 \r
 384 (defvar json-object-type 'alist\r
 385   "Type to convert JSON objects to.\r
 386 Must be one of `alist', `plist', or `hash-table'.  Consider let-binding\r
 387 this around your call to `json-read' instead of `setq'ing it.")\r
 388 \r
 389 (defvar json-array-type 'vector\r
 390   "Type to convert JSON arrays to.\r
 391 Must be one of `vector' or `list'.  Consider let-binding this around\r
 392 your call to `json-read' instead of `setq'ing it.")\r
 393 \r
 394 (defvar json-key-type nil\r
 395   "Type to convert JSON keys to.\r
 396 Must be one of `string', `symbol', `keyword', or nil.\r
 397 \r
 398 If nil, `json-read' will guess the type based on the value of\r
 399 `json-object-type':\r
 400 \r
 401     If `json-object-type' is:   nil will be interpreted as:\r
 402       `hash-table'                `string'\r
 403       `alist'                     `symbol'\r
 404       `plist'                     `keyword'\r
 405 \r
 406 Note that values other than `string' might behave strangely for\r
 407 Sufficiently Weird keys.  Consider let-binding this around your call to\r
 408 `json-read' instead of `setq'ing it.")\r
 409 \r
 410 (defvar json-false :json-false\r
 411   "Value to use when reading JSON `false'.\r
 412 If this has the same value as `json-null', you might not be able to tell\r
 413 the difference between `false' and `null'.  Consider let-binding this\r
 414 around your call to `json-read' instead of `setq'ing it.")\r
 415 \r
 416 (defvar json-null nil\r
 417   "Value to use when reading JSON `null'.\r
 418 If this has the same value as `json-false', you might not be able to\r
 419 tell the difference between `false' and `null'.  Consider let-binding\r
 420 this around your call to `json-read' instead of `setq'ing it.")\r
 421 \r
 422 \f\r
 423 \r
 424 \r
 425 ;;; Utilities\r
 426 \r
 427 (defun json-join (strings separator)\r
 428   "Join STRINGS with SEPARATOR."\r
 429   (mapconcat 'identity strings separator))\r
 430 \r
 431 (defun json-alist-p (list)\r
 432   "Non-null if and only if LIST is an alist."\r
 433   (or (null list)\r
 434       (and (consp (car list))\r
 435            (json-alist-p (cdr list)))))\r
 436 \r
 437 (defun json-plist-p (list)\r
 438   "Non-null if and only if LIST is a plist."\r
 439   (or (null list)\r
 440       (and (keywordp (car list))\r
 441            (consp (cdr list))\r
 442            (json-plist-p (cddr list)))))\r
 443 \r
 444 ;; Reader utilities\r
 445 \r
 446 ;; (defsubst json-advance (&optional n)\r
 447 ;;   "Skip past the following N characters."\r
 448 ;;   (forward-char n))\r
 449 \r
 450 (defalias 'json-advance 'forward-char)\r
 451 \r
 452 ;; (defsubst json-peek ()\r
 453 ;;   "Return the character at point."\r
 454 ;;   (let ((char (char-after (point))))\r
 455 ;;     (or char :json-eof)))\r
 456 \r
 457 (defsubst json-peek ()\r
 458   "Return the character at point."\r
 459   (or (char-after) :json-eof))\r
 460 \r
 461 (defsubst json-pop ()\r
 462   "Advance past the character at point, returning it."\r
 463   (let ((char (json-peek)))\r
 464     (if (eq char :json-eof)\r
 465         (signal 'end-of-file nil)\r
 466       (json-advance)\r
 467       char)))\r
 468 \r
 469 ;; (defun json-skip-whitespace ()\r
 470 ;;   "Skip past the whitespace at point."\r
 471 ;;   (skip-chars-forward "\t\r\n\f\b "))\r
 472 \r
 473 (defsubst json-skip-whitespace ()\r
 474   "Skip past the whitespace at point."\r
 475   (skip-chars-forward "\t\r\n\f\b "))\r
 476 \r
 477 \f\r
 478 \r
 479 \r
 480 ;; Error conditions\r
 481 \r
 482 (put 'json-error 'error-message "Unknown JSON error")\r
 483 (put 'json-error 'error-conditions '(json-error error))\r
 484 \r
 485 (put 'json-readtable-error 'error-message "JSON readtable error")\r
 486 (put 'json-readtable-error 'error-conditions\r
 487      '(json-readtable-error json-error error))\r
 488 \r
 489 (put 'json-unknown-keyword 'error-message "Unrecognized keyword")\r
 490 (put 'json-unknown-keyword 'error-conditions\r
 491      '(json-unknown-keyword json-error error))\r
 492 \r
 493 (put 'json-number-format 'error-message "Invalid number format")\r
 494 (put 'json-number-format 'error-conditions\r
 495      '(json-number-format json-error error))\r
 496 \r
 497 (put 'json-string-escape 'error-message "Bad unicode escape")\r
 498 (put 'json-string-escape 'error-conditions\r
 499      '(json-string-escape json-error error))\r
 500 \r
 501 (put 'json-string-format 'error-message "Bad string format")\r
 502 (put 'json-string-format 'error-conditions\r
 503      '(json-string-format json-error error))\r
 504 \r
 505 (put 'json-object-format 'error-message "Bad JSON object")\r
 506 (put 'json-object-format 'error-conditions\r
 507      '(json-object-format json-error error))\r
 508 \r
 509 \f\r
 510 \r
 511 \r
 512 ;;; Keywords\r
 513 \r
 514 (defvar json-keywords '("true" "false" "null")\r
 515   "List of JSON keywords.")\r
 516 \r
 517 ;; Keyword parsing\r
 518 \r
 519 (defun json-read-keyword (keyword)\r
 520   "Read a JSON keyword at point.\r
 521 KEYWORD is the keyword expected."\r
 522   (unless (member keyword json-keywords)\r
 523     (signal 'json-unknown-keyword (list keyword)))\r
 524   (mapc (lambda (char)\r
 525           (unless (char-equal char (json-peek))\r
 526             (signal 'json-unknown-keyword\r
 527                     (list (save-excursion\r
 528                             (backward-word 1)\r
 529                             (thing-at-point 'word)))))\r
 530           (json-advance))\r
 531         keyword)\r
 532   (unless (looking-at "\\(\\s-\\|[],}]\\|$\\)")\r
 533     (signal 'json-unknown-keyword\r
 534             (list (save-excursion\r
 535                     (backward-word 1)\r
 536                     (thing-at-point 'word)))))\r
 537   (cond ((string-equal keyword "true") t)\r
 538         ((string-equal keyword "false") json-false)\r
 539         ((string-equal keyword "null") json-null)))\r
 540 \r
 541 ;; Keyword encoding\r
 542 \r
 543 (defun json-encode-keyword (keyword)\r
 544   "Encode KEYWORD as a JSON value."\r
 545   (cond ((eq keyword t)          "true")\r
 546         ((eq keyword json-false) "false")\r
 547         ((eq keyword json-null)  "null")))\r
 548 \r
 549 ;;; Numbers\r
 550 \r
 551 ;; Number parsing\r
 552 \r
 553 ;; (defun json-read-number (&optional sign)\r
 554 ;;  "Read the JSON number following point.\r
 555 ;; The optional SIGN argument is for internal use.\r
 556 \r
 557 ;; N.B.: Only numbers which can fit in Emacs Lisp's native number\r
 558 ;; representation will be parsed correctly."\r
 559 ;;  ;; If SIGN is non-nil, the number is explicitly signed.\r
 560 ;;  (let ((number-regexp\r
 561 ;;         "\\([0-9]+\\)?\\(\\.[0-9]+\\)?\\([Ee][+-]?[0-9]+\\)?"))\r
 562 ;;    (cond ((and (null sign) (char-equal (json-peek) ?-))\r
 563 ;;           (json-advance)\r
 564 ;;           (- (json-read-number t)))\r
 565 ;;          ((and (null sign) (char-equal (json-peek) ?+))\r
 566 ;;           (json-advance)\r
 567 ;;           (json-read-number t))\r
 568 ;;          ((and (looking-at number-regexp)\r
 569 ;;                (or (match-beginning 1)\r
 570 ;;                    (match-beginning 2)))\r
 571 ;;           (goto-char (match-end 0))\r
 572 ;;           (string-to-number (match-string 0)))\r
 573 ;;          (t (signal 'json-number-format (list (point)))))))\r
 574 \r
 575 (defun json-read-number ()\r
 576  "Read the JSON number following point.\r
 577 \r
 578 N.B.: Only numbers which can fit in Emacs Lisp's native number\r
 579 representation will be parsed correctly."\r
 580  ;; This regexp requires one character of backtrack in the common case\r
 581  ;; of a whole number, but is slightly faster than a more explicit\r
 582  ;; regexp like "\\([0-9]+\\)?\\(\\.[0-9]+\\)?"\r
 583  (if (looking-at "[-+]?[0-9]*[.0-9][0-9]*\\([Ee][+-]?[0-9]+\\)?")\r
 584      (progn\r
 585        (goto-char (match-end 0))\r
 586        (string-to-number (match-string 0)))\r
 587    (signal 'json-number-format (list (point)))))\r
 588 \r
 589 ;; Number encoding\r
 590 \r
 591 (defun json-encode-number (number)\r
 592   "Return a JSON representation of NUMBER."\r
 593   (format "%s" number))\r
 594 \r
 595 ;;; Strings\r
 596 \r
 597 (defvar json-special-chars\r
 598   '((?\" . ?\")\r
 599     (?\\ . ?\\)\r
 600     (?/ . ?/)\r
 601     (?b . ?\b)\r
 602     (?f . ?\f)\r
 603     (?n . ?\n)\r
 604     (?r . ?\r)\r
 605     (?t . ?\t))\r
 606   "Characters which are escaped in JSON, with their elisp counterparts.")\r
 607 \r
 608 ;; String parsing\r
 609 \r
 610 (defun json-read-escaped-char ()\r
 611   "Read the JSON string escaped character at point."\r
 612   ;; Skip over the '\'\r
 613   (json-advance)\r
 614   (let* ((char (json-pop))\r
 615          (special (assq char json-special-chars)))\r
 616     (cond\r
 617      (special (cdr special))\r
 618      ((not (eq char ?u)) char)\r
 619      ((looking-at "[0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f]")\r
 620       (let ((hex (match-string 0)))\r
 621         (json-advance 4)\r
 622         (json-decode-char0 'ucs (string-to-number hex 16))))\r
 623      (t\r
 624       (signal 'json-string-escape (list (point)))))))\r
 625 \r
 626 ;; (defun json-read-string ()\r
 627 ;;   "Read the JSON string at point."\r
 628 ;;   (unless (char-equal (json-peek) ?\")\r
 629 ;;     (signal 'json-string-format (list "doesn't start with '\"'!")))\r
 630 ;;   ;; Skip over the '"'\r
 631 ;;   (json-advance)\r
 632 ;;   (let ((characters '())\r
 633 ;;         (char (json-peek)))\r
 634 ;;     (while (not (char-equal char ?\"))\r
 635 ;;       (push (if (char-equal char ?\\)\r
 636 ;;                 (json-read-escaped-char)\r
 637 ;;               (json-pop))\r
 638 ;;             characters)\r
 639 ;;       (setq char (json-peek)))\r
 640 ;;     ;; Skip over the '"'\r
 641 ;;     (json-advance)\r
 642 ;;     (if characters\r
 643 ;;         (apply 'string (nreverse characters))\r
 644 ;;       "")))\r
 645 \r
 646 ;; Really matters\r
 647 (defun json-read-string ()\r
 648   "Read the JSON string at point."\r
 649 ;;  (unless (char-equal (json-peek) ?\")\r
 650 ;;    (signal 'json-string-format (list "doesn't start with '\"'!")))\r
 651   ;; Skip over the '"'\r
 652   (json-advance)\r
 653   (let ((parts '()) (more t))\r
 654     (while more\r
 655       (let ((start (point)))\r
 656         (when (> (skip-chars-forward "^\\\\\"") 0)\r
 657           (push (buffer-substring-no-properties start (point)) parts)))\r
 658       ;; Helps a little\r
 659       (let ((char (char-after)))\r
 660         (cond ((eq char ?\") (json-advance) (setq more nil))\r
 661               ((eq char ?\\) (push (string (json-read-escaped-char)) parts))\r
 662               (t (error "XXX Unterminated string")))))\r
 663       ;; (let ((char (json-peek)))\r
 664       ;;        (case char\r
 665       ;;          ((?\") (json-advance) (setq done t))\r
 666       ;;          ((?\\) (push (string (json-read-escaped-char)) parts))\r
 667       ;;          (t     (error "XXX Unterminated string")))))\r
 668     (if parts\r
 669         (if (cdr parts)\r
 670             (apply 'concat (nreverse parts))\r
 671           (car parts))\r
 672       "")))\r
 673 \r
 674 ;; String encoding\r
 675 \r
 676 (defun json-encode-char (char)\r
 677   "Encode CHAR as a JSON string."\r
 678   (setq char (json-encode-char0 char 'ucs))\r
 679   (let ((control-char (car (rassoc char json-special-chars))))\r
 680     (cond\r
 681      ;; Special JSON character (\n, \r, etc.)\r
 682      (control-char\r
 683       (format "\\%c" control-char))\r
 684      ;; ASCIIish printable character\r
 685      ((and (> char 31) (< char 161))\r
 686       (format "%c" char))\r
 687      ;; Fallback: UCS code point in \uNNNN form\r
 688      (t\r
 689       (format "\\u%04x" char)))))\r
 690 \r
 691 (defun json-encode-string (string)\r
 692   "Return a JSON representation of STRING."\r
 693   (format "\"%s\"" (mapconcat 'json-encode-char string "")))\r
 694 \r
 695 ;;; JSON Objects\r
 696 \r
 697 (defun json-new-object ()\r
 698   "Create a new Elisp object corresponding to a JSON object.\r
 699 Please see the documentation of `json-object-type'."\r
 700   (cond ((eq json-object-type 'hash-table)\r
 701          (make-hash-table :test 'equal))\r
 702         (t\r
 703          (list))))\r
 704 \r
 705 (defun json-add-to-object (object key value)\r
 706   "Add a new KEY -> VALUE association to OBJECT.\r
 707 Returns the updated object, which you should save, e.g.:\r
 708     (setq obj (json-add-to-object obj \"foo\" \"bar\"))\r
 709 Please see the documentation of `json-object-type' and `json-key-type'."\r
 710   (let ((json-key-type\r
 711          (if (eq json-key-type nil)\r
 712              (cdr (assq json-object-type '((hash-table . string)\r
 713                                            (alist . symbol)\r
 714                                            (plist . keyword))))\r
 715            json-key-type)))\r
 716     (setq key\r
 717           (cond ((eq json-key-type 'string)\r
 718                  key)\r
 719                 ((eq json-key-type 'symbol)\r
 720                  (intern key))\r
 721                 ((eq json-key-type 'keyword)\r
 722                  (intern (concat ":" key)))))\r
 723     (cond ((eq json-object-type 'hash-table)\r
 724            (puthash key value object)\r
 725            object)\r
 726           ((eq json-object-type 'alist)\r
 727            (cons (cons key value) object))\r
 728           ((eq json-object-type 'plist)\r
 729            (cons key (cons value object))))))\r
 730 \r
 731 ;; JSON object parsing\r
 732 \r
 733 ;; (defun json-read-object ()\r
 734 ;;   "Read the JSON object at point."\r
 735 ;;   ;; Skip over the "{"\r
 736 ;;   (json-advance)\r
 737 ;;   (json-skip-whitespace)\r
 738 ;;   ;; read key/value pairs until "}"\r
 739 ;;   (let ((elements (json-new-object))\r
 740 ;;         key value)\r
 741 ;;     (while (not (char-equal (json-peek) ?}))\r
 742 ;;       (json-skip-whitespace)\r
 743 ;;       (setq key (json-read-string))\r
 744 ;;       (json-skip-whitespace)\r
 745 ;;       (if (char-equal (json-peek) ?:)\r
 746 ;;           (json-advance)\r
 747 ;;         (signal 'json-object-format (list ":" (json-peek))))\r
 748 ;;       (setq value (json-read))\r
 749 ;;       (setq elements (json-add-to-object elements key value))\r
 750 ;;       (json-skip-whitespace)\r
 751 ;;       (unless (char-equal (json-peek) ?})\r
 752 ;;         (if (char-equal (json-peek) ?,)\r
 753 ;;             (json-advance)\r
 754 ;;           (signal 'json-object-format (list "," (json-peek))))))\r
 755 ;;     ;; Skip over the "}"\r
 756 ;;     (json-advance)\r
 757 ;;     elements))\r
 758 \r
 759 \r
 760 (defun json-read-object ()\r
 761   "Read the JSON object at point."\r
 762   ;; Skip over the "{"\r
 763   (json-advance)\r
 764   (json-skip-whitespace)\r
 765   ;; read key/value pairs until "}"\r
 766   (let ((elements (json-new-object))\r
 767         key value (more t))\r
 768     (unless (eq (char-after) ?})\r
 769 ;;    (while (not (eq (char-after) ?}))\r
 770       (while more\r
 771         (unless (eq (char-after) ?\")\r
 772           (json-skip-whitespace)\r
 773           (unless (eq (char-after) ?\")\r
 774             (signal 'json-string-format (list "doesn't start with '\"'!"))))\r
 775       (setq key (json-read-string))\r
 776       ;; Makes a small but surprising difference, adds up if done\r
 777       ;; consistently\r
 778       (if (eq (char-after) ?:)\r
 779           (json-advance)\r
 780         (if (progn (json-skip-whitespace) (eq (char-after) ?:))\r
 781             (json-advance)\r
 782           (signal 'json-object-format (list ":" (json-peek)))))\r
 783       (setq value (json-read))\r
 784       (setq elements (json-add-to-object elements key value))\r
 785       ;; Order matters a little\r
 786       (cond ((eq (char-after) ?,) (json-advance))\r
 787             ((eq (char-after) ?}) (setq more nil))\r
 788             ((progn\r
 789                (json-skip-whitespace)\r
 790                (eq (char-after) ?,)) (json-advance))\r
 791             ((eq (char-after) ?}) (setq more nil))\r
 792             (t (signal 'json-object-format (list "," (json-peek)))))))\r
 793       ;; (unless (char-equal (json-peek) ?})\r
 794       ;;   (if (char-equal (json-peek) ?,)\r
 795       ;;       (json-advance)\r
 796       ;;     (signal 'json-object-format (list "," (json-peek))))))\r
 797     ;; Skip over the "}"\r
 798     (json-advance)\r
 799     elements))\r
 800 \r
 801 ;; Hash table encoding\r
 802 \r
 803 (defun json-encode-hash-table (hash-table)\r
 804   "Return a JSON representation of HASH-TABLE."\r
 805   (format "{%s}"\r
 806           (json-join\r
 807            (let (r)\r
 808              (maphash\r
 809               (lambda (k v)\r
 810                 (push (format "%s:%s"\r
 811                               (json-encode k)\r
 812                               (json-encode v))\r
 813                       r))\r
 814               hash-table)\r
 815              r)\r
 816            ", ")))\r
 817 \r
 818 ;; List encoding (including alists and plists)\r
 819 \r
 820 (defun json-encode-alist (alist)\r
 821   "Return a JSON representation of ALIST."\r
 822   (format "{%s}"\r
 823           (json-join (mapcar (lambda (cons)\r
 824                                (format "%s:%s"\r
 825                                        (json-encode (car cons))\r
 826                                        (json-encode (cdr cons))))\r
 827                              alist)\r
 828                      ", ")))\r
 829 \r
 830 (defun json-encode-plist (plist)\r
 831   "Return a JSON representation of PLIST."\r
 832   (let (result)\r
 833     (while plist\r
 834       (push (concat (json-encode (car plist))\r
 835                     ":"\r
 836                     (json-encode (cadr plist)))\r
 837             result)\r
 838       (setq plist (cddr plist)))\r
 839     (concat "{" (json-join (nreverse result) ", ") "}")))\r
 840 \r
 841 (defun json-encode-list (list)\r
 842   "Return a JSON representation of LIST.\r
 843 Tries to DWIM: simple lists become JSON arrays, while alists and plists\r
 844 become JSON objects."\r
 845   (cond ((null list)         "null")\r
 846         ((json-alist-p list) (json-encode-alist list))\r
 847         ((json-plist-p list) (json-encode-plist list))\r
 848         ((listp list)        (json-encode-array list))\r
 849         (t\r
 850          (signal 'json-error (list list)))))\r
 851 \r
 852 ;;; Arrays\r
 853 \r
 854 ;; Array parsing\r
 855 \r
 856 ;; (defun json-read-array ()\r
 857 ;;   "Read the JSON array at point."\r
 858 ;;   ;; Skip over the "["\r
 859 ;;   (json-advance)\r
 860 ;;   (json-skip-whitespace)\r
 861 ;;   ;; read values until "]"\r
 862 ;;   (let (elements)\r
 863 ;;     (while (not (char-equal (json-peek) ?\]))\r
 864 ;;       (push (json-read) elements)\r
 865 ;;       (json-skip-whitespace)\r
 866 ;;       (unless (char-equal (json-peek) ?\])\r
 867 ;;         (if (char-equal (json-peek) ?,)\r
 868 ;;             (json-advance)\r
 869 ;;           (signal 'json-error (list 'bleah)))))\r
 870 ;;     ;; Skip over the "]"\r
 871 ;;     (json-advance)\r
 872 ;;     (apply json-array-type (nreverse elements))))\r
 873 \r
 874 (defun json-read-array ()\r
 875   "Read the JSON array at point."\r
 876   ;; Skip over the "["\r
 877   (json-advance)\r
 878   (json-skip-whitespace)\r
 879   ;; read values until "]"\r
 880   (let* (elements (more t))\r
 881     (unless (eq (char-after) ?\])\r
 882       (while more\r
 883 ;;    (while (not (char-equal (json-peek) ?\]))\r
 884       (push (json-read) elements)\r
 885       ;; Doesn't help\r
 886 ;;      (setq tail (setcdr tail (cons (json-read) nil)))\r
 887 \r
 888 ;;      (json-skip-whitespace)\r
 889       (cond ((eq (char-after) ?,) (json-advance))\r
 890             ((eq (char-after) ?\]) (setq more nil))\r
 891             ((progn\r
 892                (json-skip-whitespace)\r
 893                (eq (char-after) ?,)) (json-advance))\r
 894             ((eq (char-after) ?\]) (setq more nil))\r
 895             (t (signal 'json-error (list 'bleah))))))\r
 896       ;; (unless (char-equal (json-peek) ?\])\r
 897       ;;   (if (char-equal (json-peek) ?,)\r
 898       ;;       (json-advance)\r
 899       ;;     (signal 'json-error (list 'bleah))))))\r
 900     ;; Skip over the "]"\r
 901     (json-advance)\r
 902     ;; Matters\r
 903     (if (eq json-array-type 'list)\r
 904         (nreverse elements)\r
 905       (apply json-array-type (nreverse elements)))))\r
 906 \r
 907 ;; Array encoding\r
 908 \r
 909 (defun json-encode-array (array)\r
 910   "Return a JSON representation of ARRAY."\r
 911   (concat "[" (mapconcat 'json-encode array ", ") "]"))\r
 912 \r
 913 \f\r
 914 \r
 915 \r
 916 ;;; JSON reader.\r
 917 \r
 918 ;; (defvar json-readtable\r
 919 ;;   (let ((table\r
 920 ;;          '((?t json-read-keyword "true")\r
 921 ;;            (?f json-read-keyword "false")\r
 922 ;;            (?n json-read-keyword "null")\r
 923 ;;            (?{ json-read-object)\r
 924 ;;            (?\[ json-read-array)\r
 925 ;;            (?\" json-read-string))))\r
 926 ;;     (mapc (lambda (char)\r
 927 ;;             (push (list char 'json-read-number) table))\r
 928 ;;           '(?- ?+ ?. ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))\r
 929 ;;     table)\r
 930 ;;   "Readtable for JSON reader.")\r
 931 \r
 932 ;; (defun json-read ()\r
 933 ;;   "Parse and return the JSON object following point.\r
 934 ;; Advances point just past JSON object."\r
 935 ;;   (json-skip-whitespace)\r
 936 ;;   (let ((char (json-peek)))\r
 937 ;;     (if (not (eq char :json-eof))\r
 938 ;;         (let ((record (cdr (assq char json-readtable))))\r
 939 ;;           (if (functionp (car record))\r
 940 ;;               (apply (car record) (cdr record))\r
 941 ;;             (signal 'json-readtable-error record)))\r
 942 ;;       (signal 'end-of-file nil))))\r
 943 \r
 944 (defvar my-json-readtable\r
 945   (let ((table (make-char-table nil)))\r
 946     (aset table ?t '(json-read-keyword "true"))\r
 947     (aset table ?f '(json-read-keyword "false"))\r
 948     (aset table ?n '(json-read-keyword "null"))\r
 949     (aset table ?{ '(json-read-object))\r
 950     (aset table ?\[ '(json-read-array))\r
 951     (aset table ?\" '(json-read-string))\r
 952     (mapc (lambda (char)\r
 953             (aset table char '(json-read-number)))\r
 954           '(?- ?+ ?. ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))\r
 955     table)\r
 956   "Readtable for JSON reader.")\r
 957 \r
 958 ;; Char-table matters a bit; (if (null ..)) matters more\r
 959 ;; (defun json-read ()\r
 960 ;;   "Parse and return the JSON object following point.\r
 961 ;; Advances point just past JSON object."\r
 962 ;;   (json-skip-whitespace)\r
 963 ;;   (let ((char (json-peek)))\r
 964 ;;     (if (not (eq char :json-eof))\r
 965 ;;      (let ((record (aref my-json-readtable char)))\r
 966 ;;        (if (null (car record))\r
 967 ;;            (signal 'json-readtable-error record)\r
 968 ;;          (apply (car record) (cdr record))))\r
 969 ;;       (signal 'end-of-file nil))))\r
 970 \r
 971 ;; Makes no difference or slower, probably because there's usually whitespace\r
 972 ;; (defun json-read ()\r
 973 ;;   "Parse and return the JSON object following point.\r
 974 ;; Advances point just past JSON object."\r
 975 ;;   (let ((record (and (char-after) (aref my-json-readtable (char-after)))))\r
 976 ;;     (when (null record)\r
 977 ;;       (json-skip-whitespace)\r
 978 ;;       (when (eobp)\r
 979 ;;      (signal 'end-of-file nil))\r
 980 ;;       (setq record (aref my-json-readtable (char-after)))\r
 981 ;;       (when (null record)\r
 982 ;;      (signal 'json-readtable-error record)))\r
 983 ;;     (apply (car record) (cdr record))))\r
 984 \r
 985 ;; Makes a difference\r
 986 (defun json-read ()\r
 987   "Parse and return the JSON object following point.\r
 988 Advances point just past JSON object."\r
 989   (json-skip-whitespace)\r
 990   (if (char-after)\r
 991       (let ((record (aref my-json-readtable (char-after))))\r
 992         (if record\r
 993             (apply (car record) (cdr record))\r
 994           (signal 'json-readtable-error record)))\r
 995     (signal 'end-of-file nil)))\r
 996 \r
 997 ;; Syntactic sugar for the reader\r
 998 \r
 999 (defun json-read-from-string (string)\r
1000   "Read the JSON object contained in STRING and return it."\r
1001   (with-temp-buffer\r
1002     (insert string)\r
1003     (goto-char (point-min))\r
1004     (json-read)))\r
1005 \r
1006 (defun json-read-file (file)\r
1007   "Read the first JSON object contained in FILE and return it."\r
1008   (with-temp-buffer\r
1009     (insert-file-contents file)\r
1010     (goto-char (point-min))\r
1011     (json-read)))\r
1012 \r
1013 \f\r
1014 \r
1015 \r
1016 ;;; JSON encoder\r
1017 \r
1018 (defun json-encode (object)\r
1019   "Return a JSON representation of OBJECT as a string."\r
1020   (cond ((memq object (list t json-null json-false))\r
1021          (json-encode-keyword object))\r
1022         ((stringp object)      (json-encode-string object))\r
1023         ((keywordp object)     (json-encode-string\r
1024                                 (substring (symbol-name object) 1)))\r
1025         ((symbolp object)      (json-encode-string\r
1026                                 (symbol-name object)))\r
1027         ((numberp object)      (json-encode-number object))\r
1028         ((arrayp object)       (json-encode-array object))\r
1029         ((hash-table-p object) (json-encode-hash-table object))\r
1030         ((listp object)        (json-encode-list object))\r
1031         (t                     (signal 'json-error (list object)))))\r
1032 \r
1033 (provide 'json)\r
1034 \r
1035 ;; arch-tag: 15f6e4c8-b831-4172-8749-bbc680c50ea1\r
1036 ;;; json.el ends here\r
1037 \r
1038 --/04w6evG8XlLl3ft--\r