Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv4578
Modified Files: html-syntax.lisp packages.lisp syntax.lisp Log Message: 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.
Date: Fri Mar 18 08:49:18 2005 Author: rstrandh
Index: climacs/html-syntax.lisp diff -u climacs/html-syntax.lisp:1.18 climacs/html-syntax.lisp:1.19 --- climacs/html-syntax.lisp:1.18 Thu Mar 17 06:07:12 2005 +++ climacs/html-syntax.lisp Fri Mar 18 08:49:17 2005 @@ -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)))))
Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.58 climacs/packages.lisp:1.59 --- climacs/packages.lisp:1.58 Tue Mar 15 13:51:39 2005 +++ climacs/packages.lisp Fri Mar 18 08:49:17 2005 @@ -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
Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.40 climacs/syntax.lisp:1.41 --- climacs/syntax.lisp:1.40 Wed Mar 16 07:12:10 2005 +++ climacs/syntax.lisp Fri Mar 18 08:49:17 2005 @@ -97,12 +97,38 @@ (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)) (with-slots (start-mark size) tree (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))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;