[climacs-cvs] CVS update: climacs/html-syntax.lisp climacs/packages.lisp climacs/syntax.lisp

Fri Mar 18 07:49:19 UTC 2005

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))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;


