]> git.cworth.org Git - notmuch/blob - emacs/notmuch-parser.el
emacs: Improve notmuch-message-mode initialization
[notmuch] / emacs / notmuch-parser.el
1 ;; notmuch-parser.el --- streaming S-expression parser
2 ;;
3 ;; Copyright © Austin Clements
4 ;;
5 ;; This file is part of Notmuch.
6 ;;
7 ;; Notmuch is free software: you can redistribute it and/or modify it
8 ;; under the terms of the GNU General Public License as published by
9 ;; the Free Software Foundation, either version 3 of the License, or
10 ;; (at your option) any later version.
11 ;;
12 ;; Notmuch is distributed in the hope that it will be useful, but
13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
15 ;; General Public License for more details.
16 ;;
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with Notmuch.  If not, see <http://www.gnu.org/licenses/>.
19 ;;
20 ;; Authors: Austin Clements <aclements@csail.mit.edu>
21
22 (require 'cl)
23
24 (defun notmuch-sexp-create-parser ()
25   "Return a new streaming S-expression parser.
26
27 This parser is designed to incrementally read an S-expression
28 whose structure is known to the caller.  Like a typical
29 S-expression parsing interface, it provides a function to read a
30 complete S-expression from the input.  However, it extends this
31 with an additional function that requires the next value in the
32 input to be a list and descends into it, allowing its elements to
33 be read one at a time or further descended into.  Both functions
34 can return 'retry to indicate that not enough input is available.
35
36 The parser always consumes input from point in the current
37 buffer.  Hence, the caller is allowed to delete any data before
38 point and may resynchronize after an error by moving point."
39
40   (vector 'notmuch-sexp-parser
41           ;; List depth
42           0
43           ;; Partial parse position marker
44           nil
45           ;; Partial parse state
46           nil))
47
48 (defmacro notmuch-sexp--depth (sp)         `(aref ,sp 1))
49 (defmacro notmuch-sexp--partial-pos (sp)   `(aref ,sp 2))
50 (defmacro notmuch-sexp--partial-state (sp) `(aref ,sp 3))
51
52 (defun notmuch-sexp-read (sp)
53   "Consume and return the value at point in the current buffer.
54
55 Returns 'retry if there is insufficient input to parse a complete
56 value (though it may still move point over whitespace).  If the
57 parser is currently inside a list and the next token ends the
58 list, this moves point just past the terminator and returns 'end.
59 Otherwise, this moves point to just past the end of the value and
60 returns the value."
61
62   (skip-chars-forward " \n\r\t")
63   (cond ((eobp) 'retry)
64         ((= (char-after) ?\))
65          ;; We've reached the end of a list
66          (if (= (notmuch-sexp--depth sp) 0)
67              ;; .. but we weren't in a list.  Let read signal the
68              ;; error to be consistent with all other code paths.
69              (read (current-buffer))
70            ;; Go up a level and return an end token
71            (decf (notmuch-sexp--depth sp))
72            (forward-char)
73            'end))
74         ((= (char-after) ?\()
75          ;; We're at the beginning of a list.  If we haven't started
76          ;; a partial parse yet, attempt to read the list in its
77          ;; entirety.  If this fails, or we've started a partial
78          ;; parse, extend the partial parse to figure out when we
79          ;; have a complete list.
80          (catch 'return
81            (when (null (notmuch-sexp--partial-state sp))
82              (let ((start (point)))
83                (condition-case nil
84                    (throw 'return (read (current-buffer)))
85                  (end-of-file (goto-char start)))))
86            ;; Extend the partial parse
87            (let (is-complete)
88              (save-excursion
89                (let* ((new-state (parse-partial-sexp
90                                   (or (notmuch-sexp--partial-pos sp) (point))
91                                   (point-max) 0 nil
92                                   (notmuch-sexp--partial-state sp)))
93                       ;; A complete value is available if we've
94                       ;; reached depth 0.
95                       (depth (first new-state)))
96                  (assert (>= depth 0))
97                  (if (= depth 0)
98                      ;; Reset partial parse state
99                      (setf (notmuch-sexp--partial-state sp) nil
100                            (notmuch-sexp--partial-pos sp) nil
101                            is-complete t)
102                    ;; Update partial parse state
103                    (setf (notmuch-sexp--partial-state sp) new-state
104                          (notmuch-sexp--partial-pos sp) (point-marker)))))
105              (if is-complete
106                  (read (current-buffer))
107                'retry))))
108         (t
109          ;; Attempt to read a non-compound value
110          (let ((start (point)))
111            (condition-case nil
112                (let ((val (read (current-buffer))))
113                  ;; We got what looks like a complete read, but if
114                  ;; we reached the end of the buffer in the process,
115                  ;; we may not actually have all of the input we
116                  ;; need (unless it's a string, which is delimited).
117                  (if (or (stringp val) (not (eobp)))
118                      val
119                    ;; We can't be sure the input was complete
120                    (goto-char start)
121                    'retry))
122              (end-of-file
123               (goto-char start)
124               'retry))))))
125
126 (defun notmuch-sexp-begin-list (sp)
127   "Parse the beginning of a list value and enter the list.
128
129 Returns 'retry if there is insufficient input to parse the
130 beginning of the list.  If this is able to parse the beginning of
131 a list, it moves point past the token that opens the list and
132 returns t.  Later calls to `notmuch-sexp-read' will return the
133 elements inside the list.  If the input in buffer is not the
134 beginning of a list, throw invalid-read-syntax."
135
136   (skip-chars-forward " \n\r\t")
137   (cond ((eobp) 'retry)
138         ((= (char-after) ?\()
139          (forward-char)
140          (incf (notmuch-sexp--depth sp))
141          t)
142         (t
143          ;; Skip over the bad character like `read' does
144          (forward-char)
145          (signal 'invalid-read-syntax (list (string (char-before)))))))
146
147 (defun notmuch-sexp-eof (sp)
148   "Signal an error if there is more data in SP's buffer.
149
150 Moves point to the beginning of any trailing data or to the end
151 of the buffer if there is only trailing whitespace."
152
153   (skip-chars-forward " \n\r\t")
154   (unless (eobp)
155     (error "Trailing garbage following expression")))
156
157 (defvar notmuch-sexp--parser nil
158   "The buffer-local notmuch-sexp-parser instance.
159
160 Used by `notmuch-sexp-parse-partial-list'.")
161
162 (defvar notmuch-sexp--state nil
163   "The buffer-local `notmuch-sexp-parse-partial-list' state.")
164
165 (defun notmuch-sexp-parse-partial-list (result-function result-buffer)
166   "Incrementally parse an S-expression list from the current buffer.
167
168 This function consumes an S-expression list from the current
169 buffer, applying RESULT-FUNCTION in RESULT-BUFFER to each
170 complete value in the list.  It operates incrementally and should
171 be called whenever the input buffer has been extended with
172 additional data.  The caller just needs to ensure it does not
173 move point in the input buffer."
174
175   ;; Set up the initial state
176   (unless (local-variable-p 'notmuch-sexp--parser)
177     (set (make-local-variable 'notmuch-sexp--parser)
178          (notmuch-sexp-create-parser))
179     (set (make-local-variable 'notmuch-sexp--state) 'begin))
180   (let (done)
181     (while (not done)
182       (case notmuch-sexp--state
183         (begin
184          ;; Enter the list
185          (if (eq (notmuch-sexp-begin-list notmuch-sexp--parser) 'retry)
186              (setq done t)
187            (setq notmuch-sexp--state 'result)))
188         (result
189          ;; Parse a result
190          (let ((result (notmuch-sexp-read notmuch-sexp--parser)))
191            (case result
192              (retry (setq done t))
193              (end   (setq notmuch-sexp--state 'end))
194              (t     (with-current-buffer result-buffer
195                       (funcall result-function result))))))
196         (end
197          ;; Any trailing data is unexpected
198          (notmuch-sexp-eof notmuch-sexp--parser)
199          (setq done t)))))
200   ;; Clear out what we've parsed
201   (delete-region (point-min) (point)))
202
203 (provide 'notmuch-parser)
204
205 ;; Local Variables:
206 ;; byte-compile-warnings: (not cl-functions)
207 ;; End: