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