fix problems with editor stream reading

svn: r14497

original commit: 9371f69eefe6614460e13e33054c6d05d397474f
This commit is contained in:
Matthew Flatt 2009-04-13 12:37:48 +00:00
parent 1c458d4d32
commit dfd13aa132
3 changed files with 6 additions and 4 deletions

View File

@ -124,7 +124,7 @@
(define undomode? #f) (define undomode? #f)
(define redomode? #f) (define redomode? #f)
(define interceptmode? #f) (define interceptmode? #f)
(define loadoverwritesstyles? #f) (define loadoverwritesstyles? #t)
(field [s-custom-cursor-overrides? #f] (field [s-custom-cursor-overrides? #f]
[s-need-on-display-size? #f]) [s-need-on-display-size? #f])

View File

@ -569,10 +569,10 @@
#t #t
(cond (cond
[(and (pair? boundaries) [(and (pair? boundaries)
((tell) . > . (car boundaries))) (items . > . (car boundaries)))
(set! is-bad? #t) (set! is-bad? #t)
(error 'editor-stream-in% (error 'editor-stream-in%
"overread (caused by file corruption?; ~a vs ~a)" (tell) (car boundaries))] "overread (caused by file corruption?; ~a vs ~a)" items (car boundaries))]
[(send f bad?) [(send f bad?)
(set! is-bad? #t) (set! is-bad? #t)
(error 'editor-stream-in% "stream error")] (error 'editor-stream-in% "stream error")]
@ -587,6 +587,8 @@
(if (read-version . < . 8) (if (read-version . < . 8)
(send f tell) (send f tell)
(let ([pos (send f tell)]) (let ([pos (send f tell)])
(when (not (equal? (hash-ref pos-map items pos) pos))
(error "again"))
(hash-set! pos-map items pos) (hash-set! pos-map items pos)
items))) items)))

View File

@ -2479,7 +2479,7 @@
(def/override (insert-port [input-port? f] (def/override (insert-port [input-port? f]
[(symbol-in guess same copy standard text text-force-cr) [format 'guess]] [(symbol-in guess same copy standard text text-force-cr) [format 'guess]]
[any? [replace-styles? #f]]) [any? [replace-styles? #t]])
(if (or write-locked? s-user-locked?) (if (or write-locked? s-user-locked?)
'guess ;; FIXME: docs say that this is more specific 'guess ;; FIXME: docs say that this is more specific
(do-insert-file (method-name 'text% 'insert-file) f format replace-styles?))) (do-insert-file (method-name 'text% 'insert-file) f format replace-styles?)))