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

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

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

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)))
(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")

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

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