scribble: add style to distinguish definition sites
original commit: e4a0bff456d2c40d688c6b49322ed94ec666b69c
This commit is contained in:
Matthew Flatt
parent
d96d31582f
commit
cc37b26e35
|
|
@ -894,6 +894,12 @@ Like @racket[target-element], the content is also a kind of section
|
|||
label to be shown in the ``on this page'' table for HTML output.}
|
||||
|
||||
|
||||
@defstruct[(toc-target2-element toc-target-element) ([toc-content content?])]{
|
||||
|
||||
Extends @racket[target-element] with a separate field for the content
|
||||
to be shown in the ``on this page'' table for HTML output.}
|
||||
|
||||
|
||||
@defstruct[(page-target-element target-element) ()]{
|
||||
|
||||
Like @racket[target-element], but a link to the element goes to the
|
||||
|
|
|
|||
|
|
@ -102,11 +102,13 @@ it is added to the end on its own line.}
|
|||
|
||||
@defproc[(to-element [v any/c]
|
||||
[#:expr? expr? any/c #f]
|
||||
[#:escapes? escapes? any/c #t]) element?]{
|
||||
[#:escapes? escapes? any/c #t]
|
||||
[#:defn? defn? any/c #f]) element?]{
|
||||
|
||||
Like @racket[to-paragraph], except that source-location information is
|
||||
mostly ignored, since the result is meant to be inlined into a
|
||||
paragraph.}
|
||||
paragraph. If @racket[defn?] is true, then an identifier is styled as
|
||||
a definition site.}
|
||||
|
||||
@defproc[(to-element/no-color [v any/c]
|
||||
[#:expr? expr? any/c #f]
|
||||
|
|
|
|||
|
|
@ -1,11 +1,11 @@
|
|||
#lang scribble/manual
|
||||
@(require (except-in "utils.rkt"
|
||||
make-part make-paragraph make-table make-itemization make-compound-paragraph
|
||||
make-element make-toc-element make-target-element make-toc-target-element
|
||||
make-element make-toc-element make-target-element make-toc-target-element make-toc-target2-element
|
||||
make-page-target-element make-redirect-target-element make-link-element
|
||||
make-index-element
|
||||
make-target-url target-url struct:target-url target-url? target-url-addr
|
||||
toc-element-toc-content part-title-content paragraph-content
|
||||
toc-element-toc-content toc-target2-element-toc-content part-title-content paragraph-content
|
||||
element? element-content element-style)
|
||||
(for-label scribble/manual-struct
|
||||
scribble/struct
|
||||
|
|
@ -38,7 +38,7 @@ The following structure types are re-exported, but the constructors and some sel
|
|||
are replaced as documented further below:
|
||||
|
||||
@racketblock[part paragraph table itemization compound-paragraph
|
||||
element toc-element target-element toc-target-element
|
||||
element toc-element target-element toc-target-element toc-target2-element
|
||||
page-target-element redirect-target-element link-element
|
||||
index-element]
|
||||
|
||||
|
|
@ -201,6 +201,7 @@ formats to the current one.}
|
|||
@defproc[(make-toc-element [style any/c] [content list?] [toc-content list?]) toc-element?]
|
||||
@defproc[(make-target-element [style any/c] [content list?] [tag tag?]) target-element?]
|
||||
@defproc[(make-toc-target-element [style any/c] [content list?] [tag tag?]) toc-target-element?]
|
||||
@defproc[(make-toc-target2-element [style any/c] [content list?] [tag tag?] [toc-content content?]) toc-target2-element?]
|
||||
@defproc[(make-page-target-element [style any/c] [content list?] [tag tag?]) page-target-element?]
|
||||
@defproc[(make-redirect-target-element [style any/c] [content list?] [tag tag?]
|
||||
[alt-path path-string?] [alt-anchor string?]) redirect-target-element?]
|
||||
|
|
|
|||
|
|
@ -645,7 +645,11 @@
|
|||
(when (multiarg-element? i)
|
||||
(collect-content (multiarg-element-contents i) ci))
|
||||
(when (list? i)
|
||||
(for ([e (in-list i)]) (collect-content e ci))))))
|
||||
(for ([e (in-list i)]) (collect-content e ci)))
|
||||
(when (toc-element? i)
|
||||
(collect-content (toc-element-toc-content i) ci))
|
||||
(when (toc-target2-element? i)
|
||||
(collect-content (toc-target2-element-toc-content i) ci)))))
|
||||
|
||||
(define/public (collect-target-element i ci)
|
||||
(let ([t (generate-tag (target-element-tag i) ci)])
|
||||
|
|
@ -741,7 +745,10 @@
|
|||
(hash-set! (resolve-info-delays ri) e v))))]
|
||||
[(link-element? i)
|
||||
(resolve-get d ri (link-element-tag i))])
|
||||
(resolve-content (element-content i) d ri)]
|
||||
(resolve-content (element-content i) d ri)
|
||||
(cond
|
||||
[(toc-target2-element? i) (resolve-content (toc-target2-element-toc-content i) d ri)]
|
||||
[(toc-element? i) (resolve-content (toc-element-toc-content i) d ri)])]
|
||||
[(multiarg-element? i)
|
||||
(resolve-content (multiarg-element-contents i) d ri)]))
|
||||
|
||||
|
|
|
|||
|
|
@ -180,6 +180,7 @@
|
|||
[(toc-element element) ([toc-content content?])]
|
||||
[(target-element element) ([tag tag?])]
|
||||
[(toc-target-element target-element) ()]
|
||||
[(toc-target2-element toc-target-element) ([toc-content content?])]
|
||||
[(page-target-element target-element) ()]
|
||||
[(redirect-target-element target-element) ([alt-path path-string?]
|
||||
[alt-anchor string?])]
|
||||
|
|
|
|||
|
|
@ -722,7 +722,9 @@
|
|||
(if (part? p)
|
||||
(or (part-title-content p)
|
||||
"???")
|
||||
(element-content p))
|
||||
(if (toc-target2-element? p)
|
||||
(toc-target2-element-toc-content p)
|
||||
(element-content p)))
|
||||
d ri)))))))))
|
||||
ps)))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -36,7 +36,7 @@
|
|||
(define-syntax-rule (sigelem sig elem)
|
||||
(*sig-elem (quote-syntax sig) 'elem))
|
||||
|
||||
(define (*sig-elem sig elem)
|
||||
(define (*sig-elem sig elem #:defn? [defn? #f])
|
||||
(let ([s (to-element/no-color elem)])
|
||||
(make-delayed-element
|
||||
(lambda (renderer sec ri)
|
||||
|
|
@ -48,8 +48,8 @@
|
|||
(make-element
|
||||
symbol-color
|
||||
(list
|
||||
(cond [sd (make-link-element syntax-link-color (list s) stag)]
|
||||
[vtag (make-link-element value-link-color (list s) vtag)]
|
||||
(cond [sd (make-link-element (if defn? syntax-def-color syntax-link-color) (list s) stag)]
|
||||
[vtag (make-link-element (if defn? value-def-color value-link-color) (list s) vtag)]
|
||||
[else s])))))
|
||||
(lambda () s)
|
||||
(lambda () s))))
|
||||
|
|
@ -90,10 +90,12 @@
|
|||
|
||||
(define (definition-site name stx-id form?)
|
||||
(let ([sig (current-signature)])
|
||||
(if sig
|
||||
(*sig-elem (sig-id sig) name)
|
||||
(annote-exporting-library
|
||||
(to-element (make-just-context name stx-id))))))
|
||||
(define (gen defn?)
|
||||
(if sig
|
||||
(*sig-elem #:defn? defn? (sig-id sig) name)
|
||||
(annote-exporting-library
|
||||
(to-element #:defn? defn? (make-just-context name stx-id)))))
|
||||
(values (gen #t) (gen #f))))
|
||||
|
||||
(define checkers (make-hash))
|
||||
|
||||
|
|
@ -177,10 +179,12 @@
|
|||
(let ([dep? #t])
|
||||
(let ([maker (if form?
|
||||
(id-to-form-target-maker id dep?)
|
||||
(id-to-target-maker id dep?))]
|
||||
[elem (if show-libs?
|
||||
(definition-site (syntax-e id) id form?)
|
||||
(to-element id))])
|
||||
(id-to-target-maker id dep?))])
|
||||
(define-values (elem elem-ref)
|
||||
(if show-libs?
|
||||
(definition-site (syntax-e id) id form?)
|
||||
(values (to-element id #:defn? #t)
|
||||
(to-element id))))
|
||||
(if maker
|
||||
(maker elem
|
||||
(lambda (tag)
|
||||
|
|
|
|||
|
|
@ -195,27 +195,30 @@
|
|||
(list
|
||||
(make-omitable-paragraph
|
||||
(list (let ([target-maker (id-to-target-maker stx-id #t)]
|
||||
[content (list (annote-exporting-library
|
||||
(to-element stx-id)))])
|
||||
[content (annote-exporting-library
|
||||
(to-element #:defn? #t stx-id))]
|
||||
[ref-content (annote-exporting-library
|
||||
(to-element stx-id))])
|
||||
(if target-maker
|
||||
(target-maker
|
||||
content
|
||||
(lambda (tag)
|
||||
((if whole-page?
|
||||
make-page-target-element
|
||||
make-toc-target-element)
|
||||
(lambda (s c t)
|
||||
(make-toc-target2-element s c t ref-content)))
|
||||
#f
|
||||
(list
|
||||
(make-index-element
|
||||
#f content tag
|
||||
(list (datum-intern-literal
|
||||
(symbol->string (syntax-e stx-id))))
|
||||
content
|
||||
(list ref-content)
|
||||
(with-exporting-libraries
|
||||
(lambda (libs)
|
||||
(make-index-desc (syntax-e stx-id) libs)))))
|
||||
tag)))
|
||||
(car content)))
|
||||
content))
|
||||
spacer ":" spacer
|
||||
(case kind
|
||||
[(class) (racket class?)]
|
||||
|
|
|
|||
|
|
@ -87,26 +87,26 @@
|
|||
[defined-id-expr (if (syntax-e #'d.defined-id-expr)
|
||||
#'d.defined-id-expr
|
||||
#'(quote-syntax defined-id))]
|
||||
[new-spec
|
||||
(let loop ([spec #'spec])
|
||||
(if (and (identifier? spec)
|
||||
(free-identifier=? spec #'defined-id))
|
||||
(datum->syntax #'here '(unsyntax x) spec spec)
|
||||
(syntax-case spec ()
|
||||
[(a . b)
|
||||
(datum->syntax spec
|
||||
(cons (loop #'a) (loop #'b))
|
||||
spec
|
||||
spec)]
|
||||
[_ spec])))])
|
||||
#'(with-togetherable-racket-variables
|
||||
[(new-spec ...)
|
||||
(for/list ([spec (in-list (syntax->list #'(spec spec1 ...)))])
|
||||
(let loop ([spec spec])
|
||||
(if (and (identifier? spec)
|
||||
(free-identifier=? spec #'defined-id))
|
||||
(datum->syntax #'here '(unsyntax x) spec spec)
|
||||
(syntax-case spec ()
|
||||
[(a . b)
|
||||
(datum->syntax spec
|
||||
(cons (loop #'a) (loop #'b))
|
||||
spec
|
||||
spec)]
|
||||
[_ spec]))))])
|
||||
#'(with-togetherable-racket-variables
|
||||
(l.lit ...)
|
||||
([form [defined-id spec]] [form [defined-id spec1]] ...
|
||||
[non-term (g.non-term-id g.non-term-form ...)] ...)
|
||||
(*defforms k.kind lt.expr defined-id-expr
|
||||
'(spec spec1 ...)
|
||||
(list (lambda (x) (racketblock0/form new-spec))
|
||||
(lambda (ignored) (racketblock0/form spec1)) ...)
|
||||
(list (lambda (x) (racketblock0/form new-spec)) ...)
|
||||
'((g.non-term-id g.non-term-form ...) ...)
|
||||
(list (list (lambda () (racket g.non-term-id))
|
||||
(lambda () (racketblock0/form g.non-term-form))
|
||||
|
|
@ -298,27 +298,27 @@
|
|||
(define (meta-symbol? s) (memq s '(... ...+ ?)))
|
||||
|
||||
(define (defform-site kw-id)
|
||||
(let ([target-maker (id-to-form-target-maker kw-id #t)]
|
||||
[content (list (definition-site (syntax-e kw-id)
|
||||
kw-id #t))])
|
||||
(let ([target-maker (id-to-form-target-maker kw-id #t)])
|
||||
(define-values (content ref-content) (definition-site (syntax-e kw-id) kw-id #t))
|
||||
(if target-maker
|
||||
(target-maker
|
||||
content
|
||||
(lambda (tag)
|
||||
(make-toc-target-element
|
||||
(make-toc-target2-element
|
||||
#f
|
||||
(if kw-id
|
||||
(list (make-index-element
|
||||
#f content tag
|
||||
(list (datum-intern-literal (symbol->string (syntax-e kw-id))))
|
||||
content
|
||||
(with-exporting-libraries
|
||||
(lambda (libs)
|
||||
(make-form-index-desc (syntax-e kw-id)
|
||||
libs)))))
|
||||
(make-index-element
|
||||
#f content tag
|
||||
(list (datum-intern-literal (symbol->string (syntax-e kw-id))))
|
||||
(list ref-content)
|
||||
(with-exporting-libraries
|
||||
(lambda (libs)
|
||||
(make-form-index-desc (syntax-e kw-id)
|
||||
libs))))
|
||||
content)
|
||||
tag)))
|
||||
(car content))))
|
||||
tag
|
||||
ref-content)))
|
||||
content)))
|
||||
|
||||
(define (*defforms kind link? kw-id forms form-procs subs sub-procs contract-procs content-thunk)
|
||||
(parameterize ([current-meta-list '(... ...+)])
|
||||
|
|
@ -341,10 +341,11 @@
|
|||
(make-omitable-paragraph
|
||||
(list (to-element `(,x . ,(cdr form)))))))
|
||||
(and kw-id
|
||||
(eq? form (car forms))
|
||||
(if link?
|
||||
(defform-site kw-id)
|
||||
(to-element kw-id))))))))
|
||||
(if (eq? form (car forms))
|
||||
(if link?
|
||||
(defform-site kw-id)
|
||||
(to-element #:defn? #t kw-id))
|
||||
(to-element #:defn? #t kw-id))))))))
|
||||
(if (null? sub-procs)
|
||||
null
|
||||
(list (list flow-empty-line)
|
||||
|
|
|
|||
|
|
@ -20,14 +20,19 @@
|
|||
(define-syntax-rule (xmethod class/intf-id method-id)
|
||||
(elem (method class/intf-id method-id) " in " (racket class/intf-id)))
|
||||
|
||||
(define (*method sym id)
|
||||
(**method sym id))
|
||||
(define (*method sym id
|
||||
#:defn? [defn? #f])
|
||||
(**method sym id #:defn? defn?))
|
||||
|
||||
(define (**method sym id/tag)
|
||||
(define (**method sym id/tag
|
||||
#:defn? [defn? #f])
|
||||
(define content (list (symbol->string sym)))
|
||||
(define (mk tag)
|
||||
(make-element symbol-color
|
||||
(list (make-link-element value-link-color content
|
||||
(list (make-link-element (if defn?
|
||||
value-def-color
|
||||
value-link-color)
|
||||
content
|
||||
(method-tag tag sym)))))
|
||||
(if (identifier? id/tag)
|
||||
(make-delayed-element
|
||||
|
|
|
|||
|
|
@ -332,54 +332,57 @@
|
|||
(if (and first? link?)
|
||||
(let* ([mname (extract-id prototype stx-id)]
|
||||
[target-maker (id-to-target-maker within-id #f)]
|
||||
[content (list (*method mname within-id))])
|
||||
[content (*method mname within-id #:defn? #t)]
|
||||
[ref-content (*method mname within-id)])
|
||||
(if target-maker
|
||||
(target-maker
|
||||
content
|
||||
(lambda (ctag)
|
||||
(let ([tag (method-tag ctag mname)])
|
||||
(make-toc-target-element
|
||||
(make-toc-target2-element
|
||||
#f
|
||||
(list (make-index-element
|
||||
#f
|
||||
content
|
||||
tag
|
||||
(list (datum-intern-literal (symbol->string mname)))
|
||||
content
|
||||
(list ref-content)
|
||||
(with-exporting-libraries
|
||||
(lambda (libs)
|
||||
(make-method-index-desc
|
||||
(syntax-e within-id)
|
||||
libs mname ctag)))))
|
||||
tag))))
|
||||
(car content)))
|
||||
(*method (extract-id prototype stx-id) within-id))))]
|
||||
tag
|
||||
ref-content))))
|
||||
content))
|
||||
(*method (extract-id prototype stx-id) within-id #:defn? #t))))]
|
||||
[(and first? link?)
|
||||
(define the-id (extract-id prototype stx-id))
|
||||
(let ([target-maker (id-to-target-maker stx-id #t)]
|
||||
[content (list (definition-site the-id stx-id #f))])
|
||||
(let ([target-maker (id-to-target-maker stx-id #t)])
|
||||
(define-values (content ref-content) (definition-site the-id stx-id #f))
|
||||
(if target-maker
|
||||
(target-maker
|
||||
content
|
||||
(lambda (tag)
|
||||
(make-toc-target-element
|
||||
#f
|
||||
(list (make-index-element
|
||||
#f content tag
|
||||
(list (datum-intern-literal (symbol->string the-id)))
|
||||
content
|
||||
(with-exporting-libraries
|
||||
(lambda (libs)
|
||||
(make-procedure-index-desc the-id libs)))))
|
||||
tag)))
|
||||
(car content)))]
|
||||
(target-maker
|
||||
content
|
||||
(lambda (tag)
|
||||
(make-toc-target2-element
|
||||
#f
|
||||
(make-index-element
|
||||
#f content tag
|
||||
(list (datum-intern-literal (symbol->string the-id)))
|
||||
(list ref-content)
|
||||
(with-exporting-libraries
|
||||
(lambda (libs)
|
||||
(make-procedure-index-desc the-id libs))))
|
||||
tag
|
||||
ref-content)))
|
||||
content))]
|
||||
[else
|
||||
(define the-id (extract-id prototype stx-id))
|
||||
((if link? annote-exporting-library values)
|
||||
(let ([sig (current-signature)])
|
||||
(if sig
|
||||
(*sig-elem (sig-id sig) the-id)
|
||||
(to-element (make-just-context the-id stx-id)))))]))
|
||||
(*sig-elem #:defn? #t (sig-id sig) the-id)
|
||||
(to-element #:defn? #t (make-just-context the-id stx-id)))))]))
|
||||
(define p-depth (prototype-depth prototype))
|
||||
(define flat-size (+ (prototype-size args + + #f)
|
||||
p-depth
|
||||
|
|
@ -698,45 +701,47 @@
|
|||
(list
|
||||
(let* ([the-name
|
||||
(let ([just-name
|
||||
(if link?
|
||||
(make-target-element*
|
||||
make-toc-target-element
|
||||
(if (pair? name)
|
||||
(car (syntax-e stx-id))
|
||||
stx-id)
|
||||
(annote-exporting-library
|
||||
(to-element
|
||||
(if (pair? name)
|
||||
(make-just-context (car name)
|
||||
(car (syntax-e stx-id)))
|
||||
stx-id)))
|
||||
(let ([name (if (pair? name) (car name) name)])
|
||||
(list* (list 'info name)
|
||||
(list 'type 'struct: name)
|
||||
(list 'predicate name '?)
|
||||
(append
|
||||
(if cname-id
|
||||
(list (list 'constructor (syntax-e cname-id)))
|
||||
null)
|
||||
(map (lambda (f)
|
||||
(list 'accessor name '-
|
||||
(field-name f)))
|
||||
fields)
|
||||
(filter-map
|
||||
(lambda (f)
|
||||
(if (or (not immutable?)
|
||||
(and (pair? (car f))
|
||||
(memq '#:mutable
|
||||
(car f))))
|
||||
(list 'mutator 'set- name '-
|
||||
(field-name f) '!)
|
||||
#f))
|
||||
fields)))))
|
||||
(to-element
|
||||
(if (pair? name)
|
||||
(make-just-context (car name)
|
||||
(car (syntax-e stx-id)))
|
||||
stx-id)))])
|
||||
(let ([name-id (if (pair? name)
|
||||
(make-just-context (car name)
|
||||
(car (syntax-e stx-id)))
|
||||
stx-id)])
|
||||
(if link?
|
||||
(let ()
|
||||
(define (gen defn?)
|
||||
(annote-exporting-library
|
||||
(to-element #:defn? defn? name-id)))
|
||||
(define content (gen #t))
|
||||
(define ref-content (gen #f))
|
||||
(make-target-element*
|
||||
(lambda (s c t)
|
||||
(make-toc-target2-element s c t ref-content))
|
||||
(if (pair? name)
|
||||
(car (syntax-e stx-id))
|
||||
stx-id)
|
||||
content
|
||||
(let ([name (if (pair? name) (car name) name)])
|
||||
(list* (list 'info name)
|
||||
(list 'type 'struct: name)
|
||||
(list 'predicate name '?)
|
||||
(append
|
||||
(if cname-id
|
||||
(list (list 'constructor (syntax-e cname-id)))
|
||||
null)
|
||||
(map (lambda (f)
|
||||
(list 'accessor name '-
|
||||
(field-name f)))
|
||||
fields)
|
||||
(filter-map
|
||||
(lambda (f)
|
||||
(if (or (not immutable?)
|
||||
(and (pair? (car f))
|
||||
(memq '#:mutable
|
||||
(car f))))
|
||||
(list 'mutator 'set- name '-
|
||||
(field-name f) '!)
|
||||
#f))
|
||||
fields))))))
|
||||
(to-element #:defn? #t name-id)))])
|
||||
(if (pair? name)
|
||||
(make-element
|
||||
#f
|
||||
|
|
@ -1024,27 +1029,30 @@
|
|||
(let ([target-maker
|
||||
(and link?
|
||||
((if form? id-to-form-target-maker id-to-target-maker)
|
||||
stx-id #t))]
|
||||
[content (list (if link?
|
||||
(definition-site name stx-id form?)
|
||||
(to-element (make-just-context name stx-id))))])
|
||||
stx-id #t))])
|
||||
(define-values (content ref-content)
|
||||
(if link?
|
||||
(definition-site name stx-id form?)
|
||||
(let ([s (make-just-context name stx-id)])
|
||||
(values (to-element #:defn? #t s)
|
||||
(to-element s)))))
|
||||
(if target-maker
|
||||
(target-maker
|
||||
content
|
||||
(lambda (tag)
|
||||
(make-toc-target-element
|
||||
(make-toc-target2-element
|
||||
#f
|
||||
(list
|
||||
(make-index-element
|
||||
#f
|
||||
content
|
||||
tag
|
||||
(list (datum-intern-literal (symbol->string name)))
|
||||
content
|
||||
(with-exporting-libraries
|
||||
(lambda (libs) (make-thing-index-desc name libs)))))
|
||||
tag)))
|
||||
(car content)))))))
|
||||
(make-index-element
|
||||
#f
|
||||
content
|
||||
tag
|
||||
(list (datum-intern-literal (symbol->string name)))
|
||||
(list ref-content)
|
||||
(with-exporting-libraries
|
||||
(lambda (libs) (make-thing-index-desc name libs))))
|
||||
tag
|
||||
ref-content)))
|
||||
content))))))
|
||||
(make-flow
|
||||
(list
|
||||
(make-omitable-paragraph
|
||||
|
|
@ -1087,24 +1095,23 @@
|
|||
#t)])
|
||||
(if target-maker
|
||||
(target-maker
|
||||
(list content)
|
||||
content
|
||||
(lambda (tag)
|
||||
(inner-make-target-element
|
||||
#f
|
||||
(list
|
||||
(make-index-element
|
||||
#f
|
||||
(list content)
|
||||
tag
|
||||
(list name)
|
||||
(list (racketidfont (make-element value-link-color
|
||||
(list name))))
|
||||
(with-exporting-libraries
|
||||
(lambda (libs)
|
||||
(let ([name (string->symbol name)])
|
||||
(if (eq? 'info (caar wrappers))
|
||||
(make-struct-index-desc name libs)
|
||||
(make-procedure-index-desc name libs)))))))
|
||||
(make-index-element
|
||||
#f
|
||||
content
|
||||
tag
|
||||
(list name)
|
||||
(list (racketidfont (make-element value-link-color
|
||||
(list name))))
|
||||
(with-exporting-libraries
|
||||
(lambda (libs)
|
||||
(let ([name (string->symbol name)])
|
||||
(if (eq? 'info (caar wrappers))
|
||||
(make-struct-index-desc name libs)
|
||||
(make-procedure-index-desc name libs))))))
|
||||
tag)))
|
||||
content))
|
||||
(cdr wrappers))))
|
||||
|
|
|
|||
|
|
@ -91,11 +91,17 @@
|
|||
color: #262680;
|
||||
}
|
||||
|
||||
.RktSymDef { /* used with RktSym at def site */
|
||||
}
|
||||
|
||||
.RktValLink {
|
||||
text-decoration: none;
|
||||
color: blue;
|
||||
}
|
||||
|
||||
.RktValDef { /* used with RktValLink at def site */
|
||||
}
|
||||
|
||||
.RktModLink {
|
||||
text-decoration: none;
|
||||
color: blue;
|
||||
|
|
@ -107,6 +113,9 @@
|
|||
/* font-weight: bold; */
|
||||
}
|
||||
|
||||
.RktStxDef { /* used with RktStxLink at def site */
|
||||
}
|
||||
|
||||
.RktRes {
|
||||
color: #0000af;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -4,6 +4,7 @@
|
|||
"search.rkt"
|
||||
"private/manual-sprop.rkt"
|
||||
"private/on-demand.rkt"
|
||||
"html-properties.rkt"
|
||||
file/convertible
|
||||
racket/extflonum
|
||||
(for-syntax racket/base))
|
||||
|
|
@ -36,6 +37,8 @@
|
|||
error-color
|
||||
syntax-link-color
|
||||
value-link-color
|
||||
syntax-def-color
|
||||
value-def-color
|
||||
module-color
|
||||
module-link-color
|
||||
block-color
|
||||
|
|
@ -52,10 +55,15 @@
|
|||
make-element-id-transformer
|
||||
element-id-transformer?))
|
||||
|
||||
(define (make-racket-style s #:tt? [tt? #t])
|
||||
(define (make-racket-style s
|
||||
#:tt? [tt? #t]
|
||||
#:extras [extras null])
|
||||
(make-style s (if tt?
|
||||
(cons 'tt-chars scheme-properties)
|
||||
scheme-properties)))
|
||||
(cons 'tt-chars
|
||||
(append extras
|
||||
scheme-properties))
|
||||
(append extras
|
||||
scheme-properties))))
|
||||
|
||||
(define-on-demand output-color (make-racket-style "RktOut"))
|
||||
(define-on-demand input-color (make-racket-style "RktIn"))
|
||||
|
|
@ -69,11 +77,17 @@
|
|||
(define-on-demand meta-color (make-racket-style "RktMeta"))
|
||||
(define-on-demand value-color (make-racket-style "RktVal"))
|
||||
(define-on-demand symbol-color (make-racket-style "RktSym"))
|
||||
(define-on-demand symbol-def-color (make-racket-style "RktSymDef"
|
||||
#:extras (list (attributes '((class . "RktSym"))))))
|
||||
(define-on-demand variable-color (make-racket-style "RktVar"))
|
||||
(define-on-demand opt-color (make-racket-style "RktOpt"))
|
||||
(define-on-demand error-color (make-racket-style "RktErr" #:tt? #f))
|
||||
(define-on-demand syntax-link-color (make-racket-style "RktStxLink"))
|
||||
(define-on-demand value-link-color (make-racket-style "RktValLink"))
|
||||
(define-on-demand syntax-def-color (make-racket-style "RktStxDef"
|
||||
#:extras (list (attributes '((class . "RktStxLink"))))))
|
||||
(define-on-demand value-def-color (make-racket-style "RktValDef"
|
||||
#:extras (list (attributes '((class . "RktValLink"))))))
|
||||
(define-on-demand module-color (make-racket-style "RktMod"))
|
||||
(define-on-demand module-link-color (make-racket-style "RktModLink"))
|
||||
(define-on-demand block-color (make-racket-style "RktBlk"))
|
||||
|
|
@ -134,14 +148,15 @@
|
|||
|
||||
(define qq-ellipses (string->uninterned-symbol "..."))
|
||||
|
||||
(define (make-id-element c s)
|
||||
(define (make-id-element c s defn?)
|
||||
(let* ([key (and id-element-cache
|
||||
(let ([b (identifier-label-binding c)])
|
||||
(vector (syntax-e c)
|
||||
(module-path-index->taglet (caddr b))
|
||||
(cadddr b)
|
||||
(list-ref b 5)
|
||||
(syntax-property c 'display-string))))])
|
||||
(syntax-property c 'display-string)
|
||||
defn?)))])
|
||||
(or (and key
|
||||
(let ([b (hash-ref id-element-cache key #f)])
|
||||
(and b
|
||||
|
|
@ -154,9 +169,17 @@
|
|||
(list
|
||||
(case (car tag)
|
||||
[(form)
|
||||
(make-link-element syntax-link-color (nonbreak-leading-hyphens s) tag)]
|
||||
(make-link-element (if defn?
|
||||
syntax-def-color
|
||||
syntax-link-color)
|
||||
(nonbreak-leading-hyphens s)
|
||||
tag)]
|
||||
[else
|
||||
(make-link-element value-link-color (nonbreak-leading-hyphens s) tag)])))
|
||||
(make-link-element (if defn?
|
||||
value-def-color
|
||||
value-link-color)
|
||||
(nonbreak-leading-hyphens s)
|
||||
tag)])))
|
||||
(list
|
||||
(make-element "badlink"
|
||||
(make-element value-link-color s))))))
|
||||
|
|
@ -201,7 +224,7 @@
|
|||
[(str val) (datum-intern-literal (format str val))]
|
||||
[(str . vals) (datum-intern-literal (apply format str vals))]))
|
||||
|
||||
(define (typeset-atom c out color? quote-depth expr? escapes?)
|
||||
(define (typeset-atom c out color? quote-depth expr? escapes? defn?)
|
||||
(if (and (var-id? (syntax-e c))
|
||||
(zero? quote-depth))
|
||||
(out (iformat "~s" (let ([v (var-id-sym (syntax-e c))])
|
||||
|
|
@ -252,8 +275,11 @@
|
|||
(quote-depth . <= . 0)
|
||||
(not (or it? is-var?)))
|
||||
(if (pair? (identifier-label-binding c))
|
||||
(make-id-element c s)
|
||||
(nonbreak-leading-hyphens s))
|
||||
(make-id-element c s defn?)
|
||||
(let ([c (nonbreak-leading-hyphens s)])
|
||||
(if defn?
|
||||
(make-element symbol-def-color c)
|
||||
c)))
|
||||
(literalize-spaces s #t))
|
||||
(cond
|
||||
[(positive? quote-depth) value-color]
|
||||
|
|
@ -284,7 +310,7 @@
|
|||
|
||||
(define omitable (make-style #f '(omitable)))
|
||||
|
||||
(define (gen-typeset c multi-line? prefix1 prefix suffix color? expr? escapes? elem-wrap)
|
||||
(define (gen-typeset c multi-line? prefix1 prefix suffix color? expr? escapes? defn? elem-wrap)
|
||||
(let* ([c (syntax-ize c 0 #:expr? expr?)]
|
||||
[content null]
|
||||
[docs null]
|
||||
|
|
@ -406,7 +432,7 @@
|
|||
(if val? value-color #f)
|
||||
(list
|
||||
(make-element/cache (if val? value-color paren-color) '". ")
|
||||
(typeset a #f "" "" "" (not val?) expr? escapes? elem-wrap)
|
||||
(typeset a #f "" "" "" (not val?) expr? escapes? defn? elem-wrap)
|
||||
(make-element/cache (if val? value-color paren-color) '" ."))
|
||||
(+ (syntax-span a) 4)))
|
||||
(list (syntax-source a)
|
||||
|
|
@ -818,11 +844,11 @@
|
|||
[(and (keyword? (syntax-e c)) expr?)
|
||||
(advance c init-line!)
|
||||
(let ([quote-depth (to-quoted c expr? quote-depth out color? inc-src-col)])
|
||||
(typeset-atom c out color? quote-depth expr? escapes?)
|
||||
(typeset-atom c out color? quote-depth expr? escapes? defn?)
|
||||
(set! src-col (+ src-col (or (syntax-span c) 1))))]
|
||||
[else
|
||||
(advance c init-line!)
|
||||
(typeset-atom c out color? quote-depth expr? escapes?)
|
||||
(typeset-atom c out color? quote-depth expr? escapes? defn?)
|
||||
(set! src-col (+ src-col (or (syntax-span c) 1)))
|
||||
#;
|
||||
(hash-set! next-col-map src-col dest-col)])))
|
||||
|
|
@ -844,7 +870,7 @@
|
|||
(make-table block-color (map list (reverse docs))))
|
||||
(make-sized-element #f (reverse content) dest-col))))
|
||||
|
||||
(define (typeset c multi-line? prefix1 prefix suffix color? expr? escapes? elem-wrap)
|
||||
(define (typeset c multi-line? prefix1 prefix suffix color? expr? escapes? defn? elem-wrap)
|
||||
(let* ([c (syntax-ize c 0 #:expr? expr?)]
|
||||
[s (syntax-e c)])
|
||||
(if (or multi-line?
|
||||
|
|
@ -861,7 +887,7 @@
|
|||
(struct-proxy? s)
|
||||
(and expr? (or (identifier? c)
|
||||
(keyword? (syntax-e c)))))
|
||||
(gen-typeset c multi-line? prefix1 prefix suffix color? expr? escapes? elem-wrap)
|
||||
(gen-typeset c multi-line? prefix1 prefix suffix color? expr? escapes? defn? elem-wrap)
|
||||
(typeset-atom c
|
||||
(letrec ([mk
|
||||
(case-lambda
|
||||
|
|
@ -874,31 +900,32 @@
|
|||
(make-element/cache (and color? color) elem)
|
||||
(make-sized-element (and color? color) elem len)))])])
|
||||
mk)
|
||||
color? 0 expr? escapes?))))
|
||||
color? 0 expr? escapes? defn?))))
|
||||
|
||||
(define (to-element c
|
||||
#:expr? [expr? #f]
|
||||
#:escapes? [escapes? #t])
|
||||
(typeset c #f "" "" "" #t expr? escapes? values))
|
||||
#:escapes? [escapes? #t]
|
||||
#:defn? [defn? #f])
|
||||
(typeset c #f "" "" "" #t expr? escapes? defn? values))
|
||||
|
||||
(define (to-element/no-color c
|
||||
#:expr? [expr? #f]
|
||||
#:escapes? [escapes? #t])
|
||||
(typeset c #f "" "" "" #f expr? escapes? values))
|
||||
(typeset c #f "" "" "" #f expr? escapes? #f values))
|
||||
|
||||
(define (to-paragraph c
|
||||
#:expr? [expr? #f]
|
||||
#:escapes? [escapes? #t]
|
||||
#:color? [color? #t]
|
||||
#:wrap-elem [elem-wrap (lambda (e) e)])
|
||||
(typeset c #t "" "" "" color? expr? escapes? elem-wrap))
|
||||
(typeset c #t "" "" "" color? expr? escapes? #f elem-wrap))
|
||||
|
||||
(define ((to-paragraph/prefix pfx1 pfx sfx) c
|
||||
#:expr? [expr? #f]
|
||||
#:escapes? [escapes? #t]
|
||||
#:color? [color? #t]
|
||||
#:wrap-elem [elem-wrap (lambda (e) e)])
|
||||
(typeset c #t pfx1 pfx sfx color? expr? escapes? elem-wrap))
|
||||
(typeset c #t pfx1 pfx sfx color? expr? escapes? #f elem-wrap))
|
||||
|
||||
(begin-for-syntax
|
||||
(define-struct variable-id (sym)
|
||||
|
|
|
|||
|
|
@ -15,12 +15,15 @@
|
|||
\newcommand{\RktPlain}[1]{\inColor{black}{#1}}
|
||||
\newcommand{\RktKw}[1]{{\SColorize{black}{\Scribtexttt{#1}}}} % no \textbf anymore
|
||||
\newcommand{\RktStxLink}[1]{\RktKw{#1}}
|
||||
\newcommand{\RktStxDef}[1]{\RktStxLink{#1}}
|
||||
\newcommand{\RktCmt}[1]{\inColor{CommentColor}{#1}}
|
||||
\newcommand{\RktPn}[1]{\inColor{ParenColor}{#1}}
|
||||
\newcommand{\RktInBG}[1]{\inColor{ParenColor}{#1}}
|
||||
\newcommand{\RktSym}[1]{\inColor{IdentifierColor}{#1}}
|
||||
\newcommand{\RktSymDef}[1]{\RktSym{#1}}
|
||||
\newcommand{\RktVal}[1]{\inColor{ValueColor}{#1}}
|
||||
\newcommand{\RktValLink}[1]{\inColor{blue}{#1}}
|
||||
\newcommand{\RktValDef}[1]{\RktValLink{#1}}
|
||||
\newcommand{\RktModLink}[1]{\inColor{blue}{#1}}
|
||||
\newcommand{\RktRes}[1]{\inColor{ResultColor}{#1}}
|
||||
\newcommand{\RktOut}[1]{\inColor{OutputColor}{#1}}
|
||||
|
|
|
|||
|
|
@ -101,7 +101,8 @@
|
|||
(rename-out [toc-element-toc-content/compat toc-element-toc-content])
|
||||
(compat*-out [target-element (tag)]
|
||||
[toc-target-element ()]
|
||||
[page-target-element ()]
|
||||
[toc-target2-element (toc-content)])
|
||||
(compat*-out [page-target-element ()]
|
||||
[redirect-target-element (alt-path alt-anchor)]
|
||||
[link-element (tag)]
|
||||
[index-element (tag plain-seq entry-seq desc)])
|
||||
|
|
@ -299,6 +300,8 @@
|
|||
(handle-image-style make-target-element style (list->content content) tag))
|
||||
(define (make-toc-target-element/compat style content tag)
|
||||
(handle-image-style make-toc-target-element style (list->content content) tag))
|
||||
(define (make-toc-target2-element/compat style content tag toc-content)
|
||||
(handle-image-style make-toc-target2-element style (list->content content) tag toc-content))
|
||||
(define (make-page-target-element/compat style content tag)
|
||||
(handle-image-style make-page-target-element style (list->content content) tag))
|
||||
(define (make-redirect-target-element/compat style content tag alt-path alt-anchor)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user