commit f81149c127923d26f7f1cea26f8fd2d79db89926
parent d0ba33304760318fd7db5af09024360c6426e920
Author: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 16 Apr 2008 20:52:39 +0000
r5rs and srfi docs and bindings
svn: r9336
original commit: 28a3f3f0e72da7a8810cd59f7238d7ccac647371
Diffstat:
5 files changed, 94 insertions(+), 23 deletions(-)
diff --git a/collects/scribble/base-render.ss b/collects/scribble/base-render.ss
@@ -111,10 +111,16 @@
(unless (null? parts)
(let ([s (car parts)])
(collect-part s d p-ci
- (cons (if (unnumbered-part? s) #f pos)
+ (cons (if (or (unnumbered-part? s)
+ (part-style? s 'unnumbered))
+ #f
+ pos)
number))
(loop (cdr parts)
- (if (unnumbered-part? s) pos (add1 pos))))))
+ (if (or (unnumbered-part? s)
+ (part-style? s 'unnumbered))
+ pos
+ (add1 pos))))))
(let ([prefix (part-tag-prefix d)])
(for ([(k v) (collect-info-ht p-ci)])
(when (cadr k)
diff --git a/collects/scribble/html-render.ss b/collects/scribble/html-render.ss
@@ -9,6 +9,7 @@
setup/main-collects
mzlib/list
net/url
+ scheme/serialize
(prefix-in xml: xml/xml)
(for-syntax scheme/base))
(provide render-mixin
@@ -49,23 +50,27 @@
;; (i.e., the ones that are not allowed as-in in URI
;; codecs) by using "~" followed by a hex encoding.
(define (anchor-name v)
- (let loop ([s (format "~a" v)])
- (cond
- [(regexp-match-positions #rx"[A-Z.]" s)
- => (lambda (m)
- (string-append
- (loop (substring s 0 (caar m)))
- "."
- (substring s (caar m) (cdar m))
- (loop (substring s (cdar m)))))]
- [(regexp-match-positions #rx"[^-a-zA-Z0-9_!*'().]" s)
- => (lambda (m)
- (string-append
- (substring s 0 (caar m))
- "~"
- (format "~x" (char->integer (string-ref s (caar m))))
- (loop (substring s (cdar m)))))]
- [else s])))
+ (if (literal-anchor? v)
+ (literal-anchor-string v)
+ (let loop ([s (format "~a" v)])
+ (cond
+ [(regexp-match-positions #rx"[A-Z.]" s)
+ => (lambda (m)
+ (string-append
+ (loop (substring s 0 (caar m)))
+ "."
+ (substring s (caar m) (cdar m))
+ (loop (substring s (cdar m)))))]
+ [(regexp-match-positions #rx"[^-a-zA-Z0-9_!*'().]" s)
+ => (lambda (m)
+ (string-append
+ (substring s 0 (caar m))
+ "~"
+ (format "~x" (char->integer (string-ref s (caar m))))
+ (loop (substring s (cdar m)))))]
+ [else s]))))
+
+ (define-serializable-struct literal-anchor (string))
(define literal
(let ([loc (xml:make-location 0 0 0)])
@@ -229,10 +234,18 @@
(let ([key (generate-tag (target-element-tag i) ci)])
(collect-put! ci
key
- (vector (path->relative (current-output-file))
- #f
+ (vector (path->relative (let ([p (current-output-file)])
+ (if (redirect-target-element? i)
+ (let-values ([(base name dir?) (split-path p)])
+ (build-path
+ base
+ (redirect-target-element-alt-path i)))
+ p)))
+ #f
(page-target-element? i)
- key))))
+ (if (redirect-target-element? i)
+ (make-literal-anchor (redirect-target-element-alt-anchor i))
+ key)))))
(define (dest-path dest)
(if (vector? dest) ; temporary
diff --git a/collects/scribble/latex-render.ss b/collects/scribble/latex-render.ss
@@ -68,7 +68,8 @@
(if no-number?
"*"
""))
- (when (not (part-style? d 'hidden))
+ (when (not (or (part-style? d 'hidden)
+ no-number?))
(printf "[")
(parameterize ([disable-images #t])
(render-content (part-title-content d) d ri))
diff --git a/collects/scribble/manual.ss b/collects/scribble/manual.ss
@@ -437,6 +437,55 @@
(lambda () (car content))
(lambda () (car content))))))
+
+ (define (make-binding-redirect-elements mod-path redirects)
+ (let ([taglet (path->main-collects-relative
+ (resolved-module-path-name
+ (module-path-index-resolve
+ (module-path-index-join mod-path #f))))])
+ (make-element
+ #f
+ (map
+ (lambda (redirect)
+ (let ([id (car redirect)]
+ [form? (cadr redirect)]
+ [path (caddr redirect)]
+ [anchor (cadddr redirect)])
+ (let ([make-one
+ (lambda (kind)
+ (make-redirect-target-element
+ #f
+ null
+ (list kind (list taglet id))
+ path
+ anchor))])
+ (make-element
+ #f
+ (list (make-one (if form? 'form 'def))
+ (make-one 'dep)
+ (make-index-element #f
+ null
+ (list (if form? 'form 'def)
+ (list taglet id))
+ (list (symbol->string id))
+ (list
+ (make-element
+ "schemesymbol"
+ (list
+ (make-element
+ (if form?
+ "schemesyntaxlink"
+ "schemevaluelink")
+ (list (symbol->string id))))))
+ ((if form?
+ make-form-index-desc
+ make-procedure-index-desc)
+ id
+ (list mod-path))))))))
+ redirects))))
+
+ (provide make-binding-redirect-elements)
+
(define current-signature (make-parameter #f))
(define-syntax-rule (sigelem sig elem)
diff --git a/collects/scribble/struct.ss b/collects/scribble/struct.ss
@@ -159,6 +159,8 @@
[(target-element element) ([tag tag?])]
[(toc-target-element target-element) ()]
[(page-target-element target-element) ()]
+ [(redirect-target-element target-element) ([alt-path path-string?]
+ [alt-anchor string?])]
[(link-element element) ([tag tag?])]
[(index-element element) ([tag tag?]
[plain-seq (listof string?)]
