suzanne.soy/scribble-enhanced
1
0
Fork 0
Code Issues 1 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

added scheme/help

Browse Source 
svn: r8016

original commit: f12a39d97b4d9f445f72a0240c633eab752447d8
This commit is contained in:
Matthew Flatt 2007-12-15 18:02:05 +00:00
parent 65702bffbe
commit 2dcde7a5e2
7 changed files with 475 additions and 429 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/help/search.ss
View File

@ -10,8 +10,11 @@
net/sendurl net/sendurl
mzlib/contract) mzlib/contract)
;; Restore the contract when keywords are supported:
(provide generate-search-results)
#;
(provide/contract (provide/contract
[generate-search-results (-> (listof string?) void?)]) [generate-search-results (-> (listof string?) #:xref xref? void?)])
(define (make-extra-content desc) (define (make-extra-content desc)
;; Use `desc' to provide more details on the link: ;; Use `desc' to provide more details on the link:
@ -55,7 +58,7 @@
(append (cdr search-results-files) (append (cdr search-results-files)
(list (car 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)] (let ([file (next-search-results-file)]
[search-regexps (map (λ (x) (regexp (regexp-quote x #f))) search-keys)] [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)] [exact-search-regexps (map (λ (x) (regexp (format "^~a$" (regexp-quote x #f)))) search-keys)]
@ -68,7 +71,7 @@
(car search-keys) (car search-keys)
(map (λ (x) (format ", or ~a" x)) (map (λ (x) (format ", or ~a" x))
(cdr search-keys)))])]) (cdr search-keys)))])])
(let ([x (load-xref)]) (let ([x (or xref (load-xref))])
(xref-render (xref-render
x x
(decode `(,(title (format "Search results for ~a" search-key-string)) (decode `(,(title (format "Search results for ~a" search-key-string))

1
collects/scribble/latex-render.ss
View File

@ -70,6 +70,7 @@
(printf "\\definecolor{LightGray}{rgb}{0.90,0.90,0.90}\n") (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{\\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{\\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{\\techlink}[1]{#1}\n")
(printf "\\newcommand{\\indexlink}[1]{#1}\n") (printf "\\newcommand{\\indexlink}[1]{#1}\n")
(printf "\\newcommand{\\imageleft}[1]{} % drop it\n") (printf "\\newcommand{\\imageleft}[1]{} % drop it\n")

774
collects/scribble/manual.ss
View File

@ -163,13 +163,15 @@
(let ([s (apply string-append (let ([s (apply string-append
(map (lambda (s) (if (string=? s "\n") " " s)) (map (lambda (s) (if (string=? s "\n") " " s))
strs))]) strs))])
(let ([spaces (regexp-match-positions #rx"^ *" s)] (if (regexp-match? #rx"^ *$" s)
[end-spaces (regexp-match-positions #rx" *$" s)]) (make-element "schemeinputbg" (list (hspace (string-length s))))
(make-element (let ([spaces (regexp-match-positions #rx"^ *" s)]
"schemeinputbg" [end-spaces (regexp-match-positions #rx" *$" s)])
(list (hspace (cdar spaces)) (make-element
(make-element "schemeinput" (list (substring s (cdar spaces) (caar end-spaces)))) "schemeinputbg"
(hspace (- (cdar end-spaces) (caar end-spaces)))))))) (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) (define (verbatim s)
(let ([strs (regexp-split #rx"\n" s)]) (let ([strs (regexp-split #rx"\n" s)])
@ -297,12 +299,6 @@
(define (t . str) (define (t . str)
(decode-paragraph str)) (decode-paragraph str))
(provide schememodule)
(define-syntax (schememodule stx)
(syntax-rules ()
[(_ body ...)
(code body ...)]))
;; ---------------------------------------- ;; ----------------------------------------
(define-struct sig (tagstr)) (define-struct sig (tagstr))
@ -771,23 +767,27 @@
(proc (proc
(or (get-exporting-libraries render part ri) null))))) (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 (make-splice
(cons (cons
(make-table (make-table
'boxed 'boxed
(map (lambda (box) (map (lambda (box)
(unless (and (splice? box) (unless (and (box-splice? box)
(= 1 (length (splice-run box))) (= 1 (length (splice-run box)))
(table? (car (splice-run box))) (table? (car (splice-run box)))
(eq? 'boxed (table-style (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)))))))) (list (make-flow (list (make-table #f (table-flowss (car (splice-run box))))))))
boxes)) boxes))
body))) (parameterize ([current-variable-list
(apply append (map box-splice-var-list boxes))])
(body-thunk)))))
(define-syntax-rule (deftogether (box ...) . body) (define-syntax-rule (deftogether (box ...) . body)
(*deftogether (list box ...) . body)) (*deftogether (list box ...) (lambda () (list . body))))
(define (*defproc mode within-id (define (*defproc mode within-id
stx-ids prototypes arg-contractss arg-valss result-contracts content-thunk) 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 (cadar s))))
(string-length (symbol->string (caar s))))] (string-length (symbol->string (caar s))))]
[else 0])))))]) [else 0])))))])
(parameterize ([current-variable-list (let ([var-list (map (lambda (i)
(map (lambda (i)
(and (pair? i) (and (pair? i)
(if (keyword? (car i)) (if (keyword? (car i))
(cadr i) (cadr i)
(car i)))) (car i))))
(apply append (map cdr prototypes)))]) (apply append (map cdr prototypes)))])
(make-splice (parameterize ([current-variable-list var-list])
(cons (make-box-splice
(make-table (cons
'boxed (make-table
(apply 'boxed
append (apply
(map append
(lambda (stx-id prototype arg-contracts arg-vals result-contract first?) (map
(let*-values ([(required optional more-required) (lambda (stx-id prototype arg-contracts arg-vals result-contract first?)
(let loop ([a (cdr prototype)][r-accum null]) (let*-values ([(required optional more-required)
(if (or (null? a) (let loop ([a (cdr prototype)][r-accum null])
(and (has-optional? (car a)))) (if (or (null? a)
(let ([req (reverse r-accum)]) (and (has-optional? (car a))))
(let loop ([a a][o-accum null]) (let ([req (reverse r-accum)])
(if (or (null? a) (let loop ([a a][o-accum null])
(and (not (has-optional? (car a))) (if (or (null? a)
;; A repeat after an optional argument is (and (not (has-optional? (car a)))
;; effectively optional: ;; A repeat after an optional argument is
(not (memq (car a) '(...))) ;; effectively optional:
(or (null? (cdr a)) (not (memq (car a) '(...)))
(not (memq (cadr a) '(...)))))) (or (null? (cdr a))
(values req (reverse o-accum) a) (not (memq (cadr a) '(...))))))
(loop (cdr a) (cons (car a) o-accum))))) (values req (reverse o-accum) a)
(loop (cdr a) (cons (car a) r-accum))))] (loop (cdr a) (cons (car a) o-accum)))))
[(tagged) (cond (loop (cdr a) (cons (car a) r-accum))))]
[(eq? mode 'new) [(tagged) (cond
(make-element #f [(eq? mode 'new)
(list (scheme new) (make-element #f
(hspace 1) (list (scheme new)
(to-element within-id)))] (hspace 1)
[(eq? mode 'make) (to-element within-id)))]
(make-element #f [(eq? mode 'make)
(list (scheme make-object) (make-element #f
(hspace 1) (list (scheme make-object)
(to-element within-id)))] (hspace 1)
[(eq? mode 'send) (to-element within-id)))]
(make-element #f [(eq? mode 'send)
(list (scheme send) (make-element #f
(hspace 1) (list (scheme send)
(name-this-object (syntax-e within-id)) (hspace 1)
(hspace 1) (name-this-object (syntax-e within-id))
(if first? (hspace 1)
(let* ([mname (car prototype)] (if first?
[ctag (id-to-tag within-id)] (let* ([mname (car prototype)]
[tag (method-tag ctag mname)] [ctag (id-to-tag within-id)]
[content (list (*method mname within-id))]) [tag (method-tag ctag mname)]
(if tag [content (list (*method mname within-id))])
(make-toc-target-element (if tag
#f (make-toc-target-element
(list (make-index-element #f #f
content (list (make-index-element #f
tag content
(list (symbol->string mname)) tag
content (list (symbol->string mname))
(with-exporting-libraries content
(lambda (libs) (with-exporting-libraries
(make-method-index-desc (lambda (libs)
(syntax-e within-id) (make-method-index-desc
libs (syntax-e within-id)
mname libs
ctag))))) mname
tag) ctag)))))
(car content))) tag)
(*method (car prototype) within-id))))] (car content)))
[else (*method (car prototype) within-id))))]
(if first? [else
(let ([tag (id-to-tag stx-id)] (if first?
[content (list (definition-site (car prototype) stx-id #f))]) (let ([tag (id-to-tag stx-id)]
(if tag [content (list (definition-site (car prototype) stx-id #f))])
(make-toc-target-element (if tag
#f (make-toc-target-element
(list (make-index-element #f #f
content (list (make-index-element #f
tag content
(list (symbol->string (car prototype))) tag
content (list (symbol->string (car prototype)))
(with-exporting-libraries content
(lambda (libs) (with-exporting-libraries
(make-procedure-index-desc (lambda (libs)
(car prototype) (make-procedure-index-desc
libs))))) (car prototype)
tag) libs)))))
(car content))) tag)
(annote-exporting-library (car content)))
(to-element (make-just-context (car prototype) (annote-exporting-library
stx-id))))])] (to-element (make-just-context (car prototype)
[(flat-size) (+ (prototype-size (cdr prototype) + +) stx-id))))])]
(element-width tagged))] [(flat-size) (+ (prototype-size (cdr prototype) + +)
[(short?) (or (flat-size . < . 40) (element-width tagged))]
((length prototype) . < . 3))] [(short?) (or (flat-size . < . 40)
[(res) (result-contract)] ((length prototype) . < . 3))]
[(result-next-line?) ((+ (if short? [(res) (result-contract)]
flat-size [(result-next-line?) ((+ (if short?
(+ (prototype-size (cdr prototype) max max) flat-size
(element-width tagged))) (+ (prototype-size (cdr prototype) max max)
(flow-element-width res)) (element-width tagged)))
. >= . (- max-proto-width 7))] (flow-element-width res))
[(end) (list (to-flow spacer) . >= . (- max-proto-width 7))]
(to-flow 'rarr) [(end) (list (to-flow spacer)
(to-flow spacer) (to-flow 'rarr)
(make-flow (list res)))] (to-flow spacer)
[(opt-cnt) (length optional)]) (make-flow (list res)))]
(append [(opt-cnt) (length optional)])
(list (append
(list (make-flow (list
(if short? (list (make-flow
(make-table-if-necessary (if short?
"prototype" (make-table-if-necessary
(list "prototype"
(cons (list
(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 (cons
(list* (to-flow (make-element (to-flow
#f (to-element (append
(list (list tagged)
(schemeparenfont "(") (map arg->elem required)
tagged))) (if (null? optional)
(cond null
[(null? required) (list
(to-flow (make-element #f (list spacer "[")))] (to-element
[else (syntax-property
(to-flow spacer)]) (syntax-ize (map arg->elem optional) 0)
(to-flow 'paren-shape
(if (null? required) #\?))))
(arg->elem (car optional)) (map arg->elem more-required))))
(arg->elem (car required)))) (if result-next-line?
not-end) null
(let loop ([args (cdr (append required optional more-required))] end))))
[req (sub1 (length required))]) (let ([not-end
(if (null? args) (if result-next-line?
null (list (to-flow spacer))
(let ([dots-next? (or (and (pair? (cdr args)) (list (to-flow spacer)
(or (eq? (cadr args) '...) (to-flow spacer)
(eq? (cadr args) '...+))))]) (to-flow spacer)
(cons (list* (to-flow spacer) (to-flow spacer)))])
(if (zero? req) (list
(to-flow (make-element #f (list spacer "["))) (make-table
(to-flow spacer)) "prototype"
(let ([a (arg->elem (car args))] (cons
[next (if dots-next? (list* (to-flow (make-element
(make-element #f (list (hspace 1) #f
(arg->elem (cadr args)))) (list
"")]) (schemeparenfont "(")
(to-flow tagged)))
(cond (cond
[(null? ((if dots-next? cddr cdr) args)) [(null? required)
(if (or (null? optional) (to-flow (make-element #f (list spacer "[")))]
(not (null? more-required))) [else
(make-element (to-flow spacer)])
#f (to-flow
(list a next (schemeparenfont ")"))) (if (null? required)
(make-element (arg->elem (car optional))
#f (arg->elem (car required))))
(list a next "]" (schemeparenfont ")"))))] not-end)
[(and (pair? more-required) (let loop ([args (cdr (append required optional more-required))]
(= (- 1 req) (length optional))) [req (sub1 (length required))])
(make-element #f (list a next "]"))] (if (null? args)
[(equal? next "") a] null
[else (let ([dots-next? (or (and (pair? (cdr args))
(make-element #f (list a next))]))) (or (eq? (cadr args) '...)
(if (and (null? ((if dots-next? cddr cdr) args)) (eq? (cadr args) '...+))))])
(not result-next-line?)) (cons (list* (to-flow spacer)
end (if (zero? req)
not-end)) (to-flow (make-element #f (list spacer "[")))
(loop ((if dots-next? cddr cdr) args) (sub1 req)))))))))))))) (to-flow spacer))
(if result-next-line? (let ([a (arg->elem (car args))]
(list (list (make-flow (make-table-if-necessary [next (if dots-next?
"prototype" (make-element #f (list (hspace 1)
(list end))))) (arg->elem (cadr args))))
null) "")])
(apply append (to-flow
(map (lambda (v arg-contract arg-val) (cond
(cond [(null? ((if dots-next? cddr cdr) args))
[(pair? v) (if (or (null? optional)
(let* ([v (if (keyword? (car v)) (not (null? more-required)))
(cdr v) (make-element
v)] #f
[arg-cont (arg-contract)] (list a next (schemeparenfont ")")))
[base-len (+ 5 (string-length (symbol->string (car v))) (make-element
(flow-element-width arg-cont))] #f
[arg-val (and arg-val (arg-val))] (list a next "]" (schemeparenfont ")"))))]
[def-len (if (has-optional? v) [(and (pair? more-required)
(flow-element-width arg-val) (= (- 1 req) (length optional)))
0)] (make-element #f (list a next "]"))]
[base-list [(equal? next "") a]
(list [else
(to-flow (hspace 2)) (make-element #f (list a next))])))
(to-flow (arg->elem v)) (if (and (null? ((if dots-next? cddr cdr) args))
(to-flow spacer) (not result-next-line?))
(to-flow ":") end
(to-flow spacer) not-end))
(make-flow (list arg-cont)))]) (loop ((if dots-next? cddr cdr) args) (sub1 req))))))))))))))
(list (if result-next-line?
(list (list (list (make-flow (make-table-if-necessary
(make-flow "prototype"
(if (and (has-optional? v) (list end)))))
((+ base-len 3 def-len) . >= . max-proto-width)) null)
(list (apply append
(make-table (map (lambda (v arg-contract arg-val)
"argcontract" (cond
(list [(pair? v)
base-list (let* ([v (if (keyword? (car v))
(list (cdr v)
(to-flow spacer) v)]
(to-flow spacer) [arg-cont (arg-contract)]
(to-flow spacer) [base-len (+ 5 (string-length (symbol->string (car v)))
(to-flow "=") (flow-element-width arg-cont))]
(to-flow spacer) [arg-val (and arg-val (arg-val))]
(make-flow (list arg-val)))))) [def-len (if (has-optional? v)
(make-table-if-necessary (flow-element-width arg-val)
"argcontract" 0)]
[base-list
(list (list
(append (to-flow (hspace 2))
base-list (to-flow (arg->elem v))
(if (and (has-optional? v) (to-flow spacer)
((+ base-len 3 def-len) . < . max-proto-width)) (to-flow ":")
(list (to-flow spacer) (to-flow spacer)
(to-flow "=") (make-flow (list arg-cont)))])
(to-flow spacer) (list
(make-flow (list arg-val))) (list
null)))))))))] (make-flow
[else null])) (if (and (has-optional? v)
(cdr prototype) ((+ base-len 3 def-len) . >= . max-proto-width))
arg-contracts (list
arg-vals))))) (make-table
stx-ids "argcontract"
prototypes (list
arg-contractss base-list
arg-valss (list
result-contracts (to-flow spacer)
(let loop ([ps prototypes][accum null]) (to-flow spacer)
(cond (to-flow spacer)
[(null? ps) null] (to-flow "=")
[(ormap (lambda (a) (eq? (caar ps) a)) accum) (to-flow spacer)
(cons #f (loop (cdr ps) accum))] (make-flow (list arg-val))))))
[else (make-table-if-necessary
(cons #t (loop (cdr ps) "argcontract"
(cons (caar ps) accum)))]))))) (list
(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) (define (make-target-element* inner-make-target-element stx-id content wrappers)
(if (null? wrappers) (if (null? wrappers)
@ -1148,7 +1149,7 @@
(define (field-view f) (if (pair? (car f)) (define (field-view f) (if (pair? (car f))
(make-shaped-parens (car f) #\[) (make-shaped-parens (car f) #\[)
(car f))) (car f)))
(make-splice (make-box-splice
(cons (cons
(make-table (make-table
'boxed 'boxed
@ -1232,7 +1233,7 @@
(to-element (field-view (car fields))))))) (to-element (field-view (car fields)))))))
(if (short-width . < . max-proto-width) (if (short-width . < . max-proto-width)
null null
(let loop ([fields fields]) (let loop ([fields (if (null? fields) fields (cdr fields))])
(if (null? fields) (if (null? fields)
null null
(cons (let ([fld (car fields)]) (cons (let ([fld (car fields)])
@ -1310,11 +1311,12 @@
(make-flow (list (field-contract))))))))] (make-flow (list (field-contract))))))))]
[else null])) [else null]))
fields field-contracts))) fields field-contracts)))
(content-thunk)))) (content-thunk))
null))
(define (*defthing stx-ids names form? result-contracts content-thunk) (define (*defthing stx-ids names form? result-contracts content-thunk)
(define spacer (hspace 1)) (define spacer (hspace 1))
(make-splice (make-box-splice
(cons (cons
(make-table (make-table
'boxed 'boxed
@ -1349,86 +1351,89 @@
result-contract result-contract
(make-paragraph (list result-contract))))))))))) (make-paragraph (list result-contract)))))))))))
stx-ids names result-contracts)) stx-ids names result-contracts))
(content-thunk)))) (content-thunk))
null))
(define (meta-symbol? s) (memq s '(... ...+ ?))) (define (meta-symbol? s) (memq s '(... ...+ ?)))
(define (*defforms kw-id lits forms form-procs subs sub-procs content-thunk) (define (*defforms kw-id lits forms form-procs subs sub-procs content-thunk)
(parameterize ([current-variable-list (let ([var-list
(apply (apply
append append
(map (lambda (form) (map (lambda (form)
(let loop ([form (cons (if kw-id (let loop ([form (cons (if kw-id
(if (pair? form) (if (pair? form)
(cdr form) (cdr form)
null) null)
form) form)
subs)]) subs)])
(cond (cond
[(symbol? form) (if (or (meta-symbol? form) [(symbol? form) (if (or (meta-symbol? form)
(memq form lits)) (memq form lits))
null null
(list form))] (list form))]
[(pair? form) (append (loop (car form)) [(pair? form) (append (loop (car form))
(loop (cdr form)))] (loop (cdr form)))]
[else null]))) [else null])))
forms))] forms))])
[current-meta-list '(... ...+)]) (parameterize ([current-variable-list var-list]
(make-splice [current-meta-list '(... ...+)])
(cons (make-box-splice
(make-table (cons
'boxed (make-table
(append 'boxed
(map (lambda (form form-proc) (append
(list (map (lambda (form form-proc)
(make-flow
(list (list
((or form-proc (make-flow
(lambda (x) (list
(make-paragraph ((or form-proc
(list (lambda (x)
(to-element (make-paragraph
`(,x . ,(cdr form))))))) (list
(and kw-id (to-element
(eq? form (car forms)) `(,x . ,(cdr form)))))))
(let ([tag (id-to-tag kw-id)] (and kw-id
[stag (id-to-form-tag kw-id)] (eq? form (car forms))
[content (list (definition-site (if (pair? form) (let ([tag (id-to-tag kw-id)]
(car form) [stag (id-to-form-tag kw-id)]
form) [content (list (definition-site (if (pair? form)
kw-id (car form)
#t))]) form)
(if tag kw-id
(make-target-element #t))])
#f (if tag
(list (make-target-element
(make-toc-target-element
#f #f
(if kw-id (list
(list (make-index-element #f (make-toc-target-element
content #f
tag (if kw-id
(list (symbol->string (syntax-e kw-id))) (list (make-index-element #f
content content
(with-exporting-libraries tag
(lambda (libs) (list (symbol->string (syntax-e kw-id)))
(make-form-index-desc (syntax-e kw-id) libs))))) content
content) (with-exporting-libraries
stag)) (lambda (libs)
tag) (make-form-index-desc (syntax-e kw-id) libs)))))
(car content))))))))) content)
forms form-procs) stag))
(if (null? sub-procs) tag)
null (car content)))))))))
(list (list (make-flow (list (make-paragraph (list (tt 'nbsp)))))) forms form-procs)
(list (make-flow (list (let ([l (map (lambda (sub) (if (null? sub-procs)
(map (lambda (f) (f)) sub)) null
sub-procs)]) (list (list (make-flow (list (make-paragraph (list (tt 'nbsp))))))
(*schemerawgrammars (list (make-flow (list (let ([l (map (lambda (sub)
"specgrammar" (map (lambda (f) (f)) sub))
(map car l) sub-procs)])
(map cdr l)))))))))) (*schemerawgrammars
(content-thunk))))) "specgrammar"
(map car l)
(map cdr l))))))))))
(content-thunk))
var-list))))
(define (*specsubform form has-kw? lits form-thunk subs sub-procs content-thunk) (define (*specsubform form has-kw? lits form-thunk subs sub-procs content-thunk)
(parameterize ([current-variable-list (parameterize ([current-variable-list
@ -1619,26 +1624,43 @@
(define-struct a-bib-entry (key val)) (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 (make-a-bib-entry
key key
(make-element (make-element
#f #f
(list author (append
", " (if author
'ldquo (list author
title ", ")
"," 'rdquo " " null)
location (list 'ldquo
", " title
date (if location
"." ","
(if url ".")
(make-element #f 'rdquo)
(list " " (if location
(link url (list " "
(tt url)))) location
""))))) (if date
","
"."))
null)
(if date
(list " "
date
".")
null)
(if url
(list " "
(link url (tt url)))
null)))))
(define (bibliography #:tag [tag "doc-bibliography"] . citations) (define (bibliography #:tag [tag "doc-bibliography"] . citations)
(make-unnumbered-part (make-unnumbered-part

49
collects/scribblings/scribble/basic.scrbl
View File

@ -29,7 +29,8 @@ For example, the @scheme[title] and @scheme[italic] functions might be
called from Scheme as called from Scheme as
@schemeblock[ @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 or with an @elem["@"] expression as
@ -54,11 +55,11 @@ have @schememodname[scribble/manual]).
title-decl?]{ title-decl?]{
Generates a @scheme[title-decl] to be picked up by @scheme[decode] or 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-part]. The @tech{decode}d @scheme[pre-content] (i.e.,
@scheme[decode-content] for the title content. If @scheme[tag] is parsed with @scheme[decode-content]) supplies the title content. If
@scheme[#f], a tag string is generated automatically from the @scheme[tag] is @scheme[#f], a tag string is generated automatically
content. The tag string is combined with the symbol @scheme['part] to from the content. The tag string is combined with the symbol
form the full tag. @scheme['part] to form the full tag.
A style of @scheme['toc] causes sub-sections to be generated as A style of @scheme['toc] causes sub-sections to be generated as
separate pages in multi-page HTML output. A style of @scheme['index] separate pages in multi-page HTML output. A style of @scheme['index]
@ -94,15 +95,18 @@ removed.}
} }
@defproc[(item [pre-flow any/c] ...) item?]{ @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?]{ @defproc[(item? [v any/c]) boolean?]{
Returns @scheme[#t] if @scheme[v] is an item produced by Returns @scheme[#t] if @scheme[v] is an item produced by
@scheme[item], @scheme[#f] otherwise.} @scheme[item], @scheme[#f] otherwise.}
@defform[(include-section module-path)]{ Requires @scheme[module-path] @defform[(include-section module-path)]{ Requires @scheme[module-path]
and returns its @scheme[doc] export (without making any imports and returns its @scheme[doc] export (without making any imports
visible to the enclosing context). Since this form expands to 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} @section{Text Styles}
@def-elem-proc[elem]{ Parses the @scheme[pre-content] list using @def-elem-proc[elem]{ Wraps the @tech{decode}d @scheme[pre-content] as
@scheme[decode-content], and wraps the result as an element with an element with style @scheme[#f].}
style @scheme[#f].}
@def-elem-proc[aux-elem]{Like @scheme[elem], but creates an @def-elem-proc[aux-elem]{Like @scheme[elem], but creates an
@scheme[aux-element].} @scheme[aux-element].}
@ -126,16 +129,16 @@ style @scheme[#f].}
@def-style-proc[superscript] @def-style-proc[superscript]
@defproc[(hspace [n nonnegative-exact-integer?]) element?]{ @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] ...) @defproc[(span-class [style-name string?] [pre-content any/c] ...)
element?]{ element?]{
Parses the @scheme[pre-content] list using @scheme[decode-content], Wraps the @tech{decode}d @scheme[pre-content] as an element with style
and produces an element with style @scheme[style-name]. @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 Creates an index element given a plain-text string---or list of
strings for a hierarchy, such as @scheme['("strings" "plain")] for a strings for a hierarchy, such as @scheme['("strings" "plain")] for a
``plain'' entry until a more general ``strings'' entry. The strings ``plain'' entry until a more general ``strings'' entry. The strings
also serve as the text to render in the index. The also serve as the text to render in the index. The @tech{decode}d
@scheme[pre-content] list, as parsed by @scheme[decode-content] is the @scheme[pre-content] is the text to appear inline as the index
text to appear in place of the element, to which the index entry target.}
refers.
}
@defproc[(index* [words (listof string?)] @defproc[(index* [words (listof string?)]
[word-contents (listof list?)] [word-contents (listof list?)]
@ -168,7 +169,7 @@ the list of contents render in the index (in parallel to
index-element?]{ index-element?]{
Like @scheme[index], but the word to index is determined by applying 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?] ...) @defproc[(section-index [word string?] ...)

11
collects/scribblings/scribble/decode.scrbl
View File

@ -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?]{ @defproc[(decode [lst list?]) part?]{
Decodes a document, producing a part. In @scheme[lst], instances of Decodes a document, producing a part. In @scheme[lst], instances of

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

@ -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 by newline characters in @scheme[str]. ``Here strings'' are often
useful with @scheme[verbatim].} useful with @scheme[verbatim].}
@defproc[(schemefont [pre-content any/c] ...) element?]{Typesets the given @defproc[(schemefont [pre-content any/c] ...) element?]{Typesets
content as uncolored, unhyperlinked Scheme. This procedure is useful @tech{decode}d @scheme[pre-content] as uncolored, unhyperlinked
for typesetting things like @schemefont{#lang}, which are not Scheme. This procedure is useful for typesetting things like
@scheme[read]able by themselves.} @schemefont{#lang}, which are not @scheme[read]able by themselves.}
@defproc[(schemevalfont [pre-content any/c] ...) element?]{Like @defproc[(schemevalfont [pre-content any/c] ...) element?]{Like
@scheme[schemefont], but colored as a value.} @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 @defproc[(schemeidfont [pre-content any/c] ...) element?]{Like
@scheme[schemefont], but colored as an identifier.} @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 @defproc[(schemekeywordfont [pre-content any/c] ...) element?]{Like
@scheme[schemefont], but colored as a syntactic form name.} @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 @scheme[schemefont], but colored as meta-syntax, such as backquote or
unquote.} unquote.}
@defproc[(procedure [pre-content any/c] ...) element?]{Typesets the given @defproc[(procedure [pre-content any/c] ...) element?]{Typesets
content as a procedure name in a REPL result (e.g., in typewriter font @tech{decode}d @scheme[pre-content] as a procedure name in a REPL
with a @litchar{#<procedure:} prefix and @litchar{>} suffix.).} 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 @defform[(var datum)]{Typesets @scheme[datum] as an identifier that is
an argument or sub-form in a procedure being an argument or sub-form in a procedure being documented. Normally, the
documented. Normally, the @scheme[defproc] and @scheme[defform] @scheme[defproc] and @scheme[defform] arrange for @scheme[scheme] to
arrange for @scheme[scheme] to format such identifiers automatically format such identifiers automatically in the description of the
in the description of the procedure, but use @scheme[var] if that procedure, but use @scheme[var] if that cannot work for some reason.}
cannot work for some reason.}
@defform[(svar datum)]{Like @scheme[var], but for subform non-terminals @defform[(svar datum)]{Like @scheme[var], but for subform non-terminals
in a form definition.} in a form definition.}
@ -175,8 +179,8 @@ in a form definition.}
Produces a sequence of flow elements (encaptured in a @scheme[splice]) Produces a sequence of flow elements (encaptured in a @scheme[splice])
to start the documentation for a module that can be @scheme[require]d 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 using the path @scheme[id]. The @tech{decode}d @scheme[pre-flow]s
flow that documents the procedure (see @scheme[decode-flow]). introduce the module, but need not include all of the module content.
Besides generating text, this form expands to a use of Besides generating text, this form expands to a use of
@scheme[declare-exporting] with @scheme[id]. @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 @scheme[schemeblock0], and it represents a contract on the procedure's
result. result.
The @scheme[pre-flow]s list is parsed as a flow that documents the The @tech{decode}d @scheme[pre-flow] documents the procedure. In this
procedure. In this description, references to @svar[arg-id]s description, references to @svar[arg-id]s using @scheme[scheme],
are typeset as procedure arguments. @scheme[schemeblock], @|etc| are typeset as procedure arguments.
The typesetting of all data before the @scheme[pre-flow]s ignores the The typesetting of all information before the @scheme[pre-flow]s
source layout.} ignores the source layout, except that the local formatting is
preserved for contracts and default-values expressions.}
@defform[(defproc* ([(id arg-spec ...) @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 @scheme[require-for-label]) that determines the module binding being
defined. defined.
The @scheme[pre-flow]s list is parsed as a flow that documents the The @tech{decode}d @scheme[pre-flow] documents the procedure. In this
procedure. In this description, a reference to any identifier in description, a reference to any identifier in @scheme[datum] via
@scheme[datum] is typeset as a sub-form non-terminal. If @scheme[scheme], @scheme[schemeblock], @|etc| is typeset as a sub-form
@scheme[#:literals] clause is provided, however, instances of the non-terminal. If @scheme[#:literals] clause is provided, however,
@scheme[literal-id]s are typeset normally. instances of the @scheme[literal-id]s are typeset normally.
The typesetting of @scheme[(id . datum)] preserves the source 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 ...)]{ @defform[(defform* maybe-literals [(id . datum) ..+] pre-flow ...)]{

3
collects/setup/scribble-index.ss
View File

@ -13,6 +13,7 @@
setup/main-collects) setup/main-collects)
(provide load-xref (provide load-xref
xref?
xref-render xref-render
xref-index xref-index
xref-binding->definition-tag xref-binding->definition-tag
@ -27,6 +28,8 @@
;; Private: ;; Private:
(define-struct xrefs (renderer ri)) (define-struct xrefs (renderer ri))
(define (xref? x) (xrefs? x))
;; ---------------------------------------- ;; ----------------------------------------
;; Xref loading ;; Xref loading