commit 028e28c5e5807bf8357417cf40e0be8276856c07
parent 8d484595ef85f255a1e8fa0eff09fa2ee281df36
Author: Matthew Flatt <mflatt@racket-lang.org>
Date: Fri, 15 Jun 2007 01:59:06 +0000
doc work, and also generalize normalize-definition to work with opts and kws
svn: r6665
original commit: 2e536dc70e5f2bbf82dc740eb9b0e5540178ce1f
Diffstat:
7 files changed, 59 insertions(+), 22 deletions(-)
diff --git 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
@@ -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
@@ -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
@@ -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)
+ (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 (c->s c do-elem)
(apply string-append
- (map (lambda (e)
- (element->string e))
- c)))
-
- (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)])]))
+ (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
@@ -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
@@ -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
@@ -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
