commit acc63063e17a7fb7fa5d4dee7247eee749f0dcbe
parent 4b6b80d7fcfb6a48e5414a306a22980ffd69d16e
Author: Matthew Flatt <mflatt@racket-lang.org>
Date: Sat, 25 Apr 2009 15:19:58 +0000
fix Scribble Latex rendering of prefixed tags; add #:tag-prefixes argument to secref and tech
svn: r14610
original commit: f6c389d0ec6e928f2350a21943a3b90508591870
Diffstat:
6 files changed, 59 insertions(+), 31 deletions(-)
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
