[climacs-cvs] CVS update: climacs/gui.lisp climacs/pane.lisp climacs/syntax.lisp climacs/text-syntax.lisp

[Robert Strandh]

Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv6156

Modified Files:
	gui.lisp pane.lisp syntax.lisp text-syntax.lisp 
Log Message:
Code factoring in text-syntax.lisp 
(thanks to Rudi Schlatte).

Date: Mon Jan 17 14:35:53 2005
Author: rstrandh

Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.77 climacs/gui.lisp:1.78
--- climacs/gui.lisp:1.77	Mon Jan 17 13:26:11 2005
+++ climacs/gui.lisp	Mon Jan 17 14:35:52 2005
@@ -457,7 +457,9 @@
     (let* ((directory-prefix
 	    (if (and (plusp (length so-far)) (eql (aref so-far 0) #\/))
 		""
-		(namestring #+sbcl (car (directory ".")) #+cmu (ext:default-directory))))
+		(namestring #+sbcl *default-pathname-defaults*
+                            #+cmu (ext:default-directory)
+                            #-(or sbcl cmu) *default-pathname-defaults*)))
 	   (full-so-far (concatenate 'string directory-prefix so-far))
 	   (pathnames
 	    (loop with length = (length full-so-far)


Index: climacs/pane.lisp
diff -u climacs/pane.lisp:1.2 climacs/pane.lisp:1.3
--- climacs/pane.lisp:1.2	Mon Jan 17 08:10:19 2005
+++ climacs/pane.lisp	Mon Jan 17 14:35:52 2005
@@ -34,7 +34,7 @@
   ((space-width :initform nil :reader space-width)
    (tab-width :initform nil :reader tab-width)))
 
-(defmethod tab-space-count (tabify)
+(defmethod tab-space-count ((tabify t))
   1)
 
 (defmethod tab-space-count ((tabify tabify-mixin))
@@ -122,6 +122,7 @@
 (defgeneric display-line (pane line offset syntax view))
 
 (defmethod display-line (pane line offset (syntax basic-syntax) (view textual-view))
+  (declare (ignore offset))
   (let ((saved-index nil)
 	(id 0))
     (flet ((output-word (index)


Index: climacs/syntax.lisp
diff -u climacs/syntax.lisp:1.26 climacs/syntax.lisp:1.27
--- climacs/syntax.lisp:1.26	Mon Jan 17 08:10:19 2005
+++ climacs/syntax.lisp	Mon Jan 17 14:35:52 2005
@@ -60,4 +60,5 @@
   ())
 
 (defmethod update-syntax (buffer (syntax basic-syntax))
+  (declare (ignore buffer))
   nil)


Index: climacs/text-syntax.lisp
diff -u climacs/text-syntax.lisp:1.3 climacs/text-syntax.lisp:1.4
--- climacs/text-syntax.lisp:1.3	Sat Jan 15 22:35:53 2005
+++ climacs/text-syntax.lisp	Mon Jan 17 14:35:52 2005
@@ -44,6 +44,17 @@
 
 (in-package :climacs-syntax) ;;; Put this in a separate package once it works
 
+(defun index-of-mark-after-offset (flexichain offset)
+  "Searches for the mark after `offset' in the marks stored in `flexichain'."
+  (loop with low-position = 0
+     with high-position = (nb-elements flexichain)
+     for middle-position = (floor (+ low-position high-position) 2)
+     until (= low-position high-position)
+     do (if (mark>= (element* flexichain middle-position) offset)
+            (setf high-position middle-position)
+            (setf low-position (floor (+ low-position 1 high-position) 2)))
+     finally (return low-position)))
+
 (define-syntax text-syntax ("Text" (basic-syntax))
   ((paragraphs :initform (make-instance 'standard-flexichain))))
 
@@ -51,18 +62,10 @@
   (let* ((high-offset (min (+ (offset (high-mark buffer)) 3) (size buffer)))
 	 (low-offset (max (- (offset (low-mark buffer)) 3) 0)))
     (with-slots (paragraphs) syntax
-       (let* ((nb-paragraphs (nb-elements paragraphs))
-	      (pos2 nb-paragraphs)
-	      (pos1 0))
+       (let ((pos1 (index-of-mark-after-offset paragraphs low-offset)))
 	 ;; start by deleting all syntax marks that are between the low and
 	 ;; the high marks
-	 (loop until (= pos1 pos2)
-	       do (cond ((mark< (element* paragraphs (floor (+ pos1 pos2) 2))
-				low-offset)
-			 (setf pos1 (floor (+ pos1 1 pos2) 2)))
-			(t
-			 (setf pos2 (floor (+ pos1 pos2) 2)))))
-	 (loop repeat (- nb-paragraphs pos1)
+	 (loop repeat (- (nb-elements paragraphs) pos1)
 	       while (mark<= (element* paragraphs pos1) high-offset)
 	       do (delete* paragraphs pos1))
 	 ;; check the zone between low-offset and high-offset for
@@ -95,31 +98,23 @@
 
 (defmethod beginning-of-paragraph (mark (syntax text-syntax))
   (with-slots (paragraphs) syntax
-     (let* ((nb-paragraphs (nb-elements paragraphs))
-	    (pos2 nb-paragraphs)
-	    (pos1 0)
-	    (offset (offset mark)))
-       (loop until (= pos1 pos2)
-	     do (if (mark>= (element* paragraphs (floor (+ pos1 pos2) 2)) offset)
-		    (setf pos2 (floor (+ pos1 pos2) 2))
-		    (setf pos1 (floor (+ pos1 1 pos2) 2))))
+     (let ((pos1 (index-of-mark-after-offset paragraphs (offset mark))))
        (when (> pos1 0)
 	 (setf (offset mark)
 	       (if (typep (element* paragraphs (1- pos1)) 'right-sticky-mark)
 		   (offset (element* paragraphs (- pos1 2)))
 		   (offset (element* paragraphs (1- pos1)))))))))
 
+(defgeneric end-of-paragraph (mark text-syntax))
+
 (defmethod end-of-paragraph (mark (syntax text-syntax))
   (with-slots (paragraphs) syntax
-     (let* ((nb-paragraphs (nb-elements paragraphs))
-	    (pos2 nb-paragraphs)
-	    (pos1 0)
-	    (offset (offset mark)))
-       (loop until (= pos1 pos2)
-	     do (if (mark<= (element* paragraphs (floor (+ pos1 pos2) 2)) offset)
-		    (setf pos1 (floor (+ pos1 1 pos2) 2))
-		    (setf pos2 (floor (+ pos1 pos2) 2))))
-       (when (< pos1 nb-paragraphs)
+    (let ((pos1 (index-of-mark-after-offset
+                 paragraphs
+                 ;; if mark is at paragraph-end, jump to end of next
+                 ;; paragraph
+                 (1+ (offset mark)))))
+      (when (< pos1 (nb-elements paragraphs))
 	 (setf (offset mark)
 	       (if (typep (element* paragraphs pos1) 'left-sticky-mark)
 		   (offset (element* paragraphs (1+ pos1)))