343 lines
13 KiB
EmacsLisp
343 lines
13 KiB
EmacsLisp
;;; xmtn-basic-io.el --- A parser for monotone's basic_io output format
|
|
|
|
;; Copyright (C) 2008 Stephen Leake
|
|
;; Copyright (C) 2006, 2007 Christian M. Ohler
|
|
|
|
;; Author: Christian M. Ohler
|
|
;; Maintainer: Stephen Leake stephen_leake@stephe-leake.org
|
|
;; Keywords: tools, extensions
|
|
|
|
;; This file is free software; you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation; either version 2 of the License, or
|
|
;; (at your option) any later version.
|
|
;;
|
|
;; This file is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
;;
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with this file; see the file COPYING. If not, write to
|
|
;; the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
|
|
;; Boston, MA 02110-1301 USA.
|
|
|
|
;;; Commentary:
|
|
|
|
;; This library helps parse data in monotone's basic_io format.
|
|
;;
|
|
;; See docstrings for details.
|
|
|
|
;;; Code:
|
|
|
|
;;; There are some notes on the design of xmtn in
|
|
;;; docs/xmtn-readme.txt.
|
|
|
|
;;; I haven't seen a specification for monotone's basic_io format.
|
|
;;; I'm implementing this parser somewhat defensively.
|
|
|
|
;;; Maybe strings in basic_io are always encoded as UTF-8? In that
|
|
;;; case, the decoding code for filenames and cert names/values that
|
|
;;; is currently spread across several functions could be moved
|
|
;;; directly in here.
|
|
|
|
;;; `parse-partial-sexp'/`scan-sexps', with an appropriate syntax
|
|
;;; table, looks like the best way to do this kind of parsing. It is
|
|
;;; very likely faster than anything we can implement by hand in Emacs
|
|
;;; Lisp.
|
|
|
|
;;; Much of the code in here has been tuned for speed quite a bit.
|
|
;;; Careful with refactorings! For example, introducing a variable
|
|
;;; binding that the byte-compiler can't optimize away can mean a
|
|
;;; major slowdown.
|
|
|
|
;;; Using cons cells instead of two-element lists is only a very minor
|
|
;;; performance advantage (<.5%). Also, with cons cells, `null-id'
|
|
;;; would have to be a bare symbol, while `id' and `string' would be
|
|
;;; cons cells; with lists, the representation is more uniform.
|
|
|
|
(eval-and-compile
|
|
(require 'cl)
|
|
(require 'xmtn-base) ; for xmtn--hash-id
|
|
)
|
|
|
|
(defvar xmtn-basic-io--*syntax-table*
|
|
(let ((table (make-syntax-table)))
|
|
(modify-syntax-entry ?_ "_" table)
|
|
(modify-syntax-entry ?\[ "(" table)
|
|
(modify-syntax-entry ?\] ")" table)
|
|
(modify-syntax-entry ?\" "\"" table)
|
|
(modify-syntax-entry ?\\ "/" table)
|
|
table))
|
|
|
|
(defsubst xmtn-basic-io--unescape-field (string)
|
|
(loop with start = 0
|
|
while (string-match "\\\\" string start)
|
|
do (setq string (replace-match "" t t string))
|
|
do (setq start (1+ (match-end 0))))
|
|
string)
|
|
|
|
(defsubst xmtn-basic-io--read-key ()
|
|
;; Calling `xmtn--debug-mark-text-processed' from here is way too
|
|
;; slow.
|
|
(let ((start (point)))
|
|
(skip-syntax-forward "w_")
|
|
(xmtn--assert-optional (> (point) start))
|
|
(xmtn--assert-optional (member (char-after (point)) '(?\ ?\n)))
|
|
(let ((key (buffer-substring-no-properties start (point))))
|
|
(xmtn--assert-optional (string-match "\\`[a-z_]+\\'" key) t)
|
|
;;(xmtn--debug-mark-text-processed (current-buffer) start (point) t)
|
|
key)))
|
|
|
|
(defsubst xmtn-basic-io--read-field ()
|
|
"Return a list containing the class and value of the field at point.
|
|
Possible classes are `string', `null-id', `id', `symbol'."
|
|
;; Calling `xmtn--debug-mark-text-processed' from here is way too
|
|
;; slow.
|
|
(let ((end (scan-sexps (point) 1)))
|
|
(xmtn--assert-optional end)
|
|
(xmtn--assert-optional (> end (point)))
|
|
(prog1
|
|
(case (char-after (point))
|
|
(?\" ; a string
|
|
(list 'string (xmtn-basic-io--unescape-field
|
|
(buffer-substring-no-properties (1+ (point))
|
|
(1- end)))))
|
|
(?\[ ; an id
|
|
(cond ((eq (1+ (point)) (1- end)) ;see (elisp) Equality Predicates
|
|
(list 'null-id))
|
|
(t
|
|
(xmtn--assert-optional
|
|
(typep (buffer-substring-no-properties (1+ (point))
|
|
(1- end))
|
|
'xmtn--hash-id))
|
|
(list 'id (buffer-substring-no-properties (1+ (point))
|
|
(1- end))))))
|
|
(t ; a symbol
|
|
(list 'symbol (buffer-substring-no-properties (point) end))))
|
|
(goto-char end)
|
|
(xmtn--assert-optional (member (char-after) '(?\n ?\ ))))))
|
|
|
|
(defsubst xmtn-basic-io--skip-white-space ()
|
|
;; Calling `xmtn--debug-mark-text-processed' from here is way too slow.
|
|
(skip-chars-forward " "))
|
|
|
|
(defun xmtn-basic-io-skip-blank-lines ()
|
|
"Skip blank lines (if any), so parser starts on a stanza."
|
|
(beginning-of-line)
|
|
(while
|
|
(case (char-after)
|
|
((?\n)
|
|
(forward-char 1)
|
|
t)
|
|
((? )
|
|
(skip-chars-forward " ")
|
|
t)
|
|
(t
|
|
nil)))
|
|
(beginning-of-line))
|
|
|
|
(defsubst xmtn-basic-io--parse-nonempty-line ()
|
|
(xmtn-basic-io--skip-white-space)
|
|
(prog1
|
|
(list* (xmtn-basic-io--read-key)
|
|
(loop while (progn
|
|
(xmtn-basic-io--skip-white-space)
|
|
(not (eq (char-after) ?\n)))
|
|
collect (xmtn-basic-io--read-field)))
|
|
(forward-char 1)))
|
|
|
|
(defsubst xmtn-basic-io--peek ()
|
|
(case (char-after)
|
|
((?\n) 'empty)
|
|
((nil) 'eof)
|
|
(t t)))
|
|
|
|
(defun xmtn-basic-io--next-parsed-line ()
|
|
(case (char-after)
|
|
((?\n)
|
|
(forward-char 1)
|
|
'empty)
|
|
((nil)
|
|
'eof)
|
|
(t
|
|
(xmtn-basic-io--parse-nonempty-line))))
|
|
|
|
(defun xmtn-basic-io--next-stanza ()
|
|
(let ((stanza (let ((accu nil)
|
|
(line nil))
|
|
(loop do (setq line (xmtn-basic-io--next-parsed-line))
|
|
do (xmtn--assert-optional (not (and (null accu)
|
|
(eq line 'empty))))
|
|
until (memq line '(empty eof))
|
|
do
|
|
(xmtn--assert-optional (listp line))
|
|
(xmtn--assert-optional (not (endp line)))
|
|
(push line accu))
|
|
(nreverse accu))))
|
|
stanza))
|
|
|
|
(defun xmtn-basic-io--next-parsed-line-notinline ()
|
|
(xmtn-basic-io--next-parsed-line))
|
|
|
|
(eval-and-compile
|
|
(defun xmtn-basic-io--generate-body-for-with-parser-form (parser-fn
|
|
parser-var
|
|
buffer-form body)
|
|
(let ((buffer (gensym)))
|
|
`(let ((,buffer ,buffer-form))
|
|
(with-current-buffer ,buffer
|
|
(set-syntax-table xmtn-basic-io--*syntax-table*)
|
|
(goto-char (point-min)))
|
|
(let ((,parser-var (lambda ()
|
|
(with-current-buffer ,buffer
|
|
(,parser-fn)))))
|
|
,@body)))))
|
|
|
|
(defun xmtn-basic-io-eof ()
|
|
"Return non-nil if at end of input, nil otherwise."
|
|
(eq 'eof (xmtn-basic-io--peek)))
|
|
|
|
(defmacro xmtn-basic-io-parse-line (body)
|
|
"Read next basic-io line at point. Error if it is `empty' or
|
|
`eof'. Otherwise execute BODY with `symbol' bound to key (a
|
|
string), `value' bound to list containing parsed rest of line.
|
|
List is of form ((category value) ...)."
|
|
(declare (indent 1) (debug (sexp body)))
|
|
`(let ((line (xmtn-basic-io--next-parsed-line)))
|
|
(if (member line '(empty eof))
|
|
(error "expecting a line, found %s" line)
|
|
(let ((symbol (car line))
|
|
(value (cdr line)))
|
|
,body))))
|
|
|
|
(defmacro xmtn-basic-io-optional-line (expected-key body-present)
|
|
"Read next basic-io line at point. If its key is
|
|
EXPECTED-KEY (a string), execute BODY-PRESENT with `value' bound
|
|
to list containing parsed rest of line. List is of
|
|
form ((category value) ...). Else reset to parse the same line
|
|
again."
|
|
(declare (indent 1) (debug (sexp body)))
|
|
`(let ((line (xmtn-basic-io--next-parsed-line)))
|
|
(if (and (not (member line '(empty eof)))
|
|
(string= (car line) ,expected-key))
|
|
(let ((value (cdr line)))
|
|
,body-present)
|
|
(beginning-of-line 0)
|
|
)))
|
|
|
|
(defmacro xmtn-basic-io-check-line (expected-key body)
|
|
"Read next basic-io line at point. Error if it is `empty' or
|
|
`eof', or if its key is not EXPECTED-KEY (a string). Otherwise
|
|
execute BODY with `value' bound to list containing parsed rest of
|
|
line. List is of form ((category value) ...)."
|
|
(declare (indent 1) (debug (sexp body)))
|
|
`(let ((line (xmtn-basic-io--next-parsed-line)))
|
|
(if (or (member line '(empty eof))
|
|
(not (string= (car line) ,expected-key)))
|
|
(error "expecting \"%s\", found %s" ,expected-key line)
|
|
(let ((value (cdr line)))
|
|
,body))))
|
|
|
|
(defun xmtn-basic-io-check-empty ()
|
|
"Read next basic-io line at point. Error if it is not `empty' or `eof'."
|
|
(let ((line (xmtn-basic-io--next-parsed-line)))
|
|
(if (not (member line '(empty eof)))
|
|
(error "expecting an empty line, found %s" line))))
|
|
|
|
(defmacro* xmtn-basic-io-with-line-parser ((line-parser buffer-form) &body body)
|
|
"Run BODY with LINE-PARSER bound to a parser that parses BUFFER-FORM.
|
|
|
|
BUFFER-FORM should evaluate to a buffer that contains, between
|
|
\(point-min\) and \(point-max\), zero or more lines in monotone's
|
|
basic_io format.
|
|
|
|
BODY will be evaluated with LINE-PARSER \(a symbol\) bound to a
|
|
closure that will, each time it is called, return the next line
|
|
in parsed form, or the symbol `eof' if there are no more lines.
|
|
|
|
Empty lines are returned as the symbol `empty'.
|
|
|
|
Each non-empty line is a list of a key and zero or more fields.
|
|
The key is a string. Each field is either a one-element list
|
|
\(null-id\) and represents an empty ID field \(what monotone
|
|
prints as \[\] in basic_io format\), a two-element list \(id
|
|
HASH-ID\), where HASH-ID is a string of forty hexadecimal digits
|
|
\(what monotone prints as \[HASH-ID\]\), or a two-element list
|
|
\(string STRING\), where STRING is a string (what monotone prints
|
|
as \"STRING\"\).
|
|
|
|
Lines and their contents are always fresh objects.
|
|
|
|
The macro `xmtn-match' is a useful way to process basic_io lines
|
|
parsed this way.
|
|
|
|
The parser should be assumed to have dynamic extent. If the
|
|
contents of the buffer that BUFFER-FORM evaluates to, or the
|
|
position of point in that buffer, are modified from within BODY
|
|
\(other than by calling the parser\), the parser becomes invalid
|
|
and must not be called any more."
|
|
(declare (indent 1) (debug (sexp body)))
|
|
(xmtn-basic-io--generate-body-for-with-parser-form
|
|
;; Use a notinline variant to avoid copying the full parser into
|
|
;; every user of this macro. The performance advantage of this
|
|
;; would be small.
|
|
'xmtn-basic-io--next-parsed-line-notinline
|
|
line-parser buffer-form body))
|
|
|
|
(defmacro* xmtn-basic-io-with-stanza-parser ((stanza-parser buffer-form)
|
|
&body body)
|
|
"Run BODY with STANZA-PARSER bound to a parser that parses BUFFER-FORM.
|
|
|
|
BUFFER-FORM should evaluate to a buffer that contains,
|
|
between (point-min) and (point-max), zero or more lines in
|
|
monotone's basic_io format.
|
|
|
|
BODY will be evaluated with STANZA-PARSER \(a symbol\) bound to a
|
|
closure that will, each time it is called, return the next stanza
|
|
in parsed form, or the symbol `nil' if there are no more stanzas.
|
|
|
|
Each stanza will be returned as a fresh, non-empty list of
|
|
so-called lines. See `xmtn-basic-io-with-line-parser' for a
|
|
definition of the term \"line\" in this context.
|
|
|
|
The macro `xmtn-match' and the function `assoc' are useful to
|
|
process basic_io stanzas parsed this way.
|
|
|
|
The parser should be assumed to have dynamic extent. If the
|
|
contents of the buffer that BUFFER-FORM evaluates to, or the
|
|
position of point in that buffer, are modified from within BODY
|
|
\(other than by calling the parser\), the parser becomes invalid
|
|
and must not be called any more."
|
|
(declare (indent 1) (debug (sexp body)))
|
|
(xmtn-basic-io--generate-body-for-with-parser-form
|
|
'xmtn-basic-io--next-stanza
|
|
stanza-parser buffer-form body))
|
|
|
|
(defun xmtn-basic-io-write-id (key id)
|
|
"Write a basic-io line with KEY, hex ID."
|
|
(insert key)
|
|
(insert " [")
|
|
(insert id)
|
|
(insert ?\])
|
|
(insert ?\n))
|
|
|
|
(defun xmtn-basic-io-write-str (key str)
|
|
"Write a basic-io line with KEY, string STR."
|
|
(insert key)
|
|
(insert " \"")
|
|
(insert str)
|
|
(insert ?\")
|
|
(insert ?\n))
|
|
|
|
(defun xmtn-basic-io-write-sym (key sym)
|
|
"Write a basic-io line with KEY, symbol SYM."
|
|
(insert key)
|
|
(insert " ")
|
|
(insert sym)
|
|
(insert ?\n))
|
|
|
|
(provide 'xmtn-basic-io)
|
|
|
|
;;; xmtn-basic-io.el ends here
|