--- /dev/null
+Return-Path: <amdragon@mit.edu>\r
+X-Original-To: notmuch@notmuchmail.org\r
+Delivered-To: notmuch@notmuchmail.org\r
+Received: from localhost (localhost [127.0.0.1])\r
+ by olra.theworths.org (Postfix) with ESMTP id EE5BF431FD0\r
+ for <notmuch@notmuchmail.org>; Wed, 20 Jul 2011 13:50:24 -0700 (PDT)\r
+X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
+X-Spam-Flag: NO\r
+X-Spam-Score: -0.7\r
+X-Spam-Level: \r
+X-Spam-Status: No, score=-0.7 tagged_above=-999 required=5\r
+ tests=[RCVD_IN_DNSWL_LOW=-0.7] autolearn=disabled\r
+Received: from olra.theworths.org ([127.0.0.1])\r
+ by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)\r
+ with ESMTP id 27QeVyQwmBVx for <notmuch@notmuchmail.org>;\r
+ Wed, 20 Jul 2011 13:50:22 -0700 (PDT)\r
+Received: from dmz-mailsec-scanner-5.mit.edu (DMZ-MAILSEC-SCANNER-5.MIT.EDU\r
+ [18.7.68.34])\r
+ by olra.theworths.org (Postfix) with ESMTP id 8D394431FB6\r
+ for <notmuch@notmuchmail.org>; Wed, 20 Jul 2011 13:50:22 -0700 (PDT)\r
+X-AuditID: 12074422-b7ba7ae000000a14-a6-4e273f7e061b\r
+Received: from mailhub-auth-4.mit.edu ( [18.7.62.39])\r
+ by dmz-mailsec-scanner-5.mit.edu (Symantec Messaging Gateway) with SMTP\r
+ id 1D.A7.02580.E7F372E4; Wed, 20 Jul 2011 16:50:06 -0400 (EDT)\r
+Received: from outgoing.mit.edu (OUTGOING-AUTH.MIT.EDU [18.7.22.103])\r
+ by mailhub-auth-4.mit.edu (8.13.8/8.9.2) with ESMTP id p6KKoLmr011903; \r
+ Wed, 20 Jul 2011 16:50:21 -0400\r
+Received: from awakening.csail.mit.edu (awakening.csail.mit.edu [18.26.4.91])\r
+ (authenticated bits=0)\r
+ (User authenticated as amdragon@ATHENA.MIT.EDU)\r
+ by outgoing.mit.edu (8.13.6/8.12.4) with ESMTP id p6KKoJHH001367\r
+ (version=TLSv1/SSLv3 cipher=AES256-SHA bits=256 verify=NOT);\r
+ Wed, 20 Jul 2011 16:50:20 -0400 (EDT)\r
+Received: from amthrax by awakening.csail.mit.edu with local (Exim 4.72)\r
+ (envelope-from <amdragon@mit.edu>)\r
+ id 1QjdiZ-0007Ee-Tb; Wed, 20 Jul 2011 16:50:07 -0400\r
+Date: Wed, 20 Jul 2011 16:50:07 -0400\r
+From: Austin Clements <amdragon@MIT.EDU>\r
+To: Pieter Praet <pieter@praet.org>\r
+Subject: JSON parsing performance (was Re: [PATCH v2] emacs: bad regexp @\r
+ `notmuch-search-process-filter')\r
+Message-ID: <20110720205007.GB21316@mit.edu>\r
+References: <20110705214234.GA15360@mit.edu>\r
+ <1310416993-31031-1-git-send-email-pieter@praet.org>\r
+ <20110711210532.GC25558@mit.edu> <878vs28dvo.fsf@praet.org>\r
+ <20110713185721.GI25558@mit.edu>\r
+MIME-Version: 1.0\r
+Content-Type: multipart/mixed; boundary="/04w6evG8XlLl3ft"\r
+Content-Disposition: inline\r
+In-Reply-To: <20110713185721.GI25558@mit.edu>\r
+User-Agent: Mutt/1.5.20 (2009-06-14)\r
+X-Brightmail-Tracker:\r
+ H4sIAAAAAAAAA+NgFvrIKsWRmVeSWpSXmKPExsUixG6nrltnr+5ncHmrqsW+O1uYLK7fnMls\r
+ 8fv1DWaLpb92szmweOx6/pfJY+esu+wez1bdYvbo2HeZNYAlissmJTUnsyy1SN8ugStj5u6n\r
+ 7AWr/zBW3G84zdbAuG4PYxcjJ4eEgInExHvv2SFsMYkL99azdTFycQgJ7GOUWLjyMyuEs4FR\r
+ 4uOOT8wQzkkmiaU3DkFlljBKfF67C6yfRUBV4vfJNiYQm01AQ2Lb/uVgO0QElCVOP/kJVMPB\r
+ wSxQKLHkWiVIWFggR6Lh4VdmEJtXQEdiz6t1YLaQwDFGiX1LYiDighInZz5hAbGZBawkfv6Z\r
+ wAgxRlpi+T8OEJNTQFdi6aR4kApRARWJa/vb2SYwCs1C0jwLSfMshGaIsJbEjX8vmXAKg9gW\r
+ Ej9+P2XDFDeW2HZ4LuMCRs5VjLIpuVW6uYmZOcWpybrFyYl5ealFuqZ6uZkleqkppZsYwfHo\r
+ orSD8edBpUOMAhyMSjy8DnzqfkKsiWXFlbmHGCU5mJREeafaAYX4kvJTKjMSizPii0pzUosP\r
+ MUpwMCuJ8Cr+U/MT4k1JrKxKLcqHSUlzsCiJ85Z4//cVEkhPLEnNTk0tSC2CycpwcChJ8IoD\r
+ 046QYFFqempFWmZOCUKaiYMTZDgP0HBtkBre4oLE3OLMdIj8KUZjjvu37x9h5Lj+FEgKseTl\r
+ 56VKifO+ALlRAKQ0ozQPbhospb5iFAd6Tpj3DUgVDzAdw817BbSKCWhVi7oqyKqSRISUVANj\r
+ 4l4bltdqfb++PTWNKGasSf1lweD64LSoZtcaGZ+0moNHrX7bfWbmm+n0N3B5c2ClCLPYH/W3\r
+ J5SClDctN1juzrCkj7Exk9lnf4dKlskdZ/nHbdH/Hkx+4rclyG/RLSVb3y1pO6ojMxWsrV36\r
+ 5mrU8pW/0O7YdK6Gb+fToylbzZ4bxbILzlBiKc5INNRiLipOBACOvzSrhAMAAA==\r
+Cc: servilio <servilio@gmail.com>, Notmuch Mail <notmuch@notmuchmail.org>,\r
+ David Edmondson <dme@dme.org>\r
+X-BeenThere: notmuch@notmuchmail.org\r
+X-Mailman-Version: 2.1.13\r
+Precedence: list\r
+List-Id: "Use and development of the notmuch mail system."\r
+ <notmuch.notmuchmail.org>\r
+List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
+ <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
+List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
+List-Post: <mailto:notmuch@notmuchmail.org>\r
+List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
+List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
+ <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
+X-List-Received-Date: Wed, 20 Jul 2011 20:50:25 -0000\r
+\r
+\r
+--/04w6evG8XlLl3ft\r
+Content-Type: text/plain; charset=us-ascii\r
+Content-Disposition: inline\r
+\r
+Quoth myself on Jul 13 at 2:57 pm:\r
+> Quoth Pieter Praet on Jul 13 at 4:16 pm:\r
+> > Jamie Zawinski once said/wrote [1]:\r
+> > 'Some people, when confronted with a problem, think "I know,\r
+> > I'll use regular expressions." Now they have two problems.'\r
+> > \r
+> > With this in mind, I set out to get rid of this whole regex mess altogether,\r
+> > by populating the search buffer using Notmuch's JSON output instead of doing\r
+> > brittle text matching tricks.\r
+> > \r
+> > Looking for some documentation, I stumbled upon a long-forgotten gem [2].\r
+> > \r
+> > David's already done pretty much all of the work for us!\r
+> \r
+> Yes, similar thoughts were running through my head as I futzed with\r
+> the formatting for this. My concern with moving to JSON for search\r
+> buffers is that parsing it is about *30 times slower* than the current\r
+> regexp-based approach (0.6 seconds versus 0.02 seconds for a mere 1413\r
+> result search buffer). I think JSON makes a lot of sense for show\r
+> buffers because there's generally less data and it has a lot of\r
+> complicated structure. Search results, on the other hand, have a very\r
+> simple, regular, and constrained structure, so JSON doesn't buy us\r
+> nearly as much.\r
+> \r
+> JSON is hard to parse because, like the text search output, it's\r
+> designed for human consumption (of course, unlike the text search\r
+> output, it's also designed for computer consumption). There's\r
+> something to be said for the debuggability and generality of this and\r
+> JSON is very good for exchanging small objects, but it's a remarkably\r
+> inefficient way to exchange large amounts of data between two\r
+> programs.\r
+> \r
+> I guess what I'm getting at, though it pains me to say it, is perhaps\r
+> search needs a fast, computer-readable interchange format. The\r
+> structure of the data is so simple and constrained that this could be\r
+> altogether trivial.\r
+> \r
+> Or maybe I need a faster computer.\r
+\r
+Or maybe I need to un-lame my benchmark.\r
+\r
+TL;DR: We should use JSON for search results, but possibly not the\r
+json.el shipped with Emacs.\r
+\r
+I realized that my text benchmark didn't capture the cost of\r
+extracting the match strings. re-search-forward records matches as\r
+buffer positions, which don't get realized into strings until you call\r
+match-string. Hence, match-string is quite expensive.\r
+\r
+Also, Emacs' json.el is slow, so I perked it up. My modified json.el\r
+is ~3X faster, particularly for string-heavy output like notmuch's.\r
+Though now I'm well into the realm of "eq is faster than =" and "M-x\r
+disassemble", so unless I missed something big, this is as fast as it\r
+gets.\r
+\r
+While I was still thinking about new IPC formats, I realized that the\r
+text format and the Emacs UI are already tightly coupled, so why not\r
+go all the way and use S-expressions for IPC? I now think JSON is\r
+fast enough to use, but S-expressions still have a certain appeal.\r
+They share most of the benefits of JSON; structure and extensibility\r
+in particular. Further, while the content of some ad-hoc format could\r
+easily diverge from both the text and JSON formats, S-expressions\r
+could exactly parallel the JSON content (with a little more\r
+abstraction, they could even share the same format code). For kicks,\r
+I included an S-expression benchmark. It beats out the text parser by\r
+a factor of two and the optimized JSON parser by a factor of three.\r
+\r
+Here are the results for my 1,413 result search buffer and timeworn\r
+computer\r
+\r
+ Time Normalized\r
+--format=text 0.148s 1.00x\r
+--format=json 0.598s 4.04x\r
+custom json.el 0.209s 1.41x\r
+ + string keys 0.195s 1.32x\r
+S-expressions 0.066s 0.45x\r
+\r
+I don't have time right now, but next week I might be able to look\r
+through and update dme's JSON-based search code.\r
+\r
+\r
+The benchmark and modified json.el are attached.\r
+\r
+The benchmark is written so you can open it and eval-buffer, then C-x\r
+C-e the various calls in the comments. You can either\r
+make-text/make-json, or run notmuch manually, pipe the results into\r
+files "text" and "json", and open them in Emacs.\r
+\r
+Please excuse the modified json.el code; it's gone through zero\r
+cleanup.\r
+\r
+--/04w6evG8XlLl3ft\r
+Content-Type: text/plain; charset=us-ascii\r
+Content-Disposition: attachment; filename="timeparse.el"\r
+\r
+(defmacro time-it (repeat &rest body)\r
+ (declare (indent 1))\r
+ (when (not (numberp repeat))\r
+ (push repeat body)\r
+ (setq repeat 1))\r
+ (let ((start-time (gensym)) (i (gensym)))\r
+ `(let ((,start-time (get-internal-run-time)))\r
+ (dotimes (,i ,repeat)\r
+ ,@body)\r
+ (/ (float-time (time-subtract (get-internal-run-time) ,start-time))\r
+ ,repeat))))\r
+\r
+;; Text\r
+\r
+(defun make-text ()\r
+ (with-current-buffer (get-buffer-create "text")\r
+ (erase-buffer)\r
+ (call-process "notmuch" nil t nil "search" "--format=text" "--" "tag:x/notmuch")))\r
+\r
+(defun time-text ()\r
+ (with-current-buffer "text"\r
+ (time-it 10\r
+ (goto-char (point-min))\r
+ (while (re-search-forward "^\\(thread:[0-9A-Fa-f]*\\) \\([^][]*\\) \\(\\[[0-9/]*\\]\\) \\([^;]*\\); \\(.*\\) (\\([^()]*\\))$" nil t)\r
+ (let* ((thread-id (match-string 1))\r
+ (date (match-string 2))\r
+ (count (match-string 3))\r
+ (authors (match-string 4))\r
+ (subject (match-string 5))\r
+ (tags (match-string 6))\r
+ (tag-list (if tags (save-match-data (split-string tags)))))\r
+ t)))))\r
+\r
+(byte-compile 'time-text)\r
+;; (make-text)\r
+;; (time-text)\r
+\r
+;; JSON\r
+\r
+(defun load-custom-json ()\r
+ (byte-compile-file "json.el")\r
+ (load-file "./json.elc"))\r
+\r
+(defun make-json ()\r
+ (with-current-buffer (get-buffer-create "json")\r
+ (erase-buffer)\r
+ (call-process "notmuch" nil t nil "search" "--format=json" "--" "tag:x/notmuch")))\r
+\r
+(defun time-json (&optional buf)\r
+ (with-current-buffer (or buf "json")\r
+ (let ((json-array-type 'list)\r
+ (json-object-type 'alist)\r
+ (json-key-type 'symbol))\r
+ (time-it 10\r
+ (goto-char (point-min))\r
+ (dolist (ent (json-read))\r
+ ;; (Surprisingly, traversing the structure has no noticeable\r
+ ;; impact to performance)\r
+ (let ((thread-id (assq 'thread ent))\r
+ (date (assq 'timestamp ent))\r
+ (matched (assq 'matched ent))\r
+ (total (assq 'total ent))\r
+ (authors (assq 'authors ent))\r
+ (subject (assq 'subject ent))\r
+ (tag-list (assq 'tags ent)))\r
+ t))))))\r
+\r
+(defun time-json-string-keys (&optional buf)\r
+ (with-current-buffer (or buf "json")\r
+ (let ((json-array-type 'list)\r
+ (json-object-type 'alist)\r
+ (json-key-type 'string))\r
+ (time-it 10\r
+ (goto-char (point-min))\r
+ (dolist (ent (json-read))\r
+ (let ((thread-id (assoc "thread" ent))\r
+ (date (assoc "timestamp" ent))\r
+ (matched (assoc "matched" ent))\r
+ (total (assoc "total" ent))\r
+ (authors (assoc "authors" ent))\r
+ (subject (assoc "subject" ent))\r
+ (tag-list (assoc "tags" ent)))\r
+ t))))))\r
+\r
+(byte-compile 'time-json)\r
+(byte-compile 'time-json-string-keys)\r
+;; (make-json)\r
+;; (time-json)\r
+;; (time-json-string-keys)\r
+;; (load-custom-json)\r
+\r
+;; S-expression\r
+\r
+(defun make-sexp ()\r
+ (with-current-buffer (get-buffer-create "sexp")\r
+ (erase-buffer))\r
+ (print\r
+ (with-current-buffer "json"\r
+ (let ((json-array-type 'list)\r
+ (json-object-type 'alist)\r
+ (json-key-type 'symbol))\r
+ (goto-char (point-min))\r
+ (json-read)))\r
+ (get-buffer "sexp"))\r
+ t)\r
+\r
+(defun time-sexp ()\r
+ (with-current-buffer "sexp"\r
+ (let ((buf (current-buffer)))\r
+ (time-it 10 (goto-char (point-min)) (read buf)))))\r
+\r
+(byte-compile 'time-sexp)\r
+;; (make-sexp)\r
+;; (time-sexp)\r
+\r
+;; Packed JSON\r
+\r
+(defun make-packed-json ()\r
+ (let ((buf (get-buffer-create "packed-json")))\r
+ (with-current-buffer "json"\r
+ (copy-to-buffer buf (point-min) (point-max)))\r
+ (with-current-buffer buf\r
+ (while (re-search-forward "^\\([^\"]*\"[^\"]+\"\\): \\([[\"0-9]\\)" nil t)\r
+ (replace-match "\\1:\\2" nil nil))\r
+ (goto-char (point-min))\r
+ (while (re-search-forward "\\([\"0-9]\\),\n" nil t)\r
+ (replace-match "\\1," nil nil)))))\r
+\r
+(defun time-packed-json ()\r
+ (time-json "packed-json"))\r
+\r
+;; (make-packed-json)\r
+;; (time-packed-json)\r
+\r
+--/04w6evG8XlLl3ft\r
+Content-Type: text/plain; charset=us-ascii\r
+Content-Disposition: attachment; filename="json.el"\r
+\r
+;;; json.el --- JavaScript Object Notation parser / generator\r
+\r
+;; Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.\r
+\r
+;; Author: Edward O'Connor <ted@oconnor.cx>\r
+;; Version: 1.2\r
+;; Keywords: convenience\r
+\r
+;; This file is part of GNU Emacs.\r
+\r
+;; GNU Emacs is free software: you can redistribute it and/or modify\r
+;; it under the terms of the GNU General Public License as published by\r
+;; the Free Software Foundation, either version 3 of the License, or\r
+;; (at your option) any later version.\r
+\r
+;; GNU Emacs is distributed in the hope that it will be useful,\r
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of\r
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\r
+;; GNU General Public License for more details.\r
+\r
+;; You should have received a copy of the GNU General Public License\r
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.\r
+\r
+;;; Commentary:\r
+\r
+;; This is a library for parsing and generating JSON (JavaScript Object\r
+;; Notation).\r
+\r
+;; Learn all about JSON here: <URL:http://json.org/>.\r
+\r
+;; The user-serviceable entry points for the parser are the functions\r
+;; `json-read' and `json-read-from-string'. The encoder has a single\r
+;; entry point, `json-encode'.\r
+\r
+;; Since there are several natural representations of key-value pair\r
+;; mappings in elisp (alist, plist, hash-table), `json-read' allows you\r
+;; to specify which you'd prefer (see `json-object-type' and\r
+;; `json-array-type').\r
+\r
+;; Similarly, since `false' and `null' are distinct in JSON, you can\r
+;; distinguish them by binding `json-false' and `json-null' as desired.\r
+\r
+;;; History:\r
+\r
+;; 2011-07-20 - Optimized by Austin Clements <aclements@csail.mit.edu>.\r
+;; 2006-03-11 - Initial version.\r
+;; 2006-03-13 - Added JSON generation in addition to parsing. Various\r
+;; other cleanups, bugfixes, and improvements.\r
+;; 2006-12-29 - XEmacs support, from Aidan Kehoe <kehoea@parhasard.net>.\r
+;; 2008-02-21 - Installed in GNU Emacs.\r
+\r
+;;; Code:\r
+\r
+(eval-when-compile (require 'cl))\r
+\r
+;; Compatibility code\r
+\r
+(defalias 'json-encode-char0 'encode-char)\r
+(defalias 'json-decode-char0 'decode-char)\r
+\r
+\r
+;; Parameters\r
+\r
+(defvar json-object-type 'alist\r
+ "Type to convert JSON objects to.\r
+Must be one of `alist', `plist', or `hash-table'. Consider let-binding\r
+this around your call to `json-read' instead of `setq'ing it.")\r
+\r
+(defvar json-array-type 'vector\r
+ "Type to convert JSON arrays to.\r
+Must be one of `vector' or `list'. Consider let-binding this around\r
+your call to `json-read' instead of `setq'ing it.")\r
+\r
+(defvar json-key-type nil\r
+ "Type to convert JSON keys to.\r
+Must be one of `string', `symbol', `keyword', or nil.\r
+\r
+If nil, `json-read' will guess the type based on the value of\r
+`json-object-type':\r
+\r
+ If `json-object-type' is: nil will be interpreted as:\r
+ `hash-table' `string'\r
+ `alist' `symbol'\r
+ `plist' `keyword'\r
+\r
+Note that values other than `string' might behave strangely for\r
+Sufficiently Weird keys. Consider let-binding this around your call to\r
+`json-read' instead of `setq'ing it.")\r
+\r
+(defvar json-false :json-false\r
+ "Value to use when reading JSON `false'.\r
+If this has the same value as `json-null', you might not be able to tell\r
+the difference between `false' and `null'. Consider let-binding this\r
+around your call to `json-read' instead of `setq'ing it.")\r
+\r
+(defvar json-null nil\r
+ "Value to use when reading JSON `null'.\r
+If this has the same value as `json-false', you might not be able to\r
+tell the difference between `false' and `null'. Consider let-binding\r
+this around your call to `json-read' instead of `setq'ing it.")\r
+\r
+\f\r
+\r
+\r
+;;; Utilities\r
+\r
+(defun json-join (strings separator)\r
+ "Join STRINGS with SEPARATOR."\r
+ (mapconcat 'identity strings separator))\r
+\r
+(defun json-alist-p (list)\r
+ "Non-null if and only if LIST is an alist."\r
+ (or (null list)\r
+ (and (consp (car list))\r
+ (json-alist-p (cdr list)))))\r
+\r
+(defun json-plist-p (list)\r
+ "Non-null if and only if LIST is a plist."\r
+ (or (null list)\r
+ (and (keywordp (car list))\r
+ (consp (cdr list))\r
+ (json-plist-p (cddr list)))))\r
+\r
+;; Reader utilities\r
+\r
+;; (defsubst json-advance (&optional n)\r
+;; "Skip past the following N characters."\r
+;; (forward-char n))\r
+\r
+(defalias 'json-advance 'forward-char)\r
+\r
+;; (defsubst json-peek ()\r
+;; "Return the character at point."\r
+;; (let ((char (char-after (point))))\r
+;; (or char :json-eof)))\r
+\r
+(defsubst json-peek ()\r
+ "Return the character at point."\r
+ (or (char-after) :json-eof))\r
+\r
+(defsubst json-pop ()\r
+ "Advance past the character at point, returning it."\r
+ (let ((char (json-peek)))\r
+ (if (eq char :json-eof)\r
+ (signal 'end-of-file nil)\r
+ (json-advance)\r
+ char)))\r
+\r
+;; (defun json-skip-whitespace ()\r
+;; "Skip past the whitespace at point."\r
+;; (skip-chars-forward "\t\r\n\f\b "))\r
+\r
+(defsubst json-skip-whitespace ()\r
+ "Skip past the whitespace at point."\r
+ (skip-chars-forward "\t\r\n\f\b "))\r
+\r
+\f\r
+\r
+\r
+;; Error conditions\r
+\r
+(put 'json-error 'error-message "Unknown JSON error")\r
+(put 'json-error 'error-conditions '(json-error error))\r
+\r
+(put 'json-readtable-error 'error-message "JSON readtable error")\r
+(put 'json-readtable-error 'error-conditions\r
+ '(json-readtable-error json-error error))\r
+\r
+(put 'json-unknown-keyword 'error-message "Unrecognized keyword")\r
+(put 'json-unknown-keyword 'error-conditions\r
+ '(json-unknown-keyword json-error error))\r
+\r
+(put 'json-number-format 'error-message "Invalid number format")\r
+(put 'json-number-format 'error-conditions\r
+ '(json-number-format json-error error))\r
+\r
+(put 'json-string-escape 'error-message "Bad unicode escape")\r
+(put 'json-string-escape 'error-conditions\r
+ '(json-string-escape json-error error))\r
+\r
+(put 'json-string-format 'error-message "Bad string format")\r
+(put 'json-string-format 'error-conditions\r
+ '(json-string-format json-error error))\r
+\r
+(put 'json-object-format 'error-message "Bad JSON object")\r
+(put 'json-object-format 'error-conditions\r
+ '(json-object-format json-error error))\r
+\r
+\f\r
+\r
+\r
+;;; Keywords\r
+\r
+(defvar json-keywords '("true" "false" "null")\r
+ "List of JSON keywords.")\r
+\r
+;; Keyword parsing\r
+\r
+(defun json-read-keyword (keyword)\r
+ "Read a JSON keyword at point.\r
+KEYWORD is the keyword expected."\r
+ (unless (member keyword json-keywords)\r
+ (signal 'json-unknown-keyword (list keyword)))\r
+ (mapc (lambda (char)\r
+ (unless (char-equal char (json-peek))\r
+ (signal 'json-unknown-keyword\r
+ (list (save-excursion\r
+ (backward-word 1)\r
+ (thing-at-point 'word)))))\r
+ (json-advance))\r
+ keyword)\r
+ (unless (looking-at "\\(\\s-\\|[],}]\\|$\\)")\r
+ (signal 'json-unknown-keyword\r
+ (list (save-excursion\r
+ (backward-word 1)\r
+ (thing-at-point 'word)))))\r
+ (cond ((string-equal keyword "true") t)\r
+ ((string-equal keyword "false") json-false)\r
+ ((string-equal keyword "null") json-null)))\r
+\r
+;; Keyword encoding\r
+\r
+(defun json-encode-keyword (keyword)\r
+ "Encode KEYWORD as a JSON value."\r
+ (cond ((eq keyword t) "true")\r
+ ((eq keyword json-false) "false")\r
+ ((eq keyword json-null) "null")))\r
+\r
+;;; Numbers\r
+\r
+;; Number parsing\r
+\r
+;; (defun json-read-number (&optional sign)\r
+;; "Read the JSON number following point.\r
+;; The optional SIGN argument is for internal use.\r
+\r
+;; N.B.: Only numbers which can fit in Emacs Lisp's native number\r
+;; representation will be parsed correctly."\r
+;; ;; If SIGN is non-nil, the number is explicitly signed.\r
+;; (let ((number-regexp\r
+;; "\\([0-9]+\\)?\\(\\.[0-9]+\\)?\\([Ee][+-]?[0-9]+\\)?"))\r
+;; (cond ((and (null sign) (char-equal (json-peek) ?-))\r
+;; (json-advance)\r
+;; (- (json-read-number t)))\r
+;; ((and (null sign) (char-equal (json-peek) ?+))\r
+;; (json-advance)\r
+;; (json-read-number t))\r
+;; ((and (looking-at number-regexp)\r
+;; (or (match-beginning 1)\r
+;; (match-beginning 2)))\r
+;; (goto-char (match-end 0))\r
+;; (string-to-number (match-string 0)))\r
+;; (t (signal 'json-number-format (list (point)))))))\r
+\r
+(defun json-read-number ()\r
+ "Read the JSON number following point.\r
+\r
+N.B.: Only numbers which can fit in Emacs Lisp's native number\r
+representation will be parsed correctly."\r
+ ;; This regexp requires one character of backtrack in the common case\r
+ ;; of a whole number, but is slightly faster than a more explicit\r
+ ;; regexp like "\\([0-9]+\\)?\\(\\.[0-9]+\\)?"\r
+ (if (looking-at "[-+]?[0-9]*[.0-9][0-9]*\\([Ee][+-]?[0-9]+\\)?")\r
+ (progn\r
+ (goto-char (match-end 0))\r
+ (string-to-number (match-string 0)))\r
+ (signal 'json-number-format (list (point)))))\r
+\r
+;; Number encoding\r
+\r
+(defun json-encode-number (number)\r
+ "Return a JSON representation of NUMBER."\r
+ (format "%s" number))\r
+\r
+;;; Strings\r
+\r
+(defvar json-special-chars\r
+ '((?\" . ?\")\r
+ (?\\ . ?\\)\r
+ (?/ . ?/)\r
+ (?b . ?\b)\r
+ (?f . ?\f)\r
+ (?n . ?\n)\r
+ (?r . ?\r)\r
+ (?t . ?\t))\r
+ "Characters which are escaped in JSON, with their elisp counterparts.")\r
+\r
+;; String parsing\r
+\r
+(defun json-read-escaped-char ()\r
+ "Read the JSON string escaped character at point."\r
+ ;; Skip over the '\'\r
+ (json-advance)\r
+ (let* ((char (json-pop))\r
+ (special (assq char json-special-chars)))\r
+ (cond\r
+ (special (cdr special))\r
+ ((not (eq char ?u)) char)\r
+ ((looking-at "[0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f]")\r
+ (let ((hex (match-string 0)))\r
+ (json-advance 4)\r
+ (json-decode-char0 'ucs (string-to-number hex 16))))\r
+ (t\r
+ (signal 'json-string-escape (list (point)))))))\r
+\r
+;; (defun json-read-string ()\r
+;; "Read the JSON string at point."\r
+;; (unless (char-equal (json-peek) ?\")\r
+;; (signal 'json-string-format (list "doesn't start with '\"'!")))\r
+;; ;; Skip over the '"'\r
+;; (json-advance)\r
+;; (let ((characters '())\r
+;; (char (json-peek)))\r
+;; (while (not (char-equal char ?\"))\r
+;; (push (if (char-equal char ?\\)\r
+;; (json-read-escaped-char)\r
+;; (json-pop))\r
+;; characters)\r
+;; (setq char (json-peek)))\r
+;; ;; Skip over the '"'\r
+;; (json-advance)\r
+;; (if characters\r
+;; (apply 'string (nreverse characters))\r
+;; "")))\r
+\r
+;; Really matters\r
+(defun json-read-string ()\r
+ "Read the JSON string at point."\r
+;; (unless (char-equal (json-peek) ?\")\r
+;; (signal 'json-string-format (list "doesn't start with '\"'!")))\r
+ ;; Skip over the '"'\r
+ (json-advance)\r
+ (let ((parts '()) (more t))\r
+ (while more\r
+ (let ((start (point)))\r
+ (when (> (skip-chars-forward "^\\\\\"") 0)\r
+ (push (buffer-substring-no-properties start (point)) parts)))\r
+ ;; Helps a little\r
+ (let ((char (char-after)))\r
+ (cond ((eq char ?\") (json-advance) (setq more nil))\r
+ ((eq char ?\\) (push (string (json-read-escaped-char)) parts))\r
+ (t (error "XXX Unterminated string")))))\r
+ ;; (let ((char (json-peek)))\r
+ ;; (case char\r
+ ;; ((?\") (json-advance) (setq done t))\r
+ ;; ((?\\) (push (string (json-read-escaped-char)) parts))\r
+ ;; (t (error "XXX Unterminated string")))))\r
+ (if parts\r
+ (if (cdr parts)\r
+ (apply 'concat (nreverse parts))\r
+ (car parts))\r
+ "")))\r
+\r
+;; String encoding\r
+\r
+(defun json-encode-char (char)\r
+ "Encode CHAR as a JSON string."\r
+ (setq char (json-encode-char0 char 'ucs))\r
+ (let ((control-char (car (rassoc char json-special-chars))))\r
+ (cond\r
+ ;; Special JSON character (\n, \r, etc.)\r
+ (control-char\r
+ (format "\\%c" control-char))\r
+ ;; ASCIIish printable character\r
+ ((and (> char 31) (< char 161))\r
+ (format "%c" char))\r
+ ;; Fallback: UCS code point in \uNNNN form\r
+ (t\r
+ (format "\\u%04x" char)))))\r
+\r
+(defun json-encode-string (string)\r
+ "Return a JSON representation of STRING."\r
+ (format "\"%s\"" (mapconcat 'json-encode-char string "")))\r
+\r
+;;; JSON Objects\r
+\r
+(defun json-new-object ()\r
+ "Create a new Elisp object corresponding to a JSON object.\r
+Please see the documentation of `json-object-type'."\r
+ (cond ((eq json-object-type 'hash-table)\r
+ (make-hash-table :test 'equal))\r
+ (t\r
+ (list))))\r
+\r
+(defun json-add-to-object (object key value)\r
+ "Add a new KEY -> VALUE association to OBJECT.\r
+Returns the updated object, which you should save, e.g.:\r
+ (setq obj (json-add-to-object obj \"foo\" \"bar\"))\r
+Please see the documentation of `json-object-type' and `json-key-type'."\r
+ (let ((json-key-type\r
+ (if (eq json-key-type nil)\r
+ (cdr (assq json-object-type '((hash-table . string)\r
+ (alist . symbol)\r
+ (plist . keyword))))\r
+ json-key-type)))\r
+ (setq key\r
+ (cond ((eq json-key-type 'string)\r
+ key)\r
+ ((eq json-key-type 'symbol)\r
+ (intern key))\r
+ ((eq json-key-type 'keyword)\r
+ (intern (concat ":" key)))))\r
+ (cond ((eq json-object-type 'hash-table)\r
+ (puthash key value object)\r
+ object)\r
+ ((eq json-object-type 'alist)\r
+ (cons (cons key value) object))\r
+ ((eq json-object-type 'plist)\r
+ (cons key (cons value object))))))\r
+\r
+;; JSON object parsing\r
+\r
+;; (defun json-read-object ()\r
+;; "Read the JSON object at point."\r
+;; ;; Skip over the "{"\r
+;; (json-advance)\r
+;; (json-skip-whitespace)\r
+;; ;; read key/value pairs until "}"\r
+;; (let ((elements (json-new-object))\r
+;; key value)\r
+;; (while (not (char-equal (json-peek) ?}))\r
+;; (json-skip-whitespace)\r
+;; (setq key (json-read-string))\r
+;; (json-skip-whitespace)\r
+;; (if (char-equal (json-peek) ?:)\r
+;; (json-advance)\r
+;; (signal 'json-object-format (list ":" (json-peek))))\r
+;; (setq value (json-read))\r
+;; (setq elements (json-add-to-object elements key value))\r
+;; (json-skip-whitespace)\r
+;; (unless (char-equal (json-peek) ?})\r
+;; (if (char-equal (json-peek) ?,)\r
+;; (json-advance)\r
+;; (signal 'json-object-format (list "," (json-peek))))))\r
+;; ;; Skip over the "}"\r
+;; (json-advance)\r
+;; elements))\r
+\r
+\r
+(defun json-read-object ()\r
+ "Read the JSON object at point."\r
+ ;; Skip over the "{"\r
+ (json-advance)\r
+ (json-skip-whitespace)\r
+ ;; read key/value pairs until "}"\r
+ (let ((elements (json-new-object))\r
+ key value (more t))\r
+ (unless (eq (char-after) ?})\r
+;; (while (not (eq (char-after) ?}))\r
+ (while more\r
+ (unless (eq (char-after) ?\")\r
+ (json-skip-whitespace)\r
+ (unless (eq (char-after) ?\")\r
+ (signal 'json-string-format (list "doesn't start with '\"'!"))))\r
+ (setq key (json-read-string))\r
+ ;; Makes a small but surprising difference, adds up if done\r
+ ;; consistently\r
+ (if (eq (char-after) ?:)\r
+ (json-advance)\r
+ (if (progn (json-skip-whitespace) (eq (char-after) ?:))\r
+ (json-advance)\r
+ (signal 'json-object-format (list ":" (json-peek)))))\r
+ (setq value (json-read))\r
+ (setq elements (json-add-to-object elements key value))\r
+ ;; Order matters a little\r
+ (cond ((eq (char-after) ?,) (json-advance))\r
+ ((eq (char-after) ?}) (setq more nil))\r
+ ((progn\r
+ (json-skip-whitespace)\r
+ (eq (char-after) ?,)) (json-advance))\r
+ ((eq (char-after) ?}) (setq more nil))\r
+ (t (signal 'json-object-format (list "," (json-peek)))))))\r
+ ;; (unless (char-equal (json-peek) ?})\r
+ ;; (if (char-equal (json-peek) ?,)\r
+ ;; (json-advance)\r
+ ;; (signal 'json-object-format (list "," (json-peek))))))\r
+ ;; Skip over the "}"\r
+ (json-advance)\r
+ elements))\r
+\r
+;; Hash table encoding\r
+\r
+(defun json-encode-hash-table (hash-table)\r
+ "Return a JSON representation of HASH-TABLE."\r
+ (format "{%s}"\r
+ (json-join\r
+ (let (r)\r
+ (maphash\r
+ (lambda (k v)\r
+ (push (format "%s:%s"\r
+ (json-encode k)\r
+ (json-encode v))\r
+ r))\r
+ hash-table)\r
+ r)\r
+ ", ")))\r
+\r
+;; List encoding (including alists and plists)\r
+\r
+(defun json-encode-alist (alist)\r
+ "Return a JSON representation of ALIST."\r
+ (format "{%s}"\r
+ (json-join (mapcar (lambda (cons)\r
+ (format "%s:%s"\r
+ (json-encode (car cons))\r
+ (json-encode (cdr cons))))\r
+ alist)\r
+ ", ")))\r
+\r
+(defun json-encode-plist (plist)\r
+ "Return a JSON representation of PLIST."\r
+ (let (result)\r
+ (while plist\r
+ (push (concat (json-encode (car plist))\r
+ ":"\r
+ (json-encode (cadr plist)))\r
+ result)\r
+ (setq plist (cddr plist)))\r
+ (concat "{" (json-join (nreverse result) ", ") "}")))\r
+\r
+(defun json-encode-list (list)\r
+ "Return a JSON representation of LIST.\r
+Tries to DWIM: simple lists become JSON arrays, while alists and plists\r
+become JSON objects."\r
+ (cond ((null list) "null")\r
+ ((json-alist-p list) (json-encode-alist list))\r
+ ((json-plist-p list) (json-encode-plist list))\r
+ ((listp list) (json-encode-array list))\r
+ (t\r
+ (signal 'json-error (list list)))))\r
+\r
+;;; Arrays\r
+\r
+;; Array parsing\r
+\r
+;; (defun json-read-array ()\r
+;; "Read the JSON array at point."\r
+;; ;; Skip over the "["\r
+;; (json-advance)\r
+;; (json-skip-whitespace)\r
+;; ;; read values until "]"\r
+;; (let (elements)\r
+;; (while (not (char-equal (json-peek) ?\]))\r
+;; (push (json-read) elements)\r
+;; (json-skip-whitespace)\r
+;; (unless (char-equal (json-peek) ?\])\r
+;; (if (char-equal (json-peek) ?,)\r
+;; (json-advance)\r
+;; (signal 'json-error (list 'bleah)))))\r
+;; ;; Skip over the "]"\r
+;; (json-advance)\r
+;; (apply json-array-type (nreverse elements))))\r
+\r
+(defun json-read-array ()\r
+ "Read the JSON array at point."\r
+ ;; Skip over the "["\r
+ (json-advance)\r
+ (json-skip-whitespace)\r
+ ;; read values until "]"\r
+ (let* (elements (more t))\r
+ (unless (eq (char-after) ?\])\r
+ (while more\r
+;; (while (not (char-equal (json-peek) ?\]))\r
+ (push (json-read) elements)\r
+ ;; Doesn't help\r
+;; (setq tail (setcdr tail (cons (json-read) nil)))\r
+\r
+;; (json-skip-whitespace)\r
+ (cond ((eq (char-after) ?,) (json-advance))\r
+ ((eq (char-after) ?\]) (setq more nil))\r
+ ((progn\r
+ (json-skip-whitespace)\r
+ (eq (char-after) ?,)) (json-advance))\r
+ ((eq (char-after) ?\]) (setq more nil))\r
+ (t (signal 'json-error (list 'bleah))))))\r
+ ;; (unless (char-equal (json-peek) ?\])\r
+ ;; (if (char-equal (json-peek) ?,)\r
+ ;; (json-advance)\r
+ ;; (signal 'json-error (list 'bleah))))))\r
+ ;; Skip over the "]"\r
+ (json-advance)\r
+ ;; Matters\r
+ (if (eq json-array-type 'list)\r
+ (nreverse elements)\r
+ (apply json-array-type (nreverse elements)))))\r
+\r
+;; Array encoding\r
+\r
+(defun json-encode-array (array)\r
+ "Return a JSON representation of ARRAY."\r
+ (concat "[" (mapconcat 'json-encode array ", ") "]"))\r
+\r
+\f\r
+\r
+\r
+;;; JSON reader.\r
+\r
+;; (defvar json-readtable\r
+;; (let ((table\r
+;; '((?t json-read-keyword "true")\r
+;; (?f json-read-keyword "false")\r
+;; (?n json-read-keyword "null")\r
+;; (?{ json-read-object)\r
+;; (?\[ json-read-array)\r
+;; (?\" json-read-string))))\r
+;; (mapc (lambda (char)\r
+;; (push (list char 'json-read-number) table))\r
+;; '(?- ?+ ?. ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))\r
+;; table)\r
+;; "Readtable for JSON reader.")\r
+\r
+;; (defun json-read ()\r
+;; "Parse and return the JSON object following point.\r
+;; Advances point just past JSON object."\r
+;; (json-skip-whitespace)\r
+;; (let ((char (json-peek)))\r
+;; (if (not (eq char :json-eof))\r
+;; (let ((record (cdr (assq char json-readtable))))\r
+;; (if (functionp (car record))\r
+;; (apply (car record) (cdr record))\r
+;; (signal 'json-readtable-error record)))\r
+;; (signal 'end-of-file nil))))\r
+\r
+(defvar my-json-readtable\r
+ (let ((table (make-char-table nil)))\r
+ (aset table ?t '(json-read-keyword "true"))\r
+ (aset table ?f '(json-read-keyword "false"))\r
+ (aset table ?n '(json-read-keyword "null"))\r
+ (aset table ?{ '(json-read-object))\r
+ (aset table ?\[ '(json-read-array))\r
+ (aset table ?\" '(json-read-string))\r
+ (mapc (lambda (char)\r
+ (aset table char '(json-read-number)))\r
+ '(?- ?+ ?. ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))\r
+ table)\r
+ "Readtable for JSON reader.")\r
+\r
+;; Char-table matters a bit; (if (null ..)) matters more\r
+;; (defun json-read ()\r
+;; "Parse and return the JSON object following point.\r
+;; Advances point just past JSON object."\r
+;; (json-skip-whitespace)\r
+;; (let ((char (json-peek)))\r
+;; (if (not (eq char :json-eof))\r
+;; (let ((record (aref my-json-readtable char)))\r
+;; (if (null (car record))\r
+;; (signal 'json-readtable-error record)\r
+;; (apply (car record) (cdr record))))\r
+;; (signal 'end-of-file nil))))\r
+\r
+;; Makes no difference or slower, probably because there's usually whitespace\r
+;; (defun json-read ()\r
+;; "Parse and return the JSON object following point.\r
+;; Advances point just past JSON object."\r
+;; (let ((record (and (char-after) (aref my-json-readtable (char-after)))))\r
+;; (when (null record)\r
+;; (json-skip-whitespace)\r
+;; (when (eobp)\r
+;; (signal 'end-of-file nil))\r
+;; (setq record (aref my-json-readtable (char-after)))\r
+;; (when (null record)\r
+;; (signal 'json-readtable-error record)))\r
+;; (apply (car record) (cdr record))))\r
+\r
+;; Makes a difference\r
+(defun json-read ()\r
+ "Parse and return the JSON object following point.\r
+Advances point just past JSON object."\r
+ (json-skip-whitespace)\r
+ (if (char-after)\r
+ (let ((record (aref my-json-readtable (char-after))))\r
+ (if record\r
+ (apply (car record) (cdr record))\r
+ (signal 'json-readtable-error record)))\r
+ (signal 'end-of-file nil)))\r
+\r
+;; Syntactic sugar for the reader\r
+\r
+(defun json-read-from-string (string)\r
+ "Read the JSON object contained in STRING and return it."\r
+ (with-temp-buffer\r
+ (insert string)\r
+ (goto-char (point-min))\r
+ (json-read)))\r
+\r
+(defun json-read-file (file)\r
+ "Read the first JSON object contained in FILE and return it."\r
+ (with-temp-buffer\r
+ (insert-file-contents file)\r
+ (goto-char (point-min))\r
+ (json-read)))\r
+\r
+\f\r
+\r
+\r
+;;; JSON encoder\r
+\r
+(defun json-encode (object)\r
+ "Return a JSON representation of OBJECT as a string."\r
+ (cond ((memq object (list t json-null json-false))\r
+ (json-encode-keyword object))\r
+ ((stringp object) (json-encode-string object))\r
+ ((keywordp object) (json-encode-string\r
+ (substring (symbol-name object) 1)))\r
+ ((symbolp object) (json-encode-string\r
+ (symbol-name object)))\r
+ ((numberp object) (json-encode-number object))\r
+ ((arrayp object) (json-encode-array object))\r
+ ((hash-table-p object) (json-encode-hash-table object))\r
+ ((listp object) (json-encode-list object))\r
+ (t (signal 'json-error (list object)))))\r
+\r
+(provide 'json)\r
+\r
+;; arch-tag: 15f6e4c8-b831-4172-8749-bbc680c50ea1\r
+;;; json.el ends here\r
+\r
+--/04w6evG8XlLl3ft--\r
projects / notmuch-archives.git / commitdiff