added scheme/help
svn: r8016 original commit: f12a39d97b4d9f445f72a0240c633eab752447d8
This commit is contained in:
Matthew Flatt
parent
65702bffbe
commit
2dcde7a5e2
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
(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"
|
||||
(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
|
||||
(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))))))
|
||||
(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"
|
||||
(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
|
||||
(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
|
||||
|
|
|
|||
|
|
@ -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?] ...)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ...)]{
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user