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

improved error message slightly

Browse Source 
svn: r16305
This commit is contained in:
Robby Findler 2009-10-13 16:00:01 +00:00
parent c90766affb
commit e5d76b0095
1 changed files with 25 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2544,32 +2544,38 @@
'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?)))
(define/private (do-insert-file who f format clear-styles?) (define/private (do-insert-file who f fmt clear-styles?)
(let ([format (let ([fmt
(cond (cond
[(or (eq? 'guess format) (eq? 'same format) (eq? 'copy format)) [(or (eq? 'guess fmt) (eq? 'same fmt) (eq? 'copy fmt))
(if (not (detect-wxme-file who f #t)) (if (not (detect-wxme-file who f #t))
'text 'text
'standard)] 'standard)]
[else format])]) [else fmt])])
(let ([fileerr? (let ([fileerr?
(cond (cond
[(eq? 'standard format) [(eq? 'standard fmt)
(if (not (detect-wxme-file who f #f)) (if (not (detect-wxme-file who f #f))
(error who "not a WXME file") (error who "not a WXME file")
(let* ([b (make-object editor-stream-in-file-base% f)] (let* ([b (make-object editor-stream-in-file-base% f)]
[mf (make-object editor-stream-in% b)]) [mf (make-object editor-stream-in% b)])
(not (and (read-editor-version mf b #f #t) (or (and (not (read-editor-version mf b #f #t))
(read-editor-global-header mf) 'read-editor-version-failed)
(send mf ok?) (and (not (read-editor-global-header mf))
(read-from-file mf clear-styles?) 'read-editor-global-head-failed)
(read-editor-global-footer mf) (and (not (send mf ok?))
'mf-not-ok)
(and (not (read-from-file mf clear-styles?))
'read-from-file-failed)
(and (not (read-editor-global-footer mf))
'read-editor-gobal-footer-failed)
(begin (begin
;; if STD-STYLE wasn't loaded, re-create it: ;; if STD-STYLE wasn't loaded, re-create it:
(send s-style-list new-named-style "Standard" (send s-style-list basic-style)) (send s-style-list new-named-style "Standard" (send s-style-list basic-style))
(send mf ok?))))))] (and (not (send mf ok?))
[(or (eq? format 'text) (eq? format 'text-force-cr)) 'mf-not-okay-after-adding-standard-style)))))]
[(or (eq? fmt 'text) (eq? fmt 'text-force-cr))
(let ([s (make-string 1024)]) (let ([s (make-string 1024)])
(let loop ([saved-cr? #f]) (let loop ([saved-cr? #f])
(let ([len (read-string! s f)]) (let ([len (read-string! s f)])
@ -2587,9 +2593,11 @@
#f])]) #f])])
(when fileerr? (when fileerr?
(error who "error loading the file")) (error who "error loading the file~a" (if (boolean? fileerr?)
""
(format " (~a)" fileerr?))))
format))) fmt)))
(def/override (save-port [output-port? f] (def/override (save-port [output-port? f]
[(symbol-in guess same copy standard text text-force-cr) [format 'same]] [(symbol-in guess same copy standard text text-force-cr) [format 'same]]