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:
Robby Findler 2012-11-02 08:33:40 -05:00
parent 6c760b086f
commit 95841b9303
3 changed files with 77 additions and 15 deletions

View File

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

View File

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

View File

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