fix Scribble Latex rendering of prefixed tags; add #:tag-prefixes argument to secref and tech

svn: r14610

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)
+        (let ([t (generate-tag t ci)])
-                   (generate-tag t ci)
+          (hash-set! (collect-info-ht ci)
-                   (list (or (part-title-content d) '("???")) number))))
+                     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

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)

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)
+(define (secref s #:underline? [u? #t] #:doc [doc #f] #:tag-prefixes [prefix #f])
-  (if doc (list (module-path-prefix->string doc) s) s))
+  (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)
-(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)
   (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"))

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)
+(define (techlink #:doc [doc #f] #:tag-prefixes [prefix #f] . s)
-  (*tech make-link-element #f doc s))
+  (*tech make-link-element #f doc prefix s))

collects/scribble/private/manual-utils.ss

@@ -12,8 +12,16 @@
 
 (define spacer (hspace 1))
 
-(define (doc-prefix doc s)
+(define doc-prefix
-  (if doc (list (module-path-prefix->string doc) s) s))
+  (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)))))

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
+If @scheme[#:doc module-path] is provided, the @scheme[tag] refers to
-with a prefix determined by @scheme[module-path]. When
+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
+way as for @scheme[deftech]. The @scheme[#:doc] and
-cross-document references, like in @scheme[secref].
+@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
+With the default style files, the hyperlink created by @scheme[tech]
-appears only when the mouse is moved over the term.
+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