diff --git a/collects/scribble/base-render.ss b/collects/scribble/base-render.ss index 23503bb4..226820f7 100644 --- a/collects/scribble/base-render.ss +++ b/collects/scribble/base-render.ss @@ -34,6 +34,14 @@ (substring s 0 (sub1 (string-length s)))) sep))) + (define/public (strip-aux content) + (cond + [(null? content) null] + [(aux-element? (car content)) + (strip-aux (cdr content))] + [else (cons (car content) + (strip-aux (cdr content)))])) + ;; ---------------------------------------- ;; global-info collection @@ -218,7 +226,7 @@ (null? (element-content i))) (let ([v (lookup part ht (link-element-tag i))]) (if v - (render-content (car v) part ht) + (render-content (strip-aux (car v)) part ht) (render-content (list "[missing]") part ht)))] [(element? i) (render-content (element-content i) part ht)] diff --git a/collects/scribble/basic.ss b/collects/scribble/basic.ss index 071635f0..624837b4 100644 --- a/collects/scribble/basic.ss +++ b/collects/scribble/basic.ss @@ -69,7 +69,7 @@ ;; ---------------------------------------- (provide hspace - elem + elem aux-elem italic bold tt span-class subscript superscript) @@ -80,6 +80,9 @@ (define/kw (elem #:body str) (make-element #f (decode-content str))) + (define/kw (aux-elem #:body s) + (make-aux-element #f (decode-content s))) + (define/kw (italic #:body str) (make-element 'italic (decode-content str))) diff --git a/collects/scribble/html-render.ss b/collects/scribble/html-render.ss index 25382df3..f6297722 100644 --- a/collects/scribble/html-render.ss +++ b/collects/scribble/html-render.ss @@ -31,6 +31,7 @@ install-file get-dest-directory format-number + strip-aux lookup) (define/override (get-suffix) #".html") @@ -71,7 +72,7 @@ (content "text-html; charset=utf-8"))) ,@(let ([c (part-title-content d)]) (if c - `((title ,@(format-number number '(nbsp)) ,@(render-content c d ht))) + `((title ,@(format-number number '(nbsp)) ,(content->string c this d ht))) null)) (link ((rel "stylesheet") (type "text/css") @@ -156,7 +157,7 @@ `((class ,(element-style e))) null)) ,@(if (null? (element-content e)) - (render-content (cadr dest) part ht) + (render-content (strip-aux (cadr dest)) part ht) (render-content (element-content e) part ht)))) (begin (fprintf (current-error-port) "Undefined link: ~s~n" (link-element-tag e)) ; XXX Add source info `((font ((class "badlink")) diff --git a/collects/scribble/struct.ss b/collects/scribble/struct.ss index 07146395..fe5ff5c2 100644 --- a/collects/scribble/struct.ss +++ b/collects/scribble/struct.ss @@ -76,6 +76,7 @@ [(index-element element) ([tag tag?] [plain-seq (listof string?)] [entry-seq list?])] + [(aux-element element) ()] ;; specific renders support other elements, especially strings [collected-info ([number (listof (or/c false/c integer?))] @@ -132,22 +133,35 @@ (provide content->string) - (define (content->string c) - (apply string-append - (map (lambda (e) - (element->string e)) - c))) + (define content->string + (case-lambda + [(c) (c->s c element->string)] + [(c renderer sec ht) (c->s c (lambda (e) + (element->string e renderer sec ht)))])) - (define (element->string c) - (cond - [(element? c) (content->string (element-content c))] - [(string? c) c] - [else (case c - [(ndash) "--"] - [(ldquo rdquo) "\""] - [(rsquo) "'"] - [(rarr) "->"] - [else (format "~s" c)])])) + (define (c->s c do-elem) + (apply string-append + (map do-elem c))) + + (define element->string + (case-lambda + [(c) + (cond + [(element? c) (content->string (element-content c))] + [(string? c) c] + [else (case c + [(ndash) "--"] + [(ldquo rdquo) "\""] + [(rsquo) "'"] + [(rarr) "->"] + [else (format "~s" c)])])] + [(c renderer sec ht) + (cond + [(element? c) (content->string (element-content c) renderer sec ht)] + [(delayed-element? c) + (content->string (force-delayed-element c renderer sec ht) + renderer sec ht)] + [else (element->string c)])])) ) diff --git a/collects/scribblings/scribble/basic.scrbl b/collects/scribblings/scribble/basic.scrbl index 2dcb5439..ac4c8606 100644 --- a/collects/scribblings/scribble/basic.scrbl +++ b/collects/scribblings/scribble/basic.scrbl @@ -93,6 +93,9 @@ have Scribble's @file{scheme.ss} and @file{manual.ss}). @scheme[decode-content], and wraps the result as an element with style @scheme[#f].} +@def-elem-proc[aux-elem]{Like @scheme[elem], but creates an +@scheme[aux-element].} + @def-style-proc[italic] @def-style-proc[bold] @def-style-proc[tt] diff --git a/collects/scribblings/scribble/manual.scrbl b/collects/scribblings/scribble/manual.scrbl index cf90c5ee..16d791dd 100644 --- a/collects/scribblings/scribble/manual.scrbl +++ b/collects/scribblings/scribble/manual.scrbl @@ -293,10 +293,11 @@ as a file name (e.g., in typewriter font and in in quotes).} as a command line (e.g., in typewriter font).} @; ------------------------------------------------------------------------ -@section{Section Links} +@section[#:tag "scribble:manual:section-links"]{Section Links} @defproc[(secref [tag string?]) element?]{Inserts the hyperlinked -title of the section tagged @scheme[tag].} +title of the section tagged @scheme[tag], but @scheme{aux-element} +items in the title content are omitted in the hyperlink label.} @defproc[(seclink [tag string?] [pre-content any/c] ...) element?]{The content from @scheme[pre-content] is hyperlinked to the section tagged @scheme[tag].} @@ -305,7 +306,6 @@ title of the section tagged @scheme[tag].} @scheme[pre-content] is hyperlinked to the definition of @scheme[id].} - @; ------------------------------------------------------------------------ @section{Indexing} diff --git a/collects/scribblings/scribble/struct.scrbl b/collects/scribblings/scribble/struct.scrbl index 8b6b8683..a2789f3b 100644 --- a/collects/scribblings/scribble/struct.scrbl +++ b/collects/scribblings/scribble/struct.scrbl @@ -194,6 +194,14 @@ section, and the last argument correspond to global information } +@defstruct[(aux-element element) ()]{ + +Instances of this structure type are intended for use in titles, where +the auxiliary part of the title can be omitted in hyperlinks. See, for +example, @scheme[secref]. + +} + @defstruct[delayed-element ([render (any/c part? any/c . -> . list?)])]{ The @scheme[render] procedure's arguments are the same as for