lift the restriction that the port passed to open-input-text-editor
cannot change its revision number during reading This restriction was enforced only for editors that have non string-snip% snips. The restriction was in place because the implementation strategy was to chain thru the snips in the editor using (send snip next) and that isn't safe if the revision number changes. The lifting of the restriction is implemented by tracking the position in the editor where the last snip ended and, if the revision number changes, starting over trying to get a snip from that position. This has the effect that, if the revision number never changes, the code should behave the same as it was doing before (so hopefully any new bugs I've introduced in this commit will only show up if the old implementation would have raised an error) Also, exploit the lifting of this restriction in the colorer so it doesn't to restart the port during to coloring that happens along with the parsing
This commit is contained in:
parent
6c760b086f
commit
95841b9303
|
@ -320,9 +320,6 @@ added get-regions
|
|||
(define re-tokenize-lexer-mode-argument #f)
|
||||
(define/private (continue-re-tokenize start-time did-something?)
|
||||
(cond
|
||||
[(not (= rev (get-revision-number)))
|
||||
(c-log "revision number changed unexpectedly")
|
||||
#f]
|
||||
[(and did-something? ((+ start-time 20) . <= . (current-inexact-milliseconds)))
|
||||
#f]
|
||||
[else
|
||||
|
|
|
@ -91,15 +91,17 @@
|
|||
void))))
|
||||
;; General case, which handles non-text context:
|
||||
(with-method ([gsp (text get-snip-position)]
|
||||
[grn (text get-revision-number)])
|
||||
[grn (text get-revision-number)]
|
||||
[fs (text find-snip)])
|
||||
(let-values ([(pipe-r pipe-w) (make-pipe)])
|
||||
(let* ([get-text-generic (generic wx:snip% get-text)]
|
||||
[get-count-generic (generic wx:snip% get-count)]
|
||||
[next-generic (generic wx:snip% next)]
|
||||
[revision (grn)]
|
||||
[next? #f]
|
||||
[snip-end-position (+ (gsp snip) (send-generic snip get-count-generic))]
|
||||
[update-str-to-snip
|
||||
(lambda (to-str)
|
||||
(lambda (skip to-str)
|
||||
(if snip
|
||||
(let ([snip-start (gsp snip)])
|
||||
(cond
|
||||
|
@ -109,8 +111,9 @@
|
|||
0]
|
||||
[(is-a? snip wx:string-snip%)
|
||||
(set! next? #t)
|
||||
(let ([c (min (send-generic snip get-count-generic) (- end snip-start))])
|
||||
(write-string (send-generic snip get-text-generic 0 c) pipe-w)
|
||||
(let ([c (min (- (send-generic snip get-count-generic) skip)
|
||||
(- end snip-start))])
|
||||
(write-string (send-generic snip get-text-generic skip c) pipe-w)
|
||||
(read-bytes-avail!* to-str pipe-r))]
|
||||
[else
|
||||
(set! next? #f)
|
||||
|
@ -120,13 +123,18 @@
|
|||
0)))]
|
||||
[next-snip
|
||||
(lambda (to-str)
|
||||
(unless (= revision (grn))
|
||||
(raise-arguments-error
|
||||
'text-input-port
|
||||
"editor has changed since port was opened"
|
||||
"editor" text))
|
||||
(set! snip (send-generic snip next-generic))
|
||||
(update-str-to-snip to-str))]
|
||||
(cond
|
||||
[(= revision (grn))
|
||||
(set! snip (send-generic snip next-generic))
|
||||
(set! snip-end-position (and snip (+ (gsp snip) (send-generic snip get-count-generic))))
|
||||
(update-str-to-snip 0 to-str)]
|
||||
[else
|
||||
(set! revision (grn))
|
||||
(define old-snip-end-position snip-end-position)
|
||||
(set! snip (fs snip-end-position 'after-or-none))
|
||||
(define snip-start-position (and snip (gsp snip)))
|
||||
(set! snip-end-position (and snip (+ snip-start-position (send-generic snip get-count-generic))))
|
||||
(update-str-to-snip (if snip (- old-snip-end-position snip-start-position) 0) to-str)]))]
|
||||
[read-chars (lambda (to-str)
|
||||
(cond
|
||||
[next?
|
||||
|
@ -171,7 +179,7 @@
|
|||
(- end snip-start))])
|
||||
(set! next? #t)
|
||||
(display (send-generic snip get-text-generic skip c) pipe-w))
|
||||
(update-str-to-snip empty-string))
|
||||
(update-str-to-snip 0 empty-string))
|
||||
port)))))))
|
||||
|
||||
(define (jump-to-submodule in-port expected-module k)
|
||||
|
|
|
@ -304,6 +304,62 @@
|
|||
(test #f 'peek-t (peek-byte-or-special i 0))
|
||||
(test 49 'read-1 (peek-byte-or-special i 1))))
|
||||
|
||||
(let ()
|
||||
(define t (new text%))
|
||||
(send t insert "aa\nbb\ncc\ndd\nee\nff\n")
|
||||
(send t insert (make-object image-snip%
|
||||
(collection-file-path "recycle.png" "icons")))
|
||||
|
||||
(define p (open-input-text-editor t))
|
||||
|
||||
(define rev-at-start (send t get-revision-number))
|
||||
(define line1 (read-line p))
|
||||
|
||||
(define sl (send t get-style-list))
|
||||
(define d (make-object style-delta% 'change-bold))
|
||||
(define s (send sl find-or-create-style (send sl basic-style) d))
|
||||
(send t change-style s 6 7)
|
||||
|
||||
(define rev-after-cs (send t get-revision-number))
|
||||
(define line2 (read-line p))
|
||||
|
||||
(test #t 'revision-changed (> rev-after-cs rev-at-start))
|
||||
(test "aa" 'revision-changed-line1 line1)
|
||||
(test "bb" 'revision-changed-line1 line2))
|
||||
|
||||
(let ()
|
||||
(define t (new text%))
|
||||
(send t insert "abcd\n")
|
||||
(send t insert (make-object image-snip%
|
||||
(collection-file-path "recycle.png" "icons")))
|
||||
|
||||
(define (count-snips)
|
||||
(let loop ([s (send t find-first-snip)])
|
||||
(cond
|
||||
[s (+ 1 (loop (send s next)))]
|
||||
[else 0])))
|
||||
|
||||
(send t split-snip 1)
|
||||
(define before-snip-count (count-snips))
|
||||
(define rev-at-start (send t get-revision-number))
|
||||
|
||||
(define p (open-input-text-editor t))
|
||||
|
||||
(define char1 (read-char p))
|
||||
|
||||
(define s (send (send t get-style-list) basic-style))
|
||||
(send t change-style s 0 4)
|
||||
(define after-snip-count (count-snips))
|
||||
(define rev-after-cs (send t get-revision-number))
|
||||
|
||||
(define chars (string (read-char p) (read-char p) (read-char p)))
|
||||
|
||||
(test 4 'snips-joined1 before-snip-count)
|
||||
(test 3 'snips-joined2 after-snip-count)
|
||||
(test #t 'snips-joined3 (> rev-after-cs rev-at-start))
|
||||
(test #\a 'snips-joined4 char1)
|
||||
(test "bcd" 'snips-joined5 chars))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Snips and Streams ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
@ -325,6 +381,7 @@
|
|||
snip))
|
||||
(super-instantiate ())))
|
||||
|
||||
|
||||
(define snip-class (make-object (mk-number-snip-class% #t)))
|
||||
(send snip-class set-classname (format "~s" `(lib "number-snip.ss" "drscheme" "private")))
|
||||
(send (get-the-snip-class-list) add snip-class)
|
||||
|
|
Loading…
Reference in New Issue
Block a user