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