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

reference-manual work

Browse Source 
svn: r6480

original commit: eeaa856ff139c871299f9452402733cd7bf18269
This commit is contained in:
Matthew Flatt 2007-06-05 06:44:39 +00:00
parent 0a11f1f1ee
commit ef13a0dbcc
3 changed files with 62 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

79
collects/scribble/manual.ss
View File

@ -137,12 +137,14 @@
;; ----------------------------------------
(provide defproc defproc* defstruct defthing defform defform/none
(provide defproc defproc* defstruct defthing defform defform* defform/none
specsubform specsubform/inline
var svar void-const)
var svar void-const undefined-const)
(define (void-const)
(schemefont "#<void>"))
(define void-const
(schemeresultfont "#<void>"))
(define undefined-const
(schemeresultfont "#<undefined>"))
(define dots0
(make-element #f (list "...")))
@ -161,9 +163,9 @@
(syntax-rules ()
[(_ name fields desc ...)
(*defstruct 'name 'fields (lambda () (list desc ...)))]))
(define-syntax (defform stx)
(define-syntax (defform* stx)
(syntax-case stx ()
[(_ spec desc ...)
[(_ [spec spec1 ...] desc ...)
(with-syntax ([new-spec
(syntax-case #'spec ()
[(name . rest)
@ -174,11 +176,17 @@
#'name)
#'rest)
#'spec)])])
#'(*defform #t 'spec (lambda (x) (schemeblock0 new-spec)) (lambda () (list desc ...))))]))
#'(*defforms #t '(spec spec1 ...)
(list (lambda (x) (schemeblock0 new-spec))
(lambda (ignored) (schemeblock0 spec1)) ...)
(lambda () (list desc ...))))]))
(define-syntax (defform stx)
(syntax-case stx ()
[(_ spec desc ...) #'(defform* [spec] desc ...)]))
(define-syntax (defform/none stx)
(syntax-case stx ()
[(_ spec desc ...)
#'(*defform #f 'spec (lambda (ignored) (schemeblock0 spec)) (lambda () (list desc ...)))]))
#'(*defforms #f '(spec) (list (lambda (ignored) (schemeblock0 spec))) (lambda () (list desc ...)))]))
(define-syntax specsubform
(syntax-rules ()
[(_ spec desc ...)
@ -383,35 +391,42 @@
(define (meta-symbol? s) (memq s '(... ...+ ?)))
(define (*defform kw? form form-proc content-thunk)
(define (*defforms kw? forms form-procs content-thunk)
(parameterize ([current-variable-list
(let loop ([form (if kw? (cdr form) form)])
(cond
[(symbol? form) (if (meta-symbol? form)
null
(list form))]
[(pair? form) (append (loop (car form))
(loop (cdr form)))]
[else null]))])
(apply
append
(map (lambda (form)
(let loop ([form (if kw? (cdr form) form)])
(cond
[(symbol? form) (if (meta-symbol? form)
null
(list form))]
[(pair? form) (append (loop (car form))
(loop (cdr form)))]
[else null])))
forms))])
(make-splice
(cons
(make-table
'boxed
(list
(list (make-flow
(list
((or form-proc
(lambda (x)
(make-paragraph
(list
(to-element
`(,x
. ,(cdr form)))))))
(and kw?
(make-target-element
#f
(list (to-element (car form)))
(register-scheme-form-definition (car form))))))))))
(map (lambda (form form-proc)
(list
(make-flow
(list
((or form-proc
(lambda (x)
(make-paragraph
(list
(to-element
`(,x
. ,(cdr form)))))))
(and kw?
(eq? form (car forms))
(make-target-element
#f
(list (to-element (car form)))
(register-scheme-form-definition (car form)))))))))
forms form-procs))
(content-thunk)))))
(define (*specsubform form form-thunk content-thunk)

20
collects/scribble/scheme.ss
View File

@ -28,19 +28,19 @@
(define opt-color "schemeopt")
(define current-keyword-list
(make-parameter '(define let let* letrec require provide let-values
lambda new send if cond begin else and or
(make-parameter '(define require provide
new send if cond begin else and or
define-syntax syntax-rules define-struct
quote quasiquote unquote unquote-splicing
syntax quasisyntax unsyntax unsyntax-splicing
for/fold for/list for*/list for for/and for/or for* for*/or for*/and for*/fold
for-values for*/list-values for/first for/last
set!)))
(define current-variable-list
(make-parameter null))
(define defined-names (make-hash-table))
(define-struct (sized-element element) (length))
(define (typeset c multi-line? prefix1 prefix color?)
(let* ([c (syntax-ize c 0)]
[content null]
@ -63,7 +63,10 @@
(define out
(case-lambda
[(v cls)
(out v cls (if (string? v) (string-length v) 1))]
(out v cls (cond
[(string? v) (string-length v)]
[(sized-element? v) (sized-element-length v)]
[else 1]))]
[(v cls len)
(unless (equal? v "")
(if (equal? v "\n")
@ -125,12 +128,13 @@
(datum->syntax-object
a
(let ([val? (positive? quote-depth)])
(make-element
(make-sized-element
(if val? value-color #f)
(list
(make-element (if val? value-color paren-color) '(". "))
(typeset a #f "" "" (not val?))
(make-element (if val? value-color paren-color) '(" .")))))
(make-element (if val? value-color paren-color) '(" .")))
(+ (syntax-span a) 4)))
(list (syntax-source a)
(syntax-line a)
(- (syntax-column a) 2)
@ -327,7 +331,7 @@
(out (if (and (identifier? c)
color?
(quote-depth . <= . 0)
(not (or it? is-kw? is-var?)))
(not (or it? is-var?)))
(make-delayed-element
(lambda (renderer sec ht)
(let* ([vtag (register-scheme-definition (syntax-e c))]

6
collects/scribblings/scribble/manual.scrbl
View File

@ -307,9 +307,9 @@ for the index entry.}
@defthing[PLaneT string?]{@scheme["PLaneT"] (to help make sure you get
the letters in the right case).}
@defproc[(void-const) any/c]{Returns @scheme["void"], as opposed to
@scheme[(scheme void)]---but we may eventually find a clearer way to
refer to @void-const in prose.}
@defthing[void-const element?]{Returns an element for @|void-const|.}
@defthing[undefined-const element?]{Returns an element for @|undefined-const|.}
@defproc[(centerline [pre-flow any/c] ...0) table?]{Produces a
centered table with the @scheme[pre-flow] parsed by