Commit 236611db authored by Robert Strandh's avatar Robert Strandh

Added setf methods for offset of parse-trees. Either a numerical

offset can be given, in which case, the start-mark must exist (since
we don't know the buffer), or else a mark can be given, in which case
it is cloned.

Removed references to start-mark from html-syntax.lisp, and removed it
from the export list of the climacs-syntax package.
parent dc2cd0f5
......@@ -88,7 +88,7 @@
:<head> <head> :title title :</head> </head>)))
(defun word-is (word string)
(string-equal (coerce (region-to-sequence (start-mark word) (end-offset word)) 'string)
(string-equal (coerce (buffer-sequence (buffer word) (start-offset word) (end-offset word)) 'string)
string))
(defmacro define-start-tag (name string)
......@@ -309,12 +309,12 @@
:grammar *html-grammar*
:target 'html))
(setf lexer (make-instance 'html-lexer :buffer (buffer syntax)))
(let ((m (clone-mark (low-mark buffer) :left)))
(let ((m (clone-mark (low-mark buffer) :left))
(lexeme (make-instance 'start-lexeme :state (initial-state parser))))
(setf (offset m) 0)
(insert-lexeme lexer 0 (make-instance 'start-lexeme
:start-mark m
:size 0
:state (initial-state parser))))))
(setf (start-offset lexeme) m
(end-offset lexeme) 0)
(insert-lexeme lexer 0 lexeme))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
......@@ -388,8 +388,9 @@
(with-slots (ink face) entity
(setf ink (medium-ink (sheet-medium pane))
face (text-style-face (medium-text-style (sheet-medium pane))))
(present (coerce (region-to-sequence (start-mark entity)
(end-offset entity))
(present (coerce (buffer-sequence (buffer syntax)
(start-offset entity)
(end-offset entity))
'string)
'string
:stream pane)))))
......
......@@ -96,7 +96,6 @@
#:parser #:initial-state
#:advance-parse
#:parse-tree #:start-offset #:end-offset
#:start-mark ; FIXME remove this
#:lexer #:nb-lexemes #:lexeme #:insert-lexeme
#:incremental-lexer #:next-lexeme
#:delete-invalid-lexemes #:inter-lexeme-object-p
......
......@@ -97,6 +97,17 @@ the mark, according to the specified syntax."))
(when mark
(offset mark))))
(defmethod (setf start-offset) ((offset number) (tree parse-tree))
(let ((mark (start-mark tree)))
(assert (not (null mark)))
(setf (offset mark) offset)))
(defmethod (setf start-offset) ((offset mark) (tree parse-tree))
(with-slots (start-mark) tree
(if (null start-mark)
(setf start-mark (clone-mark offset))
(setf (offset start-mark) (offset offset)))))
(defgeneric end-offset (parse-tree))
(defmethod end-offset ((tree parse-tree))
......@@ -104,6 +115,21 @@ the mark, according to the specified syntax."))
(when start-mark
(+ (offset start-mark) size))))
(defmethod (setf end-offset) ((offset number) (tree parse-tree))
(with-slots (start-mark size) tree
(assert (not (null start-mark)))
(setf size (- offset (offset start-mark)))))
(defmethod (setf end-offset) ((offset mark) (tree parse-tree))
(with-slots (start-mark size) tree
(assert (not (null start-mark)))
(setf size (- (offset offset) (offset start-mark)))))
(defmethod buffer ((tree parse-tree))
(let ((start-mark (start-mark tree)))
(when start-mark
(buffer start-mark))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; lexer
......
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