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

split part of scheme/file into scheme/path, document them

Browse Source 
svn: r7938

original commit: ca5a7c5560ee5eb26252c239dbf33f672a9749ac
This commit is contained in:
Matthew Flatt 2007-12-10 17:59:26 +00:00
parent 786d6dce57
commit 302ea79cd5
4 changed files with 32 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/scribble/base-render.ss
View File

@ -3,7 +3,8 @@
(require "struct.ss" (require "struct.ss"
mzlib/class mzlib/class
mzlib/serialize mzlib/serialize
scheme/file) scheme/file
scheme/path)
(provide render%) (provide render%)

1
collects/scribble/html-render.ss
View File

@ -2,6 +2,7 @@
(module html-render scheme/base (module html-render scheme/base
(require "struct.ss" (require "struct.ss"
scheme/class scheme/class
scheme/path
scheme/file scheme/file
mzlib/runtime-path mzlib/runtime-path
setup/main-doc setup/main-doc

35
collects/scribble/manual.ss
View File

@ -510,6 +510,23 @@
"bad argument form" "bad argument form"
#'arg)])) #'arg)]))
(define-syntax (arg-default stx)
(syntax-case stx (... ...+ _...superclass-args...)
[(_ [id contract])
(identifier? #'id)
#'#f]
[(_ [id contract val])
(identifier? #'id)
#'(schemeblock0 val)]
[(_ [kw id contract])
(keyword? (syntax-e #'kw))
#'#f]
[(_ [kw id contract val])
(keyword? (syntax-e #'kw))
#'(schemeblock0 val)]
[else
#'#f]))
(define-syntax defproc (define-syntax defproc
(syntax-rules () (syntax-rules ()
[(_ (id arg ...) result desc ...) [(_ (id arg ...) result desc ...)
@ -523,6 +540,7 @@
(list (quote-syntax/loc id) ...) (list (quote-syntax/loc id) ...)
'[(id arg ...) ...] '[(id arg ...) ...]
(list (list (lambda () (arg-contract arg)) ...) ...) (list (list (lambda () (arg-contract arg)) ...) ...)
(list (list (lambda () (arg-default arg)) ...) ...)
(list (lambda () (schemeblock0 result)) ...) (list (lambda () (schemeblock0 result)) ...)
(lambda () (list desc ...)))])) (lambda () (list desc ...)))]))
(define-syntax defstruct (define-syntax defstruct
@ -745,7 +763,7 @@
(or (get-exporting-libraries render part ri) null))))) (or (get-exporting-libraries render part ri) null)))))
(define (*defproc mode within-id (define (*defproc mode within-id
stx-ids prototypes arg-contractss result-contracts content-thunk) stx-ids prototypes arg-contractss arg-valss result-contracts content-thunk)
(let ([spacer (hspace 1)] (let ([spacer (hspace 1)]
[has-optional? (lambda (arg) [has-optional? (lambda (arg)
(and (pair? arg) (and (pair? arg)
@ -803,7 +821,7 @@
(apply (apply
append append
(map (map
(lambda (stx-id prototype arg-contracts result-contract first?) (lambda (stx-id prototype arg-contracts arg-vals result-contract first?)
(let*-values ([(required optional more-required) (let*-values ([(required optional more-required)
(let loop ([a (cdr prototype)][r-accum null]) (let loop ([a (cdr prototype)][r-accum null])
(if (or (null? a) (if (or (null? a)
@ -992,7 +1010,7 @@
(list end))))) (list end)))))
null) null)
(apply append (apply append
(map (lambda (v arg-contract) (map (lambda (v arg-contract arg-val)
(cond (cond
[(pair? v) [(pair? v)
(let* ([v (if (keyword? (car v)) (let* ([v (if (keyword? (car v))
@ -1001,8 +1019,9 @@
[arg-cont (arg-contract)] [arg-cont (arg-contract)]
[base-len (+ 5 (string-length (symbol->string (car v))) [base-len (+ 5 (string-length (symbol->string (car v)))
(flow-element-width arg-cont))] (flow-element-width arg-cont))]
[arg-val (and arg-val (arg-val))]
[def-len (if (has-optional? v) [def-len (if (has-optional? v)
(string-length (format "~a" (caddr v))) (flow-element-width arg-val)
0)] 0)]
[base-list [base-list
(list (list
@ -1028,7 +1047,7 @@
(to-flow spacer) (to-flow spacer)
(to-flow "=") (to-flow "=")
(to-flow spacer) (to-flow spacer)
(to-flow (to-element (caddr v))))))) (make-flow (list arg-val))))))
(make-table-if-necessary (make-table-if-necessary
"argcontract" "argcontract"
(list (list
@ -1039,14 +1058,16 @@
(list (to-flow spacer) (list (to-flow spacer)
(to-flow "=") (to-flow "=")
(to-flow spacer) (to-flow spacer)
(to-flow (to-element (caddr v)))) (make-flow (list arg-val)))
null)))))))))] null)))))))))]
[else null])) [else null]))
(cdr prototype) (cdr prototype)
arg-contracts))))) arg-contracts
arg-vals)))))
stx-ids stx-ids
prototypes prototypes
arg-contractss arg-contractss
arg-valss
result-contracts result-contracts
(let loop ([ps prototypes][accum null]) (let loop ([ps prototypes][accum null])
(cond (cond

2
collects/setup/scribble-index.ss
View File

@ -9,7 +9,7 @@
setup/getinfo setup/getinfo
setup/dirs setup/dirs
mzlib/serialize mzlib/serialize
scheme/file) scheme/path)
(provide load-xref (provide load-xref
xref-render xref-render