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 specsubform specsubform/inline
var svar void-const) var svar void-const undefined-const)
(define (void-const) (define void-const
(schemefont "#<void>")) (schemeresultfont "#<void>"))
(define undefined-const
(schemeresultfont "#<undefined>"))
(define dots0 (define dots0
(make-element #f (list "..."))) (make-element #f (list "...")))
@ -161,9 +163,9 @@
(syntax-rules () (syntax-rules ()
[(_ name fields desc ...) [(_ name fields desc ...)
(*defstruct 'name 'fields (lambda () (list desc ...)))])) (*defstruct 'name 'fields (lambda () (list desc ...)))]))
(define-syntax (defform stx) (define-syntax (defform* stx)
(syntax-case stx () (syntax-case stx ()
[(_ spec desc ...) [(_ [spec spec1 ...] desc ...)
(with-syntax ([new-spec (with-syntax ([new-spec
(syntax-case #'spec () (syntax-case #'spec ()
[(name . rest) [(name . rest)
@ -174,11 +176,17 @@
#'name) #'name)
#'rest) #'rest)
#'spec)])]) #'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) (define-syntax (defform/none stx)
(syntax-case stx () (syntax-case stx ()
[(_ spec desc ...) [(_ 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 (define-syntax specsubform
(syntax-rules () (syntax-rules ()
[(_ spec desc ...) [(_ spec desc ...)
@ -383,35 +391,42 @@
(define (meta-symbol? s) (memq s '(... ...+ ?))) (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 (parameterize ([current-variable-list
(let loop ([form (if kw? (cdr form) form)]) (apply
(cond append
[(symbol? form) (if (meta-symbol? form) (map (lambda (form)
null (let loop ([form (if kw? (cdr form) form)])
(list form))] (cond
[(pair? form) (append (loop (car form)) [(symbol? form) (if (meta-symbol? form)
(loop (cdr form)))] null
[else null]))]) (list form))]
[(pair? form) (append (loop (car form))
(loop (cdr form)))]
[else null])))
forms))])
(make-splice (make-splice
(cons (cons
(make-table (make-table
'boxed 'boxed
(list (map (lambda (form form-proc)
(list (make-flow (list
(list (make-flow
((or form-proc (list
(lambda (x) ((or form-proc
(make-paragraph (lambda (x)
(list (make-paragraph
(to-element (list
`(,x (to-element
. ,(cdr form))))))) `(,x
(and kw? . ,(cdr form)))))))
(make-target-element (and kw?
#f (eq? form (car forms))
(list (to-element (car form))) (make-target-element
(register-scheme-form-definition (car form)))))))))) #f
(list (to-element (car form)))
(register-scheme-form-definition (car form)))))))))
forms form-procs))
(content-thunk))))) (content-thunk)))))
(define (*specsubform form form-thunk 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 opt-color "schemeopt")
(define current-keyword-list (define current-keyword-list
(make-parameter '(define let let* letrec require provide let-values (make-parameter '(define require provide
lambda new send if cond begin else and or new send if cond begin else and or
define-syntax syntax-rules define-struct define-syntax syntax-rules define-struct
quote quasiquote unquote unquote-splicing quote quasiquote unquote unquote-splicing
syntax quasisyntax unsyntax unsyntax-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!))) set!)))
(define current-variable-list (define current-variable-list
(make-parameter null)) (make-parameter null))
(define defined-names (make-hash-table)) (define defined-names (make-hash-table))
(define-struct (sized-element element) (length))
(define (typeset c multi-line? prefix1 prefix color?) (define (typeset c multi-line? prefix1 prefix color?)
(let* ([c (syntax-ize c 0)] (let* ([c (syntax-ize c 0)]
[content null] [content null]
@ -63,7 +63,10 @@
(define out (define out
(case-lambda (case-lambda
[(v cls) [(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) [(v cls len)
(unless (equal? v "") (unless (equal? v "")
(if (equal? v "\n") (if (equal? v "\n")
@ -125,12 +128,13 @@
(datum->syntax-object (datum->syntax-object
a a
(let ([val? (positive? quote-depth)]) (let ([val? (positive? quote-depth)])
(make-element (make-sized-element
(if val? value-color #f) (if val? value-color #f)
(list (list
(make-element (if val? value-color paren-color) '(". ")) (make-element (if val? value-color paren-color) '(". "))
(typeset a #f "" "" (not val?)) (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) (list (syntax-source a)
(syntax-line a) (syntax-line a)
(- (syntax-column a) 2) (- (syntax-column a) 2)
@ -327,7 +331,7 @@
(out (if (and (identifier? c) (out (if (and (identifier? c)
color? color?
(quote-depth . <= . 0) (quote-depth . <= . 0)
(not (or it? is-kw? is-var?))) (not (or it? is-var?)))
(make-delayed-element (make-delayed-element
(lambda (renderer sec ht) (lambda (renderer sec ht)
(let* ([vtag (register-scheme-definition (syntax-e c))] (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 @defthing[PLaneT string?]{@scheme["PLaneT"] (to help make sure you get
the letters in the right case).} the letters in the right case).}
@defproc[(void-const) any/c]{Returns @scheme["void"], as opposed to @defthing[void-const element?]{Returns an element for @|void-const|.}
@scheme[(scheme void)]---but we may eventually find a clearer way to
refer to @void-const in prose.} @defthing[undefined-const element?]{Returns an element for @|undefined-const|.}
@defproc[(centerline [pre-flow any/c] ...0) table?]{Produces a @defproc[(centerline [pre-flow any/c] ...0) table?]{Produces a
centered table with the @scheme[pre-flow] parsed by centered table with the @scheme[pre-flow] parsed by