From 92e4cff791bcdb9fcb7fb29b8ab41d503c71600a Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 10 Dec 2007 22:39:38 +0000 Subject: [PATCH] FFI reference mostly Scribbled svn: r7942 original commit: 102249efc4c725e894e24b3c6b4a2382146d3b30 --- collects/scribble/manual.ss | 82 +++++++++++++++++++++---------------- collects/scribble/scheme.ss | 22 +++++----- 2 files changed, 59 insertions(+), 45 deletions(-) diff --git a/collects/scribble/manual.ss b/collects/scribble/manual.ss index 79cdb894..9219a78e 100644 --- a/collects/scribble/manual.ss +++ b/collects/scribble/manual.ss @@ -227,7 +227,7 @@ verbatim) (provide image onscreen menuitem defterm - schemefont schemevalfont schemeresultfont schemeidfont + schemefont schemevalfont schemeresultfont schemeidfont schemevarfont schemeparenfont schemekeywordfont schememetafont schememodfont filepath exec envvar Flag DFlag indexed-file indexed-envvar @@ -259,6 +259,8 @@ (make-element "schemeresult" (decode-content str))) (define (schemeidfont . str) (make-element "schemesymbol" (decode-content str))) + (define (schemevarfont . str) + (make-element "schemevariable" (decode-content str))) (define (schemeparenfont . str) (make-element "schemeparen" (decode-content str))) (define (schememetafont . str) @@ -436,7 +438,7 @@ ;; ---------------------------------------- (provide declare-exporting - defproc defproc* defstruct defthing defparam defboolparam + defproc defproc* defstruct defthing defthing* defparam defboolparam defform defform* defform/subs defform*/subs defform/none defidform specform specform/subs @@ -671,7 +673,13 @@ (define-syntax defthing (syntax-rules () [(_ id result desc ...) - (*defthing (quote-syntax/loc id) 'id #f (schemeblock0 result) (lambda () (list desc ...)))])) + (*defthing (list (quote-syntax/loc id)) (list 'id) #f (list (schemeblock0 result)) + (lambda () (list desc ...)))])) + (define-syntax defthing* + (syntax-rules () + [(_ ([id result] ...) desc ...) + (*defthing (list (quote-syntax/loc id) ...) (list 'id ...) #f (list (schemeblock0 result) ...) + (lambda () (list desc ...)))])) (define-syntax defparam (syntax-rules () [(_ id arg contract desc ...) @@ -1285,42 +1293,43 @@ fields field-contracts))) (content-thunk)))) - (define (*defthing stx-id name form? result-contract content-thunk) + (define (*defthing stx-ids names form? result-contracts content-thunk) (define spacer (hspace 1)) (make-splice (cons (make-table 'boxed - (list - (list - (make-flow - (make-table-if-necessary - "argcontract" - (list - (list (make-flow - (list - (make-paragraph - (list (let ([tag ((if form? id-to-form-tag id-to-tag) stx-id)] - [content (list (definition-site name stx-id form?))]) - (if tag - (make-toc-target-element - #f - (list (make-index-element #f - content - tag - (list (symbol->string name)) - content - (with-exporting-libraries - (lambda (libs) - (make-thing-index-desc name libs))))) - tag) - (car content))) - spacer ":" spacer)))) - (make-flow - (list - (if (flow-element? result-contract) - result-contract - (make-paragraph (list result-contract)))))))))))) + (map (lambda (stx-id name result-contract) + (list + (make-flow + (make-table-if-necessary + "argcontract" + (list + (list (make-flow + (list + (make-paragraph + (list (let ([tag ((if form? id-to-form-tag id-to-tag) stx-id)] + [content (list (definition-site name stx-id form?))]) + (if tag + (make-toc-target-element + #f + (list (make-index-element #f + content + tag + (list (symbol->string name)) + content + (with-exporting-libraries + (lambda (libs) + (make-thing-index-desc name libs))))) + tag) + (car content))) + spacer ":" spacer)))) + (make-flow + (list + (if (flow-element? result-contract) + result-contract + (make-paragraph (list result-contract))))))))))) + stx-ids names result-contracts)) (content-thunk)))) (define (meta-symbol? s) (memq s '(... ...+ ?))) @@ -2055,7 +2064,10 @@ (make-sig-desc l)) (define (*defsignature stx-id supers body-thunk indent?) - (*defthing stx-id (syntax-e stx-id) #t (make-element #f '("signature")) + (*defthing (list stx-id) + (list (syntax-e stx-id)) + #t + (list (make-element #f '("signature"))) (lambda () (let ([in (parameterize ([current-signature (make-sig (id-to-form-tag stx-id))]) diff --git a/collects/scribble/scheme.ss b/collects/scribble/scheme.ss index fa97407e..9eeb25a3 100644 --- a/collects/scribble/scheme.ss +++ b/collects/scribble/scheme.ss @@ -60,16 +60,18 @@ i))) (define (typeset-atom c out color? quote-depth) - (let-values ([(s it? sub?) - (let ([c (syntax-e c)]) - (let ([s (format "~s" c)]) - (if (and (symbol? c) - ((string-length s) . > . 1) - (char=? (string-ref s 0) #\_)) - (values (substring s 1) #t #f) - (values s #f #f))))] - [(is-var?) (and (identifier? c) - (memq (syntax-e c) (current-variable-list)))]) + (let*-values ([(is-var?) (and (identifier? c) + (memq (syntax-e c) (current-variable-list)))] + [(s it? sub?) + (let ([sc (syntax-e c)]) + (let ([s (format "~s" sc)]) + (if (and (symbol? sc) + ((string-length s) . > . 1) + (char=? (string-ref s 0) #\_) + (not (or (identifier-label-binding c) + is-var?))) + (values (substring s 1) #t #f) + (values s #f #f))))]) (if (or (element? (syntax-e c)) (delayed-element? (syntax-e c))) (out (syntax-e c) #f)