suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix WXME bug related to inserting an empty string

Browse Source 
svn: r15126
This commit is contained in:
Matthew Flatt 2009-06-09 21:20:31 +00:00
parent 6924089210
commit eac11bad65
4 changed files with 32 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
collects/mred/private/wxme/editor.ss
View File

@ -638,8 +638,7 @@
(let ([accum? (this . is-a? . text%)]) (let ([accum? (this . is-a? . text%)])
(let ([accum (let ([accum
(for/fold ([accum null]) ([i (in-range num-snips)] #:when accum) (for/fold ([accum null]) ([i (in-range num-snips)] #:when accum)
(let-boxes ([n 0]) (let ([n (send f get-exact)])
(send f get n)
(let ([sclass (if (n . >= . 0) (let ([sclass (if (n . >= . 0)
(send (send f get-s-scl) find-by-map-position f n) (send (send f get-s-scl) find-by-map-position f n)
#f)]) ; -1 => unknown #f)]) ; -1 => unknown
@ -665,20 +664,28 @@
(or (or
(send s-style-list map-index-to-style f style-index (unbox list-id)) (send s-style-list map-index-to-style f style-index (unbox list-id))
(send s-style-list basic-style))) (send s-style-list basic-style)))
(let ([accum (let* ([zero-length? (zero? (snip->count snip))]
(if accum? [accum
(cons snip accum) (if zero-length?
(do-read-insert snip))]) ;; 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 (and
accum accum
(let ([data (read-buffer-data f)]) (let ([data (read-buffer-data f)])
(and (and
(send f ok?) (send f ok?)
(let ([accum (let ([accum
(if accum? (if zero-length?
(cons (cons (car accum) data) (cdr accum)) accum
(when data (if accum?
(set-snip-data snip data)))]) (cons (cons (car accum) data) (cdr accum))
(when data
(set-snip-data snip data))))])
(and (and
accum accum
(begin (begin

2
collects/mred/private/wxme/snip.ss
View File

@ -551,7 +551,7 @@
(send f put (bytes-length bytes) bytes)))) (send f put (bytes-length bytes) bytes))))
(define/public (s-read len f) (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) (when ((string-length s-buffer) . < . len)
(set! s-buffer (make-string (* 2 len)))) (set! s-buffer (make-string (* 2 len))))
(set! s-dtext 0) (set! s-dtext 0)

4
collects/mred/private/wxme/stream.ss
View File

@ -772,8 +772,8 @@
(send f write-bytes (if (string? s) (string->bytes/latin-1 s) s))) (send f write-bytes (if (string? s) (string->bytes/latin-1 s) s)))
(when (positive? col) (when (positive? col)
(show #"\n")) (show #"\n"))
(show #"#|\n This file is in plt scheme editor format.\n") (show #"#|\n This file uses the PLT Scheme editor format.\n")
(show (format " Open this file in dr-scheme version ~a or later to read it.\n" (version))) (show (format " Open this file in DrScheme version ~a or later to read it.\n" (version)))
(show #"\n") (show #"\n")
(show #" Most likely, it was created by saving a program in DrScheme,\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") (show #" and it probably contains a program with non-text elements\n")

17
collects/mred/private/wxme/text.ss
View File

@ -244,10 +244,14 @@
(unless (eq? last-line (mline-last (unbox line-root-box))) (unless (eq? last-line (mline-last (unbox line-root-box)))
(error who "bad last line")) (error who "bad last line"))
(let loop ([line first-line] (let loop ([line first-line]
[snip snips]) [snip snips]
[snip-num 0])
(unless (eq? snips (mline-snip first-line)) (unless (eq? snips (mline-snip first-line))
(error who "bad start snip")) (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)) (unless (eq? line (snip->line snip))
(error who "snip's line is wrong: ~s ~s" snip (snip->line snip))) (error who "snip's line is wrong: ~s ~s" snip (snip->line snip)))
(if (eq? snip (mline-last-snip line)) (if (eq? snip (mline-last-snip line))
@ -255,14 +259,14 @@
(begin (begin
(unless (has-flag? (snip->flags snip) NEWLINE) (unless (has-flag? (snip->flags snip) NEWLINE)
(error who "strange line ending")) (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) (unless (eq? last-snip snip)
(error who "bad last snip"))) (error who "bad last snip")))
(begin (begin
(when (or (has-flag? (snip->flags snip) NEWLINE) (when (or (has-flag? (snip->flags snip) NEWLINE)
(has-flag? (snip->flags snip) HARD-NEWLINE)) (has-flag? (snip->flags snip) HARD-NEWLINE))
(error who "mid-line NEWLINE")) (error who "mid-line NEWLINE"))
(sloop (snip->next snip)))))) (sloop (snip->next snip) (add1 snip-num))))))
#t) #t)
(define caret-style #f) (define caret-style #f)
@ -1215,7 +1219,8 @@
(unless (or write-locked? (unless (or write-locked?
s-user-locked? s-user-locked?
(start . < . 0)) (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 ;; turn off pending style, if it doesn't apply
(when caret-style (when caret-style
(when (or (not (equal? end start)) (not (= startpos start))) (when (or (not (equal? end start)) (not (= startpos start)))
@ -1296,6 +1301,8 @@
(unless s-modified? (unless s-modified?
(set-modified #t)) (set-modified #t))
(assert (consistent-snip-lines 'pre-after-insert))
(after-insert start addlen)))] (after-insert start addlen)))]
[fail-finish [fail-finish
(lambda () (lambda ()