/[climacs]/climacs/text-syntax.lisp
ViewVC logotype

Diff of /climacs/text-syntax.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by rstrandh, Sat Jan 15 21:35:53 2005 UTC revision 1.4 by rstrandh, Mon Jan 17 13:35:52 2005 UTC
# Line 44  Line 44 
44    
45  (in-package :climacs-syntax) ;;; Put this in a separate package once it works  (in-package :climacs-syntax) ;;; Put this in a separate package once it works
46    
47    (defun index-of-mark-after-offset (flexichain offset)
48      "Searches for the mark after `offset' in the marks stored in `flexichain'."
49      (loop with low-position = 0
50         with high-position = (nb-elements flexichain)
51         for middle-position = (floor (+ low-position high-position) 2)
52         until (= low-position high-position)
53         do (if (mark>= (element* flexichain middle-position) offset)
54                (setf high-position middle-position)
55                (setf low-position (floor (+ low-position 1 high-position) 2)))
56         finally (return low-position)))
57    
58  (define-syntax text-syntax ("Text" (basic-syntax))  (define-syntax text-syntax ("Text" (basic-syntax))
59    ((paragraphs :initform (make-instance 'standard-flexichain))))    ((paragraphs :initform (make-instance 'standard-flexichain))))
60    
# Line 51  Line 62 
62    (let* ((high-offset (min (+ (offset (high-mark buffer)) 3) (size buffer)))    (let* ((high-offset (min (+ (offset (high-mark buffer)) 3) (size buffer)))
63           (low-offset (max (- (offset (low-mark buffer)) 3) 0)))           (low-offset (max (- (offset (low-mark buffer)) 3) 0)))
64      (with-slots (paragraphs) syntax      (with-slots (paragraphs) syntax
65         (let* ((nb-paragraphs (nb-elements paragraphs))         (let ((pos1 (index-of-mark-after-offset paragraphs low-offset)))
               (pos2 nb-paragraphs)  
               (pos1 0))  
66           ;; start by deleting all syntax marks that are between the low and           ;; start by deleting all syntax marks that are between the low and
67           ;; the high marks           ;; the high marks
68           (loop until (= pos1 pos2)           (loop repeat (- (nb-elements paragraphs) pos1)
                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)  
69                 while (mark<= (element* paragraphs pos1) high-offset)                 while (mark<= (element* paragraphs pos1) high-offset)
70                 do (delete* paragraphs pos1))                 do (delete* paragraphs pos1))
71           ;; check the zone between low-offset and high-offset for           ;; check the zone between low-offset and high-offset for
# Line 95  Line 98 
98    
99  (defmethod beginning-of-paragraph (mark (syntax text-syntax))  (defmethod beginning-of-paragraph (mark (syntax text-syntax))
100    (with-slots (paragraphs) syntax    (with-slots (paragraphs) syntax
101       (let* ((nb-paragraphs (nb-elements paragraphs))       (let ((pos1 (index-of-mark-after-offset paragraphs (offset mark))))
             (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))))  
102         (when (> pos1 0)         (when (> pos1 0)
103           (setf (offset mark)           (setf (offset mark)
104                 (if (typep (element* paragraphs (1- pos1)) 'right-sticky-mark)                 (if (typep (element* paragraphs (1- pos1)) 'right-sticky-mark)
105                     (offset (element* paragraphs (- pos1 2)))                     (offset (element* paragraphs (- pos1 2)))
106                     (offset (element* paragraphs (1- pos1)))))))))                     (offset (element* paragraphs (1- pos1)))))))))
107    
108    (defgeneric end-of-paragraph (mark text-syntax))
109    
110  (defmethod end-of-paragraph (mark (syntax text-syntax))  (defmethod end-of-paragraph (mark (syntax text-syntax))
111    (with-slots (paragraphs) syntax    (with-slots (paragraphs) syntax
112       (let* ((nb-paragraphs (nb-elements paragraphs))      (let ((pos1 (index-of-mark-after-offset
113              (pos2 nb-paragraphs)                   paragraphs
114              (pos1 0)                   ;; if mark is at paragraph-end, jump to end of next
115              (offset (offset mark)))                   ;; paragraph
116         (loop until (= pos1 pos2)                   (1+ (offset mark)))))
117               do (if (mark<= (element* paragraphs (floor (+ pos1 pos2) 2)) offset)        (when (< pos1 (nb-elements paragraphs))
                     (setf pos1 (floor (+ pos1 1 pos2) 2))  
                     (setf pos2 (floor (+ pos1 pos2) 2))))  
        (when (< pos1 nb-paragraphs)  
118           (setf (offset mark)           (setf (offset mark)
119                 (if (typep (element* paragraphs pos1) 'left-sticky-mark)                 (if (typep (element* paragraphs pos1) 'left-sticky-mark)
120                     (offset (element* paragraphs (1+ pos1)))                     (offset (element* paragraphs (1+ pos1)))

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

  ViewVC Help
Powered by ViewVC 1.1.5