Commit 5c330694 authored by Robert Strandh's avatar Robert Strandh

More progress on html-syntax, which may eventually become a model

for many different language syntax modules.

The display function now traverses the parse tree up as long as a
valid parse tree exists.  The rest of the display is done from the
token sequence.  It is likely that all of this can be abstracted out
and put into syntax.lisp so that html-syntax would just become a
client among others for this traversal.

Not only is the cursor still not displayed, whitespace is not handled
during the traversal of the parse tree.  This will likely be fixed in
the next few day.
parent 4f8663ce
......@@ -300,6 +300,71 @@
pane (- tab-width (mod x tab-width)) 0))))
(incf start))))
(defmethod display-parse-tree :around ((entity html-sym) syntax pane)
(with-slots (top bot) pane
(when (mark> (end-offset entity) top)
(defmethod display-parse-tree :around ((entity empty-words) syntax pane)
(declare (ignore syntax pane))
(defmethod display-parse-tree ((entity html-token) (syntax html-syntax) pane)
(updating-output (pane :unique-id entity
:id-test #'eq
:cache-value entity
:cache-test #'eq)
(present (coerce (region-to-sequence (start-mark entity)
(end-offset entity))
:stream pane)))
(defmethod display-parse-tree :before ((entity html-balanced) (syntax html-syntax) pane)
(with-slots (start) entity
(display-parse-tree start syntax pane)))
(defmethod display-parse-tree :after ((entity html-balanced) (syntax html-syntax) pane)
(with-slots (end) entity
(display-parse-tree end syntax pane)))
(defmethod display-parse-tree ((entity html-words) (syntax html-syntax) pane)
(with-slots (words) entity
(display-parse-tree words syntax pane)))
(defmethod display-parse-tree ((entity empty-words) (syntax html-syntax) pane)
(declare (ignore pane))
(defmethod display-parse-tree ((entity nonempty-words) (syntax html-syntax) pane)
(with-slots (words word) entity
(display-parse-tree words syntax pane)
(display-parse-tree word syntax pane)))
(defmethod display-parse-tree ((entity html) (syntax html-syntax) pane)
(with-slots (head body) entity
(display-parse-tree head syntax pane)
(display-parse-tree body syntax pane)))
(defmethod display-parse-tree ((entity head) (syntax html-syntax) pane)
(with-slots (title) entity
(display-parse-tree title syntax pane)))
(defgeneric display-parse-stack (symbol stack syntax pane))
(defmethod display-parse-stack (symbol stack (syntax html-syntax) pane)
(let ((next (parse-stack-next stack)))
(unless (null next)
(display-parse-stack (parse-stack-symbol next) next syntax pane))
(loop for parse-tree in (reverse (parse-stack-parse-trees stack))
do (display-parse-tree parse-tree syntax pane))))
(defun display-parse-state (state syntax pane)
(let ((top (parse-stack-top state)))
(if (not (null top))
(display-parse-stack (parse-stack-symbol top) top syntax pane)
(display-parse-tree (target-parse-tree state) syntax pane))))
(defmethod redisplay-pane-with-syntax ((pane climacs-pane) (syntax html-syntax) current-p)
(with-slots (top bot) pane
(with-slots (tokens) syntax
......@@ -310,16 +375,24 @@
;; go back to a token before bot
(loop until (mark<= (end-offset (element* tokens (1- end-token-index))) bot)
do (decf end-token-index))
;; for forward to the last token before bot
;; go forward to the last token before bot
(loop until (or (= end-token-index (nb-elements tokens))
(mark> (start-offset (element* tokens end-token-index)) bot))
do (incf end-token-index))
(let ((start-token-index end-token-index))
;; go back to the first token after top
(loop until (mark<= (end-offset (element* tokens (1- start-token-index))) top)
;; go back to the first token after top, or until the previous token
;; contains a valid parser state
(loop until (or (mark<= (end-offset (element* tokens (1- start-token-index))) top)
(not (null (parse-stack-top
(slot-value (element* tokens (1- start-token-index)) 'state)))))
do (decf start-token-index))
;; display the parse tree if any
(unless (parse-state-empty-p (slot-value (element* tokens (1- start-token-index)) 'state))
(display-parse-state (slot-value (element* tokens (1- start-token-index)) 'state)
;; display the tokens
(loop with prev-offset = (offset top)
(loop with prev-offset = (end-offset (element* tokens (1- start-token-index)))
while (< start-token-index end-token-index)
do (let ((token (element* tokens start-token-index)))
(handle-whitespace pane (buffer pane) prev-offset (start-offset token))
......@@ -92,7 +92,7 @@
#:update-syntax #:update-syntax-for-display
#:grammar #:parser #:initial-state
#:parse-stack-top #:target-parse-tree
#:parse-stack-top #:target-parse-tree #:parse-state-empty-p
#:parse-stack-next #:parse-stack-symbol
#:parse-stack-parse-trees #:map-over-parse-trees
......@@ -326,6 +326,10 @@ is empty in that state."
represent a complete parse of the target."
(state-contains-target-p state))
(defun parse-state-empty-p (state)
(and (null (parse-stack-top state))
(null (target-parse-tree state))))
(defun parse-stack-next (parse-stack)
"given a parse stack frame, return the next frame in the stack."
(assert (not (null parse-stack)))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment