From cc37b26e3509800155fc682fcb45ff06dfefcde3 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 14 Nov 2013 07:40:10 -0700 Subject: [PATCH] scribble: add style to distinguish definition sites original commit: e4a0bff456d2c40d688c6b49322ed94ec666b69c --- .../scribblings/scribble/core.scrbl | 6 + .../scribblings/scribble/scheme.scrbl | 6 +- .../scribblings/scribble/struct.scrbl | 7 +- .../scribble-lib/scribble/base-render.rkt | 11 +- .../scribble-lib/scribble/core.rkt | 1 + .../scribble-lib/scribble/html-render.rkt | 4 +- .../scribble/private/manual-bind.rkt | 26 ++- .../scribble/private/manual-class.rkt | 13 +- .../scribble/private/manual-form.rkt | 67 +++--- .../scribble/private/manual-method.rkt | 13 +- .../scribble/private/manual-proc.rkt | 195 +++++++++--------- .../scribble-lib/scribble/racket.css | 9 + .../scribble-lib/scribble/racket.rkt | 71 +++++-- .../scribble-lib/scribble/racket.tex | 3 + .../scribble-lib/scribble/struct.rkt | 5 +- 15 files changed, 259 insertions(+), 178 deletions(-) diff --git a/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/core.scrbl b/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/core.scrbl index c098bd07..f9762a2c 100644 --- a/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/core.scrbl +++ b/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/core.scrbl @@ -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 diff --git a/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/scheme.scrbl b/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/scheme.scrbl index 40729f4e..b866a528 100644 --- a/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/scheme.scrbl +++ b/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/scheme.scrbl @@ -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] diff --git a/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/struct.scrbl b/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/struct.scrbl index fab2bb69..c2301f8c 100644 --- a/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/struct.scrbl +++ b/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/struct.scrbl @@ -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?] diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/base-render.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/base-render.rkt index 8931cd04..1e8b348f 100644 --- a/pkgs/scribble-pkgs/scribble-lib/scribble/base-render.rkt +++ b/pkgs/scribble-pkgs/scribble-lib/scribble/base-render.rkt @@ -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)])) diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/core.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/core.rkt index 965244c1..1d52e420 100644 --- a/pkgs/scribble-pkgs/scribble-lib/scribble/core.rkt +++ b/pkgs/scribble-pkgs/scribble-lib/scribble/core.rkt @@ -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?])] diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt index 9dcbcc07..f0eca43d 100644 --- a/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt +++ b/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt @@ -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))))))) diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-bind.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-bind.rkt index 48c06596..0d19da6d 100644 --- a/pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-bind.rkt +++ b/pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-bind.rkt @@ -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) diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-class.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-class.rkt index 5e09fba6..9586f350 100644 --- a/pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-class.rkt +++ b/pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-class.rkt @@ -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?)] diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-form.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-form.rkt index 52b9c690..c4ab5a9d 100644 --- a/pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-form.rkt +++ b/pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-form.rkt @@ -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) diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-method.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-method.rkt index 525c4dff..9e5a75d1 100644 --- a/pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-method.rkt +++ b/pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-method.rkt @@ -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 diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-proc.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-proc.rkt index a5b27ee8..95b05068 100644 --- a/pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-proc.rkt +++ b/pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-proc.rkt @@ -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)))) diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/racket.css b/pkgs/scribble-pkgs/scribble-lib/scribble/racket.css index c9dc5386..99e7734e 100644 --- a/pkgs/scribble-pkgs/scribble-lib/scribble/racket.css +++ b/pkgs/scribble-pkgs/scribble-lib/scribble/racket.css @@ -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; } diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/racket.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/racket.rkt index 0f0cb26c..d0208644 100644 --- a/pkgs/scribble-pkgs/scribble-lib/scribble/racket.rkt +++ b/pkgs/scribble-pkgs/scribble-lib/scribble/racket.rkt @@ -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) diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/racket.tex b/pkgs/scribble-pkgs/scribble-lib/scribble/racket.tex index 64c5a5a2..fae0ceb7 100644 --- a/pkgs/scribble-pkgs/scribble-lib/scribble/racket.tex +++ b/pkgs/scribble-pkgs/scribble-lib/scribble/racket.tex @@ -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}} diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/struct.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/struct.rkt index 630717b9..3b430454 100644 --- a/pkgs/scribble-pkgs/scribble-lib/scribble/struct.rkt +++ b/pkgs/scribble-pkgs/scribble-lib/scribble/struct.rkt @@ -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)