From ef13a0dbcc9955d6e9e4eb80b72908862b640e4f Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 5 Jun 2007 06:44:39 +0000 Subject: [PATCH] reference-manual work svn: r6480 original commit: eeaa856ff139c871299f9452402733cd7bf18269 --- collects/scribble/manual.ss | 79 +++++++++++++--------- collects/scribble/scheme.ss | 20 +++--- collects/scribblings/scribble/manual.scrbl | 6 +- 3 files changed, 62 insertions(+), 43 deletions(-) diff --git a/collects/scribble/manual.ss b/collects/scribble/manual.ss index 4cc64b00..fee088bf 100644 --- a/collects/scribble/manual.ss +++ b/collects/scribble/manual.ss @@ -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 "#")) + (define void-const + (schemeresultfont "#")) + (define undefined-const + (schemeresultfont "#")) (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) diff --git a/collects/scribble/scheme.ss b/collects/scribble/scheme.ss index a3340900..6a2116d7 100644 --- a/collects/scribble/scheme.ss +++ b/collects/scribble/scheme.ss @@ -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))] diff --git a/collects/scribblings/scribble/manual.scrbl b/collects/scribblings/scribble/manual.scrbl index fccc359c..364d5014 100644 --- a/collects/scribblings/scribble/manual.scrbl +++ b/collects/scribblings/scribble/manual.scrbl @@ -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