From acc63063e17a7fb7fa5d4dee7247eee749f0dcbe Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 25 Apr 2009 15:19:58 +0000 Subject: [PATCH] fix Scribble Latex rendering of prefixed tags; add #:tag-prefixes argument to secref and tech svn: r14610 original commit: f6c389d0ec6e928f2350a21943a3b90508591870 --- collects/scribble/base-render.ss | 12 ++++++--- collects/scribble/latex-render.ss | 9 ++++--- collects/scribble/private/manual-style.ss | 12 ++++----- collects/scribble/private/manual-tech.ss | 14 +++++----- collects/scribble/private/manual-utils.ss | 12 +++++++-- collects/scribblings/scribble/manual.scrbl | 31 ++++++++++++++++------ 6 files changed, 59 insertions(+), 31 deletions(-) diff --git a/collects/scribble/base-render.ss b/collects/scribble/base-render.ss index 72407734..6219d8da 100644 --- a/collects/scribble/base-render.ss +++ b/collects/scribble/base-render.ss @@ -234,9 +234,12 @@ (define/public (collect-part-tags d ci number) (for ([t (part-tags d)]) - (hash-set! (collect-info-ht ci) - (generate-tag t ci) - (list (or (part-title-content d) '("???")) number)))) + (let ([t (generate-tag t ci)]) + (hash-set! (collect-info-ht ci) + t + (list (or (part-title-content d) '("???")) + number + (add-current-tag-prefix t)))))) (define/public (collect-content c ci) (for ([i c]) (collect-element i ci))) @@ -281,7 +284,8 @@ (for ([e (element-content i)]) (collect-element e ci)))))) (define/public (collect-target-element i ci) - (collect-put! ci (generate-tag (target-element-tag i) ci) (list i))) + (let ([t (generate-tag (target-element-tag i) ci)]) + (collect-put! ci t (list i (add-current-tag-prefix t))))) (define/public (collect-index-element i ci) (collect-put! ci diff --git a/collects/scribble/latex-render.ss b/collects/scribble/latex-render.ss index 490956d3..96027659 100644 --- a/collects/scribble/latex-render.ss +++ b/collects/scribble/latex-render.ss @@ -6,6 +6,7 @@ scheme/port scheme/path scheme/string + scheme/list setup/main-collects) (provide render-mixin) @@ -97,7 +98,7 @@ (printf "}") (when (part-style? d 'index) (printf "\n\n"))) (for ([t (part-tags d)]) - (printf "\\label{t:~a}\n\n" (t-encode (tag-key t ri)))) + (printf "\\label{t:~a}\n\n" (t-encode (add-current-tag-prefix (tag-key t ri))))) (render-flow (part-flow d) d ri #f) (for ([sec (part-parts d)]) (render-part sec ri)) (when (part-style? d 'index) (printf "\\onecolumn\n\n")) @@ -140,7 +141,7 @@ (link-element? e))]) (when (target-element? e) (printf "\\label{t:~a}" - (t-encode (tag-key (target-element-tag e) ri)))) + (t-encode (add-current-tag-prefix (tag-key (target-element-tag e) ri))))) (when part-label? (printf "\\SecRef{") (render-content @@ -217,7 +218,9 @@ (show-link-page-numbers) (not (done-link-page-numbers))) (printf ", \\pageref{t:~a}" - (t-encode (tag-key (link-element-tag e) ri)))) + (t-encode + (let ([v (resolve-get part ri (link-element-tag e))]) + (and v (last v)))))) null)) (define/private (t-encode s) diff --git a/collects/scribble/private/manual-style.ss b/collects/scribble/private/manual-style.ss index 9f49153f..e337e44f 100644 --- a/collects/scribble/private/manual-style.ss +++ b/collects/scribble/private/manual-style.ss @@ -2,6 +2,7 @@ (require "../decode.ss" "../struct.ss" "../basic.ss" + "manual-utils.ss" scheme/list scheme/string) @@ -175,14 +176,11 @@ (define (elemref #:underline? [u? #t] t . body) (make-link-element (if u? #f "plainlink") (decode-content body) `(elem ,t))) -(define (doc-prefix doc s) - (if doc (list (module-path-prefix->string doc) s) s)) - -(define (secref s #:underline? [u? #t] #:doc [doc #f]) - (make-link-element (if u? #f "plainlink") null `(part ,(doc-prefix doc s)))) -(define (seclink tag #:underline? [u? #t] #:doc [doc #f] . s) +(define (secref s #:underline? [u? #t] #:doc [doc #f] #:tag-prefixes [prefix #f]) + (make-link-element (if u? #f "plainlink") null `(part ,(doc-prefix doc prefix s)))) +(define (seclink tag #:underline? [u? #t] #:doc [doc #f] #:tag-prefixes [prefix #f] . s) (make-link-element (if u? #f "plainlink") (decode-content s) - `(part ,(doc-prefix doc tag)))) + `(part ,(doc-prefix doc prefix tag)))) (define (other-manual #:underline? [u? #t] doc) (secref #:doc doc #:underline? u? "top")) diff --git a/collects/scribble/private/manual-tech.ss b/collects/scribble/private/manual-tech.ss index 5cb7d417..f9a13bce 100644 --- a/collects/scribble/private/manual-tech.ss +++ b/collects/scribble/private/manual-tech.ss @@ -7,19 +7,19 @@ (provide deftech tech techlink) -(define (*tech make-elem style doc s) +(define (*tech make-elem style doc prefix s) (let* ([c (decode-content s)] [s (string-foldcase (content->string c))] [s (regexp-replace #rx"ies$" s "y")] [s (regexp-replace #rx"s$" s "")] [s (regexp-replace* #px"[-\\s]+" s " ")]) - (make-elem style c (list 'tech (doc-prefix doc s))))) + (make-elem style c (list 'tech (doc-prefix doc prefix s))))) (define (deftech #:style? [style? #t] . s) (let* ([e (if style? (apply defterm s) (make-element #f (decode-content s)))] - [t (*tech make-target-element #f #f (list e))]) + [t (*tech make-target-element #f #f #f (list e))]) (make-index-element #f (list t) (target-element-tag t) @@ -27,14 +27,14 @@ (list e) 'tech))) -(define (tech #:doc [doc #f] . s) +(define (tech #:doc [doc #f] #:tag-prefixes [prefix #f] . s) (*tech (lambda (style c tag) (make-link-element style (list (make-element "techinside" c)) tag)) "techoutside" - doc s)) + doc prefix s)) -(define (techlink #:doc [doc #f] . s) - (*tech make-link-element #f doc s)) +(define (techlink #:doc [doc #f] #:tag-prefixes [prefix #f] . s) + (*tech make-link-element #f doc prefix s)) diff --git a/collects/scribble/private/manual-utils.ss b/collects/scribble/private/manual-utils.ss index 31032287..a8e9a759 100644 --- a/collects/scribble/private/manual-utils.ss +++ b/collects/scribble/private/manual-utils.ss @@ -12,8 +12,16 @@ (define spacer (hspace 1)) -(define (doc-prefix doc s) - (if doc (list (module-path-prefix->string doc) s) s)) +(define doc-prefix + (case-lambda + [(doc s) + (if doc + (list (module-path-prefix->string doc) s) + s)] + [(doc prefix s) + (doc-prefix doc (if prefix + (append prefix (list s)) + s))])) (define (to-flow e) (make-flow (list (make-omitable-paragraph (list e))))) diff --git a/collects/scribblings/scribble/manual.scrbl b/collects/scribblings/scribble/manual.scrbl index 6057726e..32e28287 100644 --- a/collects/scribblings/scribble/manual.scrbl +++ b/collects/scribblings/scribble/manual.scrbl @@ -872,6 +872,7 @@ and @litchar{^} for subscripts and superscripts.} @defproc[(secref [tag string?] [#:doc module-path (or/c module-path? false/c) #f] + [#:tag-prefixes prefixes (or/c (listof string?) false/c) #f] [#:underline? underline? any/c #t]) element?]{ @@ -879,20 +880,29 @@ Inserts the hyperlinked title of the section tagged @scheme[tag], but @schemeidfont{aux-element} items in the title content are omitted in the hyperlink label. -If @scheme[module-path] is provided, the @scheme[tag] refers to a tag -with a prefix determined by @scheme[module-path]. When +If @scheme[#:doc module-path] is provided, the @scheme[tag] refers to +a tag with a prefix determined by @scheme[module-path]. When @exec{setup-plt} renders documentation, it automatically adds a tag prefix to the document based on the source module. Thus, for example, to refer to a section of the PLT Scheme reference, @scheme[module-path] would be @scheme['(lib "scribblings/reference/reference.scrbl")]. +The @scheme[#:tag-prefixes prefixes] argument similarly supports +selecting a particular section as determined by a path of tag +prefixes. When a @scheme[#:doc] argument is provided, then +@scheme[prefixes] should trace a path of tag-prefixed subsections to +reach the @scheme[tag] section. When @scheme[#:doc] is not provided, +the @scheme[prefixes] path is relative to any enclosing section (i.e., +the youngest ancestor that produces a match). + If @scheme[underline?] is @scheme[#f], then the hyperlink is rendered in HTML without an underline.} @defproc[(seclink [tag string?] [#:doc module-path (or/c module-path? false/c) #f] + [#:tag-prefixes prefixes (or/c (listof string?) false/c) #f] [#:underline? underline? any/c #t] [pre-content any/c] ...) element?]{ @@ -968,17 +978,21 @@ If @scheme[style?] is true, then @scheme[defterm] is used on @scheme[pre-content].} @defproc[(tech [pre-content any/c] ... - [#:doc module-path (or/c module-path? false/c) #f]) + [#:doc module-path (or/c module-path? false/c) #f] + [#:tag-prefixes prefixes (or/c (listof string?) false/c) #f]) element?]{ Produces an element for the @tech{decode}d @scheme[pre-content], and hyperlinks it to the definition of the content as established by @scheme[deftech]. The content's string form is normalized in the same -way as for @scheme[deftech]. The @scheme[#:doc] argument supports -cross-document references, like in @scheme[secref]. +way as for @scheme[deftech]. The @scheme[#:doc] and +@scheme[#:tag-prefixes] arguments support cross-document and +section-specific references, like in @scheme[secref]. -The hyperlink is relatively quiet, in that underlining in HTML output -appears only when the mouse is moved over the term. +With the default style files, the hyperlink created by @scheme[tech] +is somewhat quieter than most hyperlinks: the underline in HTML output +is gray, instead of blue, and the term and underline turn blue only +when the mouse is moved over the term. In some cases, combining both natural-language uses of a term and proper linking can require some creativity, even with the @@ -987,7 +1001,8 @@ defined, but a sentence uses the term ``binding,'' the latter can be linked to the former using @schemefont["@tech{bind}ing"].} @defproc[(techlink [pre-content any/c] ... - [#:doc module-path (or/c module-path? false/c) #f]) + [#:doc module-path (or/c module-path? false/c) #f] + [#:tag-prefixes prefixes (or/c (listof string?) false/c) #f]) element?]{ Like @scheme[tech], but the link is not a quiet. For example, in HTML