Adjusted the module-reader to handler editor objects as object-names of ports.

svn: r10470
This commit is contained in:
Danny Yoo 2008-06-27 03:26:44 +00:00
parent ca7188be1e
commit e16ba1b779

View File

@ -1,9 +1,11 @@
(module module-reader scheme/base
(provide (rename-out [provide-module-reader #%module-begin]
(require scheme/class)
(provide (rename-out [provide-module-reader #%module-begin]
[wrap wrap-read-all]))
(define-syntax provide-module-reader
(define-syntax provide-module-reader
(syntax-rules ()
[(_ lib)
(#%module-begin
@ -17,7 +19,7 @@
(wrap 'lib in (lambda (in) (read-syntax src in))
modpath src line col pos)))]))
(define (wrap lib port read modpath src line col pos)
(define (wrap lib port read modpath src line col pos)
(let ([body
(let loop ([a null])
(let ([v (read port)])
@ -25,11 +27,21 @@
(reverse a)
(loop (cons v a)))))])
(let* ([p-name (object-name port)]
[name (if (path? p-name)
[p-name
(cond [(and (object? p-name)
(method-in-interface? 'get-port-name (object-interface p-name)))
(send p-name get-port-name)]
[(and (object? p-name)
(method-in-interface? 'get-filename (object-interface p-name)))
(send p-name get-filename)]
[else p-name])]
[name (cond
[(path? p-name)
(let-values ([(base name dir?) (split-path p-name)])
(string->symbol
(path->string (path-replace-suffix name #""))))
'page)]
(path->string (path-replace-suffix name #""))))]
[else
'page])]
[tag-src (lambda (v)
(if (syntax? modpath)
(datum->syntax #f