diff --git a/collects/framework/private/color.rkt b/collects/framework/private/color.rkt index e340683e51..ec9a03a91c 100644 --- a/collects/framework/private/color.rkt +++ b/collects/framework/private/color.rkt @@ -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 diff --git a/collects/mred/private/snipfile.rkt b/collects/mred/private/snipfile.rkt index 831dd5ea3d..86113ee5a1 100644 --- a/collects/mred/private/snipfile.rkt +++ b/collects/mred/private/snipfile.rkt @@ -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) diff --git a/collects/tests/gracket/editor.rktl b/collects/tests/gracket/editor.rktl index 41532ae582..d70c33ad1b 100644 --- a/collects/tests/gracket/editor.rktl +++ b/collects/tests/gracket/editor.rktl @@ -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)