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

MrEd-less reading of WXME files (work in progress, but it's mostly there)

Browse Source 
svn: r5393

original commit: 208d160a1bf334912f362cf258c375b55544cd2b
This commit is contained in:
Matthew Flatt 2007-01-18 12:20:57 +00:00
parent cafeb9bbe3
commit a72f2d6b6e
1 changed files with 31 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
collects/mred/private/snipfile.ss
View File

@ -15,18 +15,39 @@
;; snip-class% and editor-data-class% loaders
(define (ok-string-element? m)
(and (string? m)
(regexp-match? #rx"^[-a-zA-Z0-9_. ]+$" m)
(not (string=? m ".."))
(not (string=? m "."))))
(define (ok-lib-path? m)
(and (pair? m)
(eq? 'lib (car m))
(pair? (cdr m))
(list? m)
(andmap ok-string-element? (cdr m))))
(let ([load-one
(lambda (str id %)
(let ([m (with-handlers ([void (lambda (x) #f)])
(let ([m (with-handlers ([exn:fail:read? (lambda (x) #f)])
(and (regexp-match #rx"^[(].*[)]$" str)
(read (open-input-string str))))])
(if (and (list? m)
(eq? 'lib (car m))
(andmap string? (cdr m)))
(let ([result (dynamic-require m id)])
(if (is-a? result %)
result
(error 'load-class "not a ~a% instance" id)))
(let* ([p (open-input-string str)]
[m (read p)])
(and (eof-object? (read p))
m))))])
(if (or (ok-lib-path? m)
(and (list? m)
(= (length m) 2)
(ok-lib-path? (car m)
(ok-lib-path? (cadr m)))))
(let ([m (if (ok-lib-path? m)
m
(car m))])
(let ([result (dynamic-require m id)])
(if (is-a? result %)
result
(error 'load-class "not a ~a% instance" id))))
#f)))])
;; install the getters:
(wx:set-snip-class-getter
@ -233,7 +254,7 @@
(let ([p (open-input-file filename)])
(port-count-lines! p)
(let ([p (cond
[(regexp-match-peek #rx#"^WXME01[0-9][0-9] ## " p)
[(regexp-match-peek #rx#"^(?:#reader(lib\"wxme[.]ss\"\"mred\"))?WXME01[0-9][0-9] ## " p)
(let ([t (make-object text%)])
(send t insert-port p 'standard)
(close-input-port p)