misc-deps
/
racket-ansi
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix bug in find-mark*.

This commit is contained in:
Tony Garnock-Jones 2014-12-27 17:14:30 -05:00
parent 46d97f0926
commit 492f7a3105
1 changed files with 20 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
rmacs/rope.rkt
View File

@ -216,7 +216,7 @@
;; Searches from pos (inclusive) in the direction indicated. ;; Searches from pos (inclusive) in the direction indicated.
;; Pos points to a mark-position, not a character-position. ;; Pos points to a mark-position, not a character-position.
(define (find-mark* r forward? mtype start-pos) (define (find-mark* r forward? mtype start-pos)
(define (search-here r start-pos) (define (search-here r offset start-pos)
(define marks (hash-ref (rope-mark-index r) mtype #f)) (define marks (hash-ref (rope-mark-index r) mtype #f))
(define lo (rope-lo r)) (define lo (rope-lo r))
(if (not marks) (if (not marks)
@ -227,22 +227,21 @@
(if (and (or (not candidate) (if (and (or (not candidate)
(pos-comparer pos (car candidate))) (pos-comparer pos (car candidate)))
(boundary-comparer pos start-pos)) (boundary-comparer pos start-pos))
(cons (+ pos lo) value) (cons (+ pos offset lo) value)
candidate))))) candidate)))))
(define (search r start-pos) (define (search r offset start-pos)
(and r (and r
(set-member? (rope-marks r) mtype) (set-member? (rope-marks r) mtype)
(let-values (((lo hi) (rope-lo+hi r))) (let-values (((lo hi) (rope-lo+hi r)))
(cond (if forward?
[(< start-pos lo) (or (and (< start-pos lo) (search (rope-left r) offset start-pos))
(or (search (rope-left r) start-pos) (and (<= start-pos hi) (search-here r offset (- start-pos lo)))
(and forward? (search-here r (- start-pos lo))))] (search (rope-right r) (+ offset hi) (- start-pos hi)))
[(> start-pos hi) (or (and (> start-pos hi) (search (rope-right r) (+ offset hi) (- start-pos hi)))
(or (search (rope-right r) (- start-pos hi)) (and (>= start-pos lo) (search-here r offset (- start-pos lo)))
(and (not forward?) (search-here r (- start-pos lo))))] (search (rope-left r) offset start-pos)))
[else )))
(search-here r (- start-pos lo))])))) (search r 0 start-pos))
(search r start-pos))
(define (has-mark? r mtype) (define (has-mark? r mtype)
(and r (set-member? (rope-marks r) mtype))) (and r (set-member? (rope-marks r) mtype)))
@ -530,4 +529,12 @@
(check-equal? (map (lambda (i) (compute-range-index i 'default 10)) (check-equal? (map (lambda (i) (compute-range-index i 'default 10))
(list 0 10 3 -1 -2 11 12 -8 -9 -10 -11 -12)) (list 0 10 3 -1 -2 11 12 -8 -9 -10 -11 -12))
(list 0 10 3 9 8 10 10 2 1 0 0 0)) (list 0 10 3 9 8 10 10 2 1 0 0 0))
(let* ((r (rope-append (string->rope (make-string 10 #\a))
(string->rope (make-string (* 2 *glom-up-to*) #\z))))
(_ (check-equal? (rope-size r) (+ 10 (* 2 *glom-up-to*))))
(r (set-mark r mtype1 (rope-size r) #t))
(r (splay-to-pos 'testing r 0))
(pos (find-mark-pos r mtype1)))
(check-equal? pos 266))
) )