From eac11bad6503bc7f8ab3554d41ef7af8516f988d Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 9 Jun 2009 21:20:31 +0000 Subject: [PATCH] fix WXME bug related to inserting an empty string svn: r15126 --- collects/mred/private/wxme/editor.ss | 27 +++++++++++++++++---------- collects/mred/private/wxme/snip.ss | 2 +- collects/mred/private/wxme/stream.ss | 4 ++-- collects/mred/private/wxme/text.ss | 17 ++++++++++++----- 4 files changed, 32 insertions(+), 18 deletions(-) diff --git a/collects/mred/private/wxme/editor.ss b/collects/mred/private/wxme/editor.ss index 7c9f42b751..716743bc38 100644 --- a/collects/mred/private/wxme/editor.ss +++ b/collects/mred/private/wxme/editor.ss @@ -638,8 +638,7 @@ (let ([accum? (this . is-a? . text%)]) (let ([accum (for/fold ([accum null]) ([i (in-range num-snips)] #:when accum) - (let-boxes ([n 0]) - (send f get n) + (let ([n (send f get-exact)]) (let ([sclass (if (n . >= . 0) (send (send f get-s-scl) find-by-map-position f n) #f)]) ; -1 => unknown @@ -665,20 +664,28 @@ (or (send s-style-list map-index-to-style f style-index (unbox list-id)) (send s-style-list basic-style))) - (let ([accum - (if accum? - (cons snip accum) - (do-read-insert snip))]) + (let* ([zero-length? (zero? (snip->count snip))] + [accum + (if zero-length? + ;; A 0-length snip is a bug in the input, but + ;; we continue anyway to recover from bad + ;; files generated by version 4.2. + accum + (if accum? + (cons snip accum) + (do-read-insert snip)))]) (and accum (let ([data (read-buffer-data f)]) (and (send f ok?) (let ([accum - (if accum? - (cons (cons (car accum) data) (cdr accum)) - (when data - (set-snip-data snip data)))]) + (if zero-length? + accum + (if accum? + (cons (cons (car accum) data) (cdr accum)) + (when data + (set-snip-data snip data))))]) (and accum (begin diff --git a/collects/mred/private/wxme/snip.ss b/collects/mred/private/wxme/snip.ss index 6e1c4fa101..f8188ff802 100644 --- a/collects/mred/private/wxme/snip.ss +++ b/collects/mred/private/wxme/snip.ss @@ -551,7 +551,7 @@ (send f put (bytes-length bytes) bytes)))) (define/public (s-read len f) - (unless (len . <= . 0) + (unless (len . < . 0) ; tolerate a 0-length snip, to be filtered out later (when ((string-length s-buffer) . < . len) (set! s-buffer (make-string (* 2 len)))) (set! s-dtext 0) diff --git a/collects/mred/private/wxme/stream.ss b/collects/mred/private/wxme/stream.ss index 85eb7d139a..58f8f768fd 100644 --- a/collects/mred/private/wxme/stream.ss +++ b/collects/mred/private/wxme/stream.ss @@ -772,8 +772,8 @@ (send f write-bytes (if (string? s) (string->bytes/latin-1 s) s))) (when (positive? col) (show #"\n")) - (show #"#|\n This file is in plt scheme editor format.\n") - (show (format " Open this file in dr-scheme version ~a or later to read it.\n" (version))) + (show #"#|\n This file uses the PLT Scheme editor format.\n") + (show (format " Open this file in DrScheme version ~a or later to read it.\n" (version))) (show #"\n") (show #" Most likely, it was created by saving a program in DrScheme,\n") (show #" and it probably contains a program with non-text elements\n") diff --git a/collects/mred/private/wxme/text.ss b/collects/mred/private/wxme/text.ss index 4f301e2084..c9ce4815e6 100644 --- a/collects/mred/private/wxme/text.ss +++ b/collects/mred/private/wxme/text.ss @@ -244,10 +244,14 @@ (unless (eq? last-line (mline-last (unbox line-root-box))) (error who "bad last line")) (let loop ([line first-line] - [snip snips]) + [snip snips] + [snip-num 0]) (unless (eq? snips (mline-snip first-line)) (error who "bad start snip")) - (let sloop ([snip snip]) + (let sloop ([snip snip][snip-num snip-num]) + (when (zero? (snip->count snip)) + (unless (zero? len) + (error who "snip count is 0 at ~s" snip-num))) (unless (eq? line (snip->line snip)) (error who "snip's line is wrong: ~s ~s" snip (snip->line snip))) (if (eq? snip (mline-last-snip line)) @@ -255,14 +259,14 @@ (begin (unless (has-flag? (snip->flags snip) NEWLINE) (error who "strange line ending")) - (loop (mline-next line) (snip->next snip))) + (loop (mline-next line) (snip->next snip) (add1 snip-num))) (unless (eq? last-snip snip) (error who "bad last snip"))) (begin (when (or (has-flag? (snip->flags snip) NEWLINE) (has-flag? (snip->flags snip) HARD-NEWLINE)) (error who "mid-line NEWLINE")) - (sloop (snip->next snip)))))) + (sloop (snip->next snip) (add1 snip-num)))))) #t) (define caret-style #f) @@ -1215,7 +1219,8 @@ (unless (or write-locked? s-user-locked? (start . < . 0)) - (let ([start (min start len)]) + (let ([start (min start len)] + [str (and str (positive? (string-length str)) str)]) ;; turn off pending style, if it doesn't apply (when caret-style (when (or (not (equal? end start)) (not (= startpos start))) @@ -1295,6 +1300,8 @@ (unless s-modified? (set-modified #t)) + + (assert (consistent-snip-lines 'pre-after-insert)) (after-insert start addlen)))] [fail-finish