suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

Start revising scribble/text (include temporarily removed).

Browse Source 
svn: r11557

original commit: 60e001000a770d7b668b2029c83201782460157a
This commit is contained in:
Eli Barzilay 2008-09-05 18:53:50 +00:00
parent 8c28c37118
commit 31a7a10dc3
1 changed files with 13 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
collects/scribble/text.ss
View File

@ -1,60 +1,22 @@
#lang scheme/base
(require scheme/promise (for-syntax scheme/base))
(provide (all-from-out scheme/base scheme/promise))
(require scheme/promise)
(define (show x [p (current-output-port)])
(let show ([x x])
;; output
(provide output)
(define (output x [p (current-output-port)])
(let loop ([x x])
(cond [(or (void? x) (not x) (null? x)) (void)]
[(pair? x) (show (car x)) (show (cdr x))]
[(promise? x) (show (force x))]
[(keyword? x) (show (keyword->string x))]
[(and (procedure? x) (procedure-arity-includes? x 0)) (show (x))]
;; display won't work, since it calls us back
;; [else (display x p)]
;; things that are printed directly
[(pair? x) (loop (car x)) (loop (cdr x))]
[(promise? x) (loop (force x))]
[(keyword? x) (loop (keyword->string x))]
[(and (procedure? x) (procedure-arity-includes? x 0)) (loop (x))]
[(bytes? x) (write-bytes x p)]
[(string? x) (write-string x p)]
[(char? x) (write-char x p)]
[(number? x) (write x p)]
[(symbol? x) (display x p)]
;; generic fallback
[else (show (format "~a" x))])))
;; this is too much -- it also changes error messages
;; (global-port-print-handler show)
(port-display-handler (current-output-port) show)
;; the default prints a newline too, avoid that
(current-print display)
;; make it possible to use this language through a repl
;; --> won't work: need an `inside' reader that reads a single expression
;; (require (prefix-in * "text/lang/reader.ss"))
;; (current-prompt-read
;; (lambda () (parameterize ([read-accept-reader #t]) (*read-syntax))))
;; Utilities
(require (prefix-in at: "reader.ss"))
(provide at:read-inside at:read-syntax-inside)
(provide include)
(define-syntax (include stx)
(syntax-case stx ()
[(_ filename)
(let* ([source (syntax-source stx)]
[dir (or (and source
(let-values ([(base file dir?) (split-path source)])
(and (path? base) base)))
(current-load-relative-directory)
(current-directory))])
(with-syntax ([ns (if source
#`(module->namespace #,source)
#'(current-namespace))]
[dir dir])
#'(let ([contents
(with-input-from-file (path->complete-path filename dir)
at:read-syntax-inside)])
(parameterize ([current-namespace ns])
(for ([expr (syntax->list contents)])
(show (eval expr)))))))]))
[else (error 'output "don't know how to render value: ~v" x)]))
(void))