commit 2dcde7a5e2f448d10844fb464246ca4b13e348e4
parent 65702bffbe8ae823b3684ffd413572e549f9bd21
Author: Matthew Flatt <mflatt@racket-lang.org>
Date: Sat, 15 Dec 2007 18:02:05 +0000
added scheme/help
svn: r8016
original commit: f12a39d97b4d9f445f72a0240c633eab752447d8
Diffstat:
7 files changed, 474 insertions(+), 428 deletions(-)
diff --git a/collects/help/search.ss b/collects/help/search.ss
@@ -10,8 +10,11 @@
net/sendurl
mzlib/contract)
+;; Restore the contract when keywords are supported:
+(provide generate-search-results)
+#;
(provide/contract
- [generate-search-results (-> (listof string?) void?)])
+ [generate-search-results (-> (listof string?) #:xref xref? void?)])
(define (make-extra-content desc)
;; Use `desc' to provide more details on the link:
@@ -55,7 +58,7 @@
(append (cdr search-results-files)
(list (car search-results-files))))))
-(define (generate-search-results search-keys)
+(define (generate-search-results search-keys #:xref [xref #f])
(let ([file (next-search-results-file)]
[search-regexps (map (λ (x) (regexp (regexp-quote x #f))) search-keys)]
[exact-search-regexps (map (λ (x) (regexp (format "^~a$" (regexp-quote x #f)))) search-keys)]
@@ -68,7 +71,7 @@
(car search-keys)
(map (λ (x) (format ", or ~a" x))
(cdr search-keys)))])])
- (let ([x (load-xref)])
+ (let ([x (or xref (load-xref))])
(xref-render
x
(decode `(,(title (format "Search results for ~a" search-key-string))
diff --git a/collects/scribble/latex-render.ss b/collects/scribble/latex-render.ss
@@ -70,6 +70,7 @@
(printf "\\definecolor{LightGray}{rgb}{0.90,0.90,0.90}\n")
(printf "\\newcommand{\\schemeinput}[1]{\\colorbox{LightGray}{\\hspace{-0.5ex}\\schemeinputbg{#1}\\hspace{-0.5ex}}}\n")
(printf "\\newcommand{\\highlighted}[1]{\\colorbox{PaleBlue}{\\hspace{-0.5ex}\\schemeinputbg{#1}\\hspace{-0.5ex}}}\n")
+ (printf "\\newcommand{\\plainlink}[1]{#1}\n")
(printf "\\newcommand{\\techlink}[1]{#1}\n")
(printf "\\newcommand{\\indexlink}[1]{#1}\n")
(printf "\\newcommand{\\imageleft}[1]{} % drop it\n")
diff --git a/collects/scribble/manual.ss b/collects/scribble/manual.ss
@@ -163,13 +163,15 @@
(let ([s (apply string-append
(map (lambda (s) (if (string=? s "\n") " " s))
strs))])
- (let ([spaces (regexp-match-positions #rx"^ *" s)]
- [end-spaces (regexp-match-positions #rx" *$" s)])
- (make-element
- "schemeinputbg"
- (list (hspace (cdar spaces))
- (make-element "schemeinput" (list (substring s (cdar spaces) (caar end-spaces))))
- (hspace (- (cdar end-spaces) (caar end-spaces))))))))
+ (if (regexp-match? #rx"^ *$" s)
+ (make-element "schemeinputbg" (list (hspace (string-length s))))
+ (let ([spaces (regexp-match-positions #rx"^ *" s)]
+ [end-spaces (regexp-match-positions #rx" *$" s)])
+ (make-element
+ "schemeinputbg"
+ (list (hspace (cdar spaces))
+ (make-element "schemeinput" (list (substring s (cdar spaces) (caar end-spaces))))
+ (hspace (- (cdar end-spaces) (caar end-spaces)))))))))
(define (verbatim s)
(let ([strs (regexp-split #rx"\n" s)])
@@ -297,12 +299,6 @@
(define (t . str)
(decode-paragraph str))
- (provide schememodule)
- (define-syntax (schememodule stx)
- (syntax-rules ()
- [(_ body ...)
- (code body ...)]))
-
;; ----------------------------------------
(define-struct sig (tagstr))
@@ -771,23 +767,27 @@
(proc
(or (get-exporting-libraries render part ri) null)))))
- (define (*deftogether boxes . body)
+ (define-struct (box-splice splice) (var-list))
+
+ (define (*deftogether boxes body-thunk)
(make-splice
(cons
(make-table
'boxed
(map (lambda (box)
- (unless (and (splice? box)
+ (unless (and (box-splice? box)
(= 1 (length (splice-run box)))
(table? (car (splice-run box)))
(eq? 'boxed (table-style (car (splice-run box)))))
- (error 'deftogether "element is not a splice containing a single table: ~e" box))
+ (error 'deftogether "element is not a boxing splice containing a single table: ~e" box))
(list (make-flow (list (make-table #f (table-flowss (car (splice-run box))))))))
boxes))
- body)))
+ (parameterize ([current-variable-list
+ (apply append (map box-splice-var-list boxes))])
+ (body-thunk)))))
(define-syntax-rule (deftogether (box ...) . body)
- (*deftogether (list box ...) . body))
+ (*deftogether (list box ...) (lambda () (list . body))))
(define (*defproc mode within-id
stx-ids prototypes arg-contractss arg-valss result-contracts content-thunk)
@@ -834,277 +834,278 @@
(string-length (symbol->string (cadar s))))
(string-length (symbol->string (caar s))))]
[else 0])))))])
- (parameterize ([current-variable-list
- (map (lambda (i)
+ (let ([var-list (map (lambda (i)
(and (pair? i)
(if (keyword? (car i))
(cadr i)
(car i))))
(apply append (map cdr prototypes)))])
- (make-splice
- (cons
- (make-table
- 'boxed
- (apply
- append
- (map
- (lambda (stx-id prototype arg-contracts arg-vals result-contract first?)
- (let*-values ([(required optional more-required)
- (let loop ([a (cdr prototype)][r-accum null])
- (if (or (null? a)
- (and (has-optional? (car a))))
- (let ([req (reverse r-accum)])
- (let loop ([a a][o-accum null])
- (if (or (null? a)
- (and (not (has-optional? (car a)))
- ;; A repeat after an optional argument is
- ;; effectively optional:
- (not (memq (car a) '(...)))
- (or (null? (cdr a))
- (not (memq (cadr a) '(...))))))
- (values req (reverse o-accum) a)
- (loop (cdr a) (cons (car a) o-accum)))))
- (loop (cdr a) (cons (car a) r-accum))))]
- [(tagged) (cond
- [(eq? mode 'new)
- (make-element #f
- (list (scheme new)
- (hspace 1)
- (to-element within-id)))]
- [(eq? mode 'make)
- (make-element #f
- (list (scheme make-object)
- (hspace 1)
- (to-element within-id)))]
- [(eq? mode 'send)
- (make-element #f
- (list (scheme send)
- (hspace 1)
- (name-this-object (syntax-e within-id))
- (hspace 1)
- (if first?
- (let* ([mname (car prototype)]
- [ctag (id-to-tag within-id)]
- [tag (method-tag ctag mname)]
- [content (list (*method mname within-id))])
- (if tag
- (make-toc-target-element
- #f
- (list (make-index-element #f
- content
- tag
- (list (symbol->string mname))
- content
- (with-exporting-libraries
- (lambda (libs)
- (make-method-index-desc
- (syntax-e within-id)
- libs
- mname
- ctag)))))
- tag)
- (car content)))
- (*method (car prototype) within-id))))]
- [else
- (if first?
- (let ([tag (id-to-tag stx-id)]
- [content (list (definition-site (car prototype) stx-id #f))])
- (if tag
- (make-toc-target-element
- #f
- (list (make-index-element #f
- content
- tag
- (list (symbol->string (car prototype)))
- content
- (with-exporting-libraries
- (lambda (libs)
- (make-procedure-index-desc
- (car prototype)
- libs)))))
- tag)
- (car content)))
- (annote-exporting-library
- (to-element (make-just-context (car prototype)
- stx-id))))])]
- [(flat-size) (+ (prototype-size (cdr prototype) + +)
- (element-width tagged))]
- [(short?) (or (flat-size . < . 40)
- ((length prototype) . < . 3))]
- [(res) (result-contract)]
- [(result-next-line?) ((+ (if short?
- flat-size
- (+ (prototype-size (cdr prototype) max max)
- (element-width tagged)))
- (flow-element-width res))
- . >= . (- max-proto-width 7))]
- [(end) (list (to-flow spacer)
- (to-flow 'rarr)
- (to-flow spacer)
- (make-flow (list res)))]
- [(opt-cnt) (length optional)])
- (append
- (list
- (list (make-flow
- (if short?
- (make-table-if-necessary
- "prototype"
- (list
- (cons
- (to-flow
- (to-element (append
- (list tagged)
- (map arg->elem required)
- (if (null? optional)
- null
- (list
- (to-element
- (syntax-property
- (syntax-ize (map arg->elem optional) 0)
- 'paren-shape
- #\?))))
- (map arg->elem more-required))))
- (if result-next-line?
- null
- end))))
- (let ([not-end
- (if result-next-line?
- (list (to-flow spacer))
- (list (to-flow spacer)
- (to-flow spacer)
- (to-flow spacer)
- (to-flow spacer)))])
- (list
- (make-table
- "prototype"
+ (parameterize ([current-variable-list var-list])
+ (make-box-splice
+ (cons
+ (make-table
+ 'boxed
+ (apply
+ append
+ (map
+ (lambda (stx-id prototype arg-contracts arg-vals result-contract first?)
+ (let*-values ([(required optional more-required)
+ (let loop ([a (cdr prototype)][r-accum null])
+ (if (or (null? a)
+ (and (has-optional? (car a))))
+ (let ([req (reverse r-accum)])
+ (let loop ([a a][o-accum null])
+ (if (or (null? a)
+ (and (not (has-optional? (car a)))
+ ;; A repeat after an optional argument is
+ ;; effectively optional:
+ (not (memq (car a) '(...)))
+ (or (null? (cdr a))
+ (not (memq (cadr a) '(...))))))
+ (values req (reverse o-accum) a)
+ (loop (cdr a) (cons (car a) o-accum)))))
+ (loop (cdr a) (cons (car a) r-accum))))]
+ [(tagged) (cond
+ [(eq? mode 'new)
+ (make-element #f
+ (list (scheme new)
+ (hspace 1)
+ (to-element within-id)))]
+ [(eq? mode 'make)
+ (make-element #f
+ (list (scheme make-object)
+ (hspace 1)
+ (to-element within-id)))]
+ [(eq? mode 'send)
+ (make-element #f
+ (list (scheme send)
+ (hspace 1)
+ (name-this-object (syntax-e within-id))
+ (hspace 1)
+ (if first?
+ (let* ([mname (car prototype)]
+ [ctag (id-to-tag within-id)]
+ [tag (method-tag ctag mname)]
+ [content (list (*method mname within-id))])
+ (if tag
+ (make-toc-target-element
+ #f
+ (list (make-index-element #f
+ content
+ tag
+ (list (symbol->string mname))
+ content
+ (with-exporting-libraries
+ (lambda (libs)
+ (make-method-index-desc
+ (syntax-e within-id)
+ libs
+ mname
+ ctag)))))
+ tag)
+ (car content)))
+ (*method (car prototype) within-id))))]
+ [else
+ (if first?
+ (let ([tag (id-to-tag stx-id)]
+ [content (list (definition-site (car prototype) stx-id #f))])
+ (if tag
+ (make-toc-target-element
+ #f
+ (list (make-index-element #f
+ content
+ tag
+ (list (symbol->string (car prototype)))
+ content
+ (with-exporting-libraries
+ (lambda (libs)
+ (make-procedure-index-desc
+ (car prototype)
+ libs)))))
+ tag)
+ (car content)))
+ (annote-exporting-library
+ (to-element (make-just-context (car prototype)
+ stx-id))))])]
+ [(flat-size) (+ (prototype-size (cdr prototype) + +)
+ (element-width tagged))]
+ [(short?) (or (flat-size . < . 40)
+ ((length prototype) . < . 3))]
+ [(res) (result-contract)]
+ [(result-next-line?) ((+ (if short?
+ flat-size
+ (+ (prototype-size (cdr prototype) max max)
+ (element-width tagged)))
+ (flow-element-width res))
+ . >= . (- max-proto-width 7))]
+ [(end) (list (to-flow spacer)
+ (to-flow 'rarr)
+ (to-flow spacer)
+ (make-flow (list res)))]
+ [(opt-cnt) (length optional)])
+ (append
+ (list
+ (list (make-flow
+ (if short?
+ (make-table-if-necessary
+ "prototype"
+ (list
(cons
- (list* (to-flow (make-element
- #f
- (list
- (schemeparenfont "(")
- tagged)))
- (cond
- [(null? required)
- (to-flow (make-element #f (list spacer "[")))]
- [else
- (to-flow spacer)])
- (to-flow
- (if (null? required)
- (arg->elem (car optional))
- (arg->elem (car required))))
- not-end)
- (let loop ([args (cdr (append required optional more-required))]
- [req (sub1 (length required))])
- (if (null? args)
- null
- (let ([dots-next? (or (and (pair? (cdr args))
- (or (eq? (cadr args) '...)
- (eq? (cadr args) '...+))))])
- (cons (list* (to-flow spacer)
- (if (zero? req)
- (to-flow (make-element #f (list spacer "[")))
- (to-flow spacer))
- (let ([a (arg->elem (car args))]
- [next (if dots-next?
- (make-element #f (list (hspace 1)
- (arg->elem (cadr args))))
- "")])
- (to-flow
- (cond
- [(null? ((if dots-next? cddr cdr) args))
- (if (or (null? optional)
- (not (null? more-required)))
- (make-element
- #f
- (list a next (schemeparenfont ")")))
- (make-element
- #f
- (list a next "]" (schemeparenfont ")"))))]
- [(and (pair? more-required)
- (= (- 1 req) (length optional)))
- (make-element #f (list a next "]"))]
- [(equal? next "") a]
- [else
- (make-element #f (list a next))])))
- (if (and (null? ((if dots-next? cddr cdr) args))
- (not result-next-line?))
- end
- not-end))
- (loop ((if dots-next? cddr cdr) args) (sub1 req))))))))))))))
- (if result-next-line?
- (list (list (make-flow (make-table-if-necessary
- "prototype"
- (list end)))))
- null)
- (apply append
- (map (lambda (v arg-contract arg-val)
- (cond
- [(pair? v)
- (let* ([v (if (keyword? (car v))
- (cdr v)
- v)]
- [arg-cont (arg-contract)]
- [base-len (+ 5 (string-length (symbol->string (car v)))
- (flow-element-width arg-cont))]
- [arg-val (and arg-val (arg-val))]
- [def-len (if (has-optional? v)
- (flow-element-width arg-val)
- 0)]
- [base-list
- (list
- (to-flow (hspace 2))
- (to-flow (arg->elem v))
- (to-flow spacer)
- (to-flow ":")
- (to-flow spacer)
- (make-flow (list arg-cont)))])
- (list
- (list
- (make-flow
- (if (and (has-optional? v)
- ((+ base-len 3 def-len) . >= . max-proto-width))
- (list
- (make-table
- "argcontract"
+ (to-flow
+ (to-element (append
+ (list tagged)
+ (map arg->elem required)
+ (if (null? optional)
+ null
+ (list
+ (to-element
+ (syntax-property
+ (syntax-ize (map arg->elem optional) 0)
+ 'paren-shape
+ #\?))))
+ (map arg->elem more-required))))
+ (if result-next-line?
+ null
+ end))))
+ (let ([not-end
+ (if result-next-line?
+ (list (to-flow spacer))
+ (list (to-flow spacer)
+ (to-flow spacer)
+ (to-flow spacer)
+ (to-flow spacer)))])
+ (list
+ (make-table
+ "prototype"
+ (cons
+ (list* (to-flow (make-element
+ #f
+ (list
+ (schemeparenfont "(")
+ tagged)))
+ (cond
+ [(null? required)
+ (to-flow (make-element #f (list spacer "[")))]
+ [else
+ (to-flow spacer)])
+ (to-flow
+ (if (null? required)
+ (arg->elem (car optional))
+ (arg->elem (car required))))
+ not-end)
+ (let loop ([args (cdr (append required optional more-required))]
+ [req (sub1 (length required))])
+ (if (null? args)
+ null
+ (let ([dots-next? (or (and (pair? (cdr args))
+ (or (eq? (cadr args) '...)
+ (eq? (cadr args) '...+))))])
+ (cons (list* (to-flow spacer)
+ (if (zero? req)
+ (to-flow (make-element #f (list spacer "[")))
+ (to-flow spacer))
+ (let ([a (arg->elem (car args))]
+ [next (if dots-next?
+ (make-element #f (list (hspace 1)
+ (arg->elem (cadr args))))
+ "")])
+ (to-flow
+ (cond
+ [(null? ((if dots-next? cddr cdr) args))
+ (if (or (null? optional)
+ (not (null? more-required)))
+ (make-element
+ #f
+ (list a next (schemeparenfont ")")))
+ (make-element
+ #f
+ (list a next "]" (schemeparenfont ")"))))]
+ [(and (pair? more-required)
+ (= (- 1 req) (length optional)))
+ (make-element #f (list a next "]"))]
+ [(equal? next "") a]
+ [else
+ (make-element #f (list a next))])))
+ (if (and (null? ((if dots-next? cddr cdr) args))
+ (not result-next-line?))
+ end
+ not-end))
+ (loop ((if dots-next? cddr cdr) args) (sub1 req))))))))))))))
+ (if result-next-line?
+ (list (list (make-flow (make-table-if-necessary
+ "prototype"
+ (list end)))))
+ null)
+ (apply append
+ (map (lambda (v arg-contract arg-val)
+ (cond
+ [(pair? v)
+ (let* ([v (if (keyword? (car v))
+ (cdr v)
+ v)]
+ [arg-cont (arg-contract)]
+ [base-len (+ 5 (string-length (symbol->string (car v)))
+ (flow-element-width arg-cont))]
+ [arg-val (and arg-val (arg-val))]
+ [def-len (if (has-optional? v)
+ (flow-element-width arg-val)
+ 0)]
+ [base-list
+ (list
+ (to-flow (hspace 2))
+ (to-flow (arg->elem v))
+ (to-flow spacer)
+ (to-flow ":")
+ (to-flow spacer)
+ (make-flow (list arg-cont)))])
+ (list
+ (list
+ (make-flow
+ (if (and (has-optional? v)
+ ((+ base-len 3 def-len) . >= . max-proto-width))
(list
- base-list
+ (make-table
+ "argcontract"
+ (list
+ base-list
+ (list
+ (to-flow spacer)
+ (to-flow spacer)
+ (to-flow spacer)
+ (to-flow "=")
+ (to-flow spacer)
+ (make-flow (list arg-val))))))
+ (make-table-if-necessary
+ "argcontract"
(list
- (to-flow spacer)
- (to-flow spacer)
- (to-flow spacer)
- (to-flow "=")
- (to-flow spacer)
- (make-flow (list arg-val))))))
- (make-table-if-necessary
- "argcontract"
- (list
- (append
- base-list
- (if (and (has-optional? v)
- ((+ base-len 3 def-len) . < . max-proto-width))
- (list (to-flow spacer)
- (to-flow "=")
- (to-flow spacer)
- (make-flow (list arg-val)))
- null)))))))))]
- [else null]))
- (cdr prototype)
- arg-contracts
- arg-vals)))))
- stx-ids
- prototypes
- arg-contractss
- arg-valss
- result-contracts
- (let loop ([ps prototypes][accum null])
- (cond
- [(null? ps) null]
- [(ormap (lambda (a) (eq? (caar ps) a)) accum)
- (cons #f (loop (cdr ps) accum))]
- [else
- (cons #t (loop (cdr ps)
- (cons (caar ps) accum)))])))))
- (content-thunk))))))
+ (append
+ base-list
+ (if (and (has-optional? v)
+ ((+ base-len 3 def-len) . < . max-proto-width))
+ (list (to-flow spacer)
+ (to-flow "=")
+ (to-flow spacer)
+ (make-flow (list arg-val)))
+ null)))))))))]
+ [else null]))
+ (cdr prototype)
+ arg-contracts
+ arg-vals)))))
+ stx-ids
+ prototypes
+ arg-contractss
+ arg-valss
+ result-contracts
+ (let loop ([ps prototypes][accum null])
+ (cond
+ [(null? ps) null]
+ [(ormap (lambda (a) (eq? (caar ps) a)) accum)
+ (cons #f (loop (cdr ps) accum))]
+ [else
+ (cons #t (loop (cdr ps)
+ (cons (caar ps) accum)))])))))
+ (content-thunk))
+ var-list)))))
(define (make-target-element* inner-make-target-element stx-id content wrappers)
(if (null? wrappers)
@@ -1148,7 +1149,7 @@
(define (field-view f) (if (pair? (car f))
(make-shaped-parens (car f) #\[)
(car f)))
- (make-splice
+ (make-box-splice
(cons
(make-table
'boxed
@@ -1232,7 +1233,7 @@
(to-element (field-view (car fields)))))))
(if (short-width . < . max-proto-width)
null
- (let loop ([fields fields])
+ (let loop ([fields (if (null? fields) fields (cdr fields))])
(if (null? fields)
null
(cons (let ([fld (car fields)])
@@ -1310,11 +1311,12 @@
(make-flow (list (field-contract))))))))]
[else null]))
fields field-contracts)))
- (content-thunk))))
+ (content-thunk))
+ null))
(define (*defthing stx-ids names form? result-contracts content-thunk)
(define spacer (hspace 1))
- (make-splice
+ (make-box-splice
(cons
(make-table
'boxed
@@ -1349,86 +1351,89 @@
result-contract
(make-paragraph (list result-contract)))))))))))
stx-ids names result-contracts))
- (content-thunk))))
+ (content-thunk))
+ null))
(define (meta-symbol? s) (memq s '(... ...+ ?)))
(define (*defforms kw-id lits forms form-procs subs sub-procs content-thunk)
- (parameterize ([current-variable-list
- (apply
- append
- (map (lambda (form)
- (let loop ([form (cons (if kw-id
- (if (pair? form)
- (cdr form)
- null)
- form)
- subs)])
- (cond
- [(symbol? form) (if (or (meta-symbol? form)
- (memq form lits))
- null
- (list form))]
- [(pair? form) (append (loop (car form))
- (loop (cdr form)))]
- [else null])))
- forms))]
- [current-meta-list '(... ...+)])
- (make-splice
- (cons
- (make-table
- 'boxed
- (append
- (map (lambda (form form-proc)
- (list
- (make-flow
+ (let ([var-list
+ (apply
+ append
+ (map (lambda (form)
+ (let loop ([form (cons (if kw-id
+ (if (pair? form)
+ (cdr form)
+ null)
+ form)
+ subs)])
+ (cond
+ [(symbol? form) (if (or (meta-symbol? form)
+ (memq form lits))
+ null
+ (list form))]
+ [(pair? form) (append (loop (car form))
+ (loop (cdr form)))]
+ [else null])))
+ forms))])
+ (parameterize ([current-variable-list var-list]
+ [current-meta-list '(... ...+)])
+ (make-box-splice
+ (cons
+ (make-table
+ 'boxed
+ (append
+ (map (lambda (form form-proc)
(list
- ((or form-proc
- (lambda (x)
- (make-paragraph
- (list
- (to-element
- `(,x . ,(cdr form)))))))
- (and kw-id
- (eq? form (car forms))
- (let ([tag (id-to-tag kw-id)]
- [stag (id-to-form-tag kw-id)]
- [content (list (definition-site (if (pair? form)
- (car form)
- form)
- kw-id
- #t))])
- (if tag
- (make-target-element
- #f
- (list
- (make-toc-target-element
+ (make-flow
+ (list
+ ((or form-proc
+ (lambda (x)
+ (make-paragraph
+ (list
+ (to-element
+ `(,x . ,(cdr form)))))))
+ (and kw-id
+ (eq? form (car forms))
+ (let ([tag (id-to-tag kw-id)]
+ [stag (id-to-form-tag kw-id)]
+ [content (list (definition-site (if (pair? form)
+ (car form)
+ form)
+ kw-id
+ #t))])
+ (if tag
+ (make-target-element
#f
- (if kw-id
- (list (make-index-element #f
- content
- tag
- (list (symbol->string (syntax-e kw-id)))
- content
- (with-exporting-libraries
- (lambda (libs)
- (make-form-index-desc (syntax-e kw-id) libs)))))
- content)
- stag))
- tag)
- (car content)))))))))
- forms form-procs)
- (if (null? sub-procs)
- null
- (list (list (make-flow (list (make-paragraph (list (tt 'nbsp))))))
- (list (make-flow (list (let ([l (map (lambda (sub)
- (map (lambda (f) (f)) sub))
- sub-procs)])
- (*schemerawgrammars
- "specgrammar"
- (map car l)
- (map cdr l))))))))))
- (content-thunk)))))
+ (list
+ (make-toc-target-element
+ #f
+ (if kw-id
+ (list (make-index-element #f
+ content
+ tag
+ (list (symbol->string (syntax-e kw-id)))
+ content
+ (with-exporting-libraries
+ (lambda (libs)
+ (make-form-index-desc (syntax-e kw-id) libs)))))
+ content)
+ stag))
+ tag)
+ (car content)))))))))
+ forms form-procs)
+ (if (null? sub-procs)
+ null
+ (list (list (make-flow (list (make-paragraph (list (tt 'nbsp))))))
+ (list (make-flow (list (let ([l (map (lambda (sub)
+ (map (lambda (f) (f)) sub))
+ sub-procs)])
+ (*schemerawgrammars
+ "specgrammar"
+ (map car l)
+ (map cdr l))))))))))
+ (content-thunk))
+ var-list))))
(define (*specsubform form has-kw? lits form-thunk subs sub-procs content-thunk)
(parameterize ([current-variable-list
@@ -1619,26 +1624,43 @@
(define-struct a-bib-entry (key val))
- (define (bib-entry #:key key #:title title #:author author #:location location #:date date #:url [url #f])
+ (define (bib-entry #:key key
+ #:title title
+ #:author [author #f]
+ #:location [location #f]
+ #:date [date #f]
+ #:url [url #f])
(make-a-bib-entry
key
(make-element
#f
- (list author
- ", "
- 'ldquo
- title
- "," 'rdquo " "
- location
- ", "
- date
- "."
- (if url
- (make-element #f
- (list " "
- (link url
- (tt url))))
- "")))))
+ (append
+ (if author
+ (list author
+ ", ")
+ null)
+ (list 'ldquo
+ title
+ (if location
+ ","
+ ".")
+ 'rdquo)
+ (if location
+ (list " "
+ location
+ (if date
+ ","
+ "."))
+ null)
+ (if date
+ (list " "
+ date
+ ".")
+ null)
+ (if url
+ (list " "
+ (link url (tt url)))
+ null)))))
(define (bibliography #:tag [tag "doc-bibliography"] . citations)
(make-unnumbered-part
diff --git a/collects/scribblings/scribble/basic.scrbl b/collects/scribblings/scribble/basic.scrbl
@@ -29,7 +29,8 @@ For example, the @scheme[title] and @scheme[italic] functions might be
called from Scheme as
@schemeblock[
-(title #:tag "how-to" "How to Design " (italic "Great") " Programs")
+(title #:tag "how-to"
+ "How to Design " (italic "Great") " Programs")
]
or with an @elem["@"] expression as
@@ -54,11 +55,11 @@ have @schememodname[scribble/manual]).
title-decl?]{
Generates a @scheme[title-decl] to be picked up by @scheme[decode] or
-@scheme[decode-part]. The @scheme[pre-content]s list is parsed with
-@scheme[decode-content] for the title content. If @scheme[tag] is
-@scheme[#f], a tag string is generated automatically from the
-content. The tag string is combined with the symbol @scheme['part] to
-form the full tag.
+@scheme[decode-part]. The @tech{decode}d @scheme[pre-content] (i.e.,
+parsed with @scheme[decode-content]) supplies the title content. If
+@scheme[tag] is @scheme[#f], a tag string is generated automatically
+from the content. The tag string is combined with the symbol
+@scheme['part] to form the full tag.
A style of @scheme['toc] causes sub-sections to be generated as
separate pages in multi-page HTML output. A style of @scheme['index]
@@ -94,15 +95,18 @@ removed.}
}
@defproc[(item [pre-flow any/c] ...) item?]{
- Creates an item for use with @scheme[itemize]. The
- @scheme[pre-flow] list is parsed with @scheme[decode-flow].
-}
+
+Creates an item for use with @scheme[itemize]. The @tech{decode}d
+@scheme[pre-flow] (i.e., parsed with @scheme[decode-flow]) is the item
+content.}
+
@defproc[(item? [v any/c]) boolean?]{
Returns @scheme[#t] if @scheme[v] is an item produced by
@scheme[item], @scheme[#f] otherwise.}
+
@defform[(include-section module-path)]{ Requires @scheme[module-path]
and returns its @scheme[doc] export (without making any imports
visible to the enclosing context). Since this form expands to
@@ -112,9 +116,8 @@ Returns @scheme[#t] if @scheme[v] is an item produced by
@section{Text Styles}
-@def-elem-proc[elem]{ Parses the @scheme[pre-content] list using
-@scheme[decode-content], and wraps the result as an element with
-style @scheme[#f].}
+@def-elem-proc[elem]{ Wraps the @tech{decode}d @scheme[pre-content] as
+an element with style @scheme[#f].}
@def-elem-proc[aux-elem]{Like @scheme[elem], but creates an
@scheme[aux-element].}
@@ -126,16 +129,16 @@ style @scheme[#f].}
@def-style-proc[superscript]
@defproc[(hspace [n nonnegative-exact-integer?]) element?]{
-Produces an element containing @scheme[n] spaces and style @scheme['hspace].
-}
+
+Produces an element containing @scheme[n] spaces and style
+@scheme['hspace].}
+
@defproc[(span-class [style-name string?] [pre-content any/c] ...)
element?]{
-Parses the @scheme[pre-content] list using @scheme[decode-content],
-and produces an element with style @scheme[style-name].
-
-}
+Wraps the @tech{decode}d @scheme[pre-content] as an element with style
+@scheme[style-name].}
@; ------------------------------------------------------------------------
@@ -148,12 +151,10 @@ and produces an element with style @scheme[style-name].
Creates an index element given a plain-text string---or list of
strings for a hierarchy, such as @scheme['("strings" "plain")] for a
``plain'' entry until a more general ``strings'' entry. The strings
-also serve as the text to render in the index. The
-@scheme[pre-content] list, as parsed by @scheme[decode-content] is the
-text to appear in place of the element, to which the index entry
-refers.
+also serve as the text to render in the index. The @tech{decode}d
+@scheme[pre-content] is the text to appear inline as the index
+target.}
-}
@defproc[(index* [words (listof string?)]
[word-contents (listof list?)]
@@ -168,7 +169,7 @@ the list of contents render in the index (in parallel to
index-element?]{
Like @scheme[index], but the word to index is determined by applying
-@scheme[content->string] on the parsed @scheme[pre-content] list.}
+@scheme[content->string] on the @tech{decode}d @scheme[pre-content].}
@defproc[(section-index [word string?] ...)
diff --git a/collects/scribblings/scribble/decode.scrbl b/collects/scribblings/scribble/decode.scrbl
@@ -30,6 +30,17 @@ special text conversions:
}
+Some functions @deftech{decode} a sequence of @scheme[_pre-flow] or
+@scheme[_pre-content] arguments using @scheme[decode-flow] or
+@scheme[decode-content], respectively. For example, the @scheme[bold]
+function accepts any number of @scheme[_pre-content] arguments, so
+that in
+
+@verbatim[" @bold{``apple''}"]
+
+the @litchar{``apple''} argument is decoded to use fancy quotes, and
+then it is bolded.
+
@defproc[(decode [lst list?]) part?]{
Decodes a document, producing a part. In @scheme[lst], instances of
diff --git a/collects/scribblings/scribble/manual.scrbl b/collects/scribblings/scribble/manual.scrbl
@@ -130,10 +130,10 @@ as a table/paragraph in typewriter font with the linebreaks specified
by newline characters in @scheme[str]. ``Here strings'' are often
useful with @scheme[verbatim].}
-@defproc[(schemefont [pre-content any/c] ...) element?]{Typesets the given
-content as uncolored, unhyperlinked Scheme. This procedure is useful
-for typesetting things like @schemefont{#lang}, which are not
-@scheme[read]able by themselves.}
+@defproc[(schemefont [pre-content any/c] ...) element?]{Typesets
+@tech{decode}d @scheme[pre-content] as uncolored, unhyperlinked
+Scheme. This procedure is useful for typesetting things like
+@schemefont{#lang}, which are not @scheme[read]able by themselves.}
@defproc[(schemevalfont [pre-content any/c] ...) element?]{Like
@scheme[schemefont], but colored as a value.}
@@ -144,6 +144,10 @@ for typesetting things like @schemefont{#lang}, which are not
@defproc[(schemeidfont [pre-content any/c] ...) element?]{Like
@scheme[schemefont], but colored as an identifier.}
+@defproc[(schemevarfont [pre-content any/c] ...) element?]{Like
+@scheme[schemefont], but colored as a variable (i.e., an argument or
+sub-form in a procedure being documented).}
+
@defproc[(schemekeywordfont [pre-content any/c] ...) element?]{Like
@scheme[schemefont], but colored as a syntactic form name.}
@@ -154,16 +158,16 @@ for typesetting things like @schemefont{#lang}, which are not
@scheme[schemefont], but colored as meta-syntax, such as backquote or
unquote.}
-@defproc[(procedure [pre-content any/c] ...) element?]{Typesets the given
-content as a procedure name in a REPL result (e.g., in typewriter font
-with a @litchar{#<procedure:} prefix and @litchar{>} suffix.).}
+@defproc[(procedure [pre-content any/c] ...) element?]{Typesets
+@tech{decode}d @scheme[pre-content] as a procedure name in a REPL
+result (e.g., in typewriter font with a @litchar{#<procedure:} prefix
+and @litchar{>} suffix.).}
-@defform[(var datum)]{Typesets @scheme[var] as an identifier that is
-an argument or sub-form in a procedure being
-documented. Normally, the @scheme[defproc] and @scheme[defform]
-arrange for @scheme[scheme] to format such identifiers automatically
-in the description of the procedure, but use @scheme[var] if that
-cannot work for some reason.}
+@defform[(var datum)]{Typesets @scheme[datum] as an identifier that is
+an argument or sub-form in a procedure being documented. Normally, the
+@scheme[defproc] and @scheme[defform] arrange for @scheme[scheme] to
+format such identifiers automatically in the description of the
+procedure, but use @scheme[var] if that cannot work for some reason.}
@defform[(svar datum)]{Like @scheme[var], but for subform non-terminals
in a form definition.}
@@ -175,8 +179,8 @@ in a form definition.}
Produces a sequence of flow elements (encaptured in a @scheme[splice])
to start the documentation for a module that can be @scheme[require]d
-using the path @scheme[id]. The @scheme[pre-flow]s list is parsed as a
-flow that documents the procedure (see @scheme[decode-flow]).
+using the path @scheme[id]. The @tech{decode}d @scheme[pre-flow]s
+introduce the module, but need not include all of the module content.
Besides generating text, this form expands to a use of
@scheme[declare-exporting] with @scheme[id].
@@ -274,12 +278,13 @@ The @scheme[result-contract-expr-datum] is typeset via
@scheme[schemeblock0], and it represents a contract on the procedure's
result.
-The @scheme[pre-flow]s list is parsed as a flow that documents the
-procedure. In this description, references to @svar[arg-id]s
-are typeset as procedure arguments.
+The @tech{decode}d @scheme[pre-flow] documents the procedure. In this
+description, references to @svar[arg-id]s using @scheme[scheme],
+@scheme[schemeblock], @|etc| are typeset as procedure arguments.
-The typesetting of all data before the @scheme[pre-flow]s ignores the
-source layout.}
+The typesetting of all information before the @scheme[pre-flow]s
+ignores the source layout, except that the local formatting is
+preserved for contracts and default-values expressions.}
@defform[(defproc* ([(id arg-spec ...)
@@ -309,14 +314,14 @@ for-label binding) are hyperlinked to this documentation. The
@scheme[require-for-label]) that determines the module binding being
defined.
-The @scheme[pre-flow]s list is parsed as a flow that documents the
-procedure. In this description, a reference to any identifier in
-@scheme[datum] is typeset as a sub-form non-terminal. If
-@scheme[#:literals] clause is provided, however, instances of the
-@scheme[literal-id]s are typeset normally.
+The @tech{decode}d @scheme[pre-flow] documents the procedure. In this
+description, a reference to any identifier in @scheme[datum] via
+@scheme[scheme], @scheme[schemeblock], @|etc| is typeset as a sub-form
+non-terminal. If @scheme[#:literals] clause is provided, however,
+instances of the @scheme[literal-id]s are typeset normally.
The typesetting of @scheme[(id . datum)] preserves the source
-layout, like @scheme[schemeblock], and unlike @scheme[defproc].}
+layout, like @scheme[schemeblock].}
@defform[(defform* maybe-literals [(id . datum) ..+] pre-flow ...)]{
diff --git a/collects/setup/scribble-index.ss b/collects/setup/scribble-index.ss
@@ -13,6 +13,7 @@
setup/main-collects)
(provide load-xref
+ xref?
xref-render
xref-index
xref-binding->definition-tag
@@ -27,6 +28,8 @@
;; Private:
(define-struct xrefs (renderer ri))
+(define (xref? x) (xrefs? x))
+
;; ----------------------------------------
;; Xref loading
