commit 9e58c9fdc136e5ac5773cbb376aecb022a0c9db4
parent 61f344920d8c155d75d0f1caf06bbb16f8532946
Author: Matthew Flatt <mflatt@racket-lang.org>
Date: Sun, 2 Sep 2007 17:39:32 +0000
371.2
svn: r7263
original commit: e4cbc4e6a938fd5bd90aab305ca39d61e7eae151
Diffstat:
22 files changed, 2207 insertions(+), 940 deletions(-)
diff --git a/collects/scribble/base-render.ss b/collects/scribble/base-render.ss
@@ -11,7 +11,7 @@
(class object%
(init-field dest-dir)
-
+
(define/public (get-dest-directory)
dest-dir)
@@ -43,209 +43,333 @@
(strip-aux (cdr content)))]))
;; ----------------------------------------
- ;; global-info collection
+ ;; marshal info
- (define/public (save-info fn info)
- (let ([s (serialize info)])
- (with-output-to-file fn
- (lambda ()
- (write s))
- 'truncate/replace)))
+ (define/public (get-serialize-version)
+ 1)
+
+ (define/public (serialize-info ri)
+ (parameterize ([current-serialize-resolve-info ri])
+ (serialize (collect-info-ht (resolve-info-ci ri)))))
- (define/public (load-info fn info)
- (let ([ht (deserialize (with-input-from-file fn read))])
+ (define/public (deserialize-info v ci)
+ (let ([ht (deserialize v)]
+ [in-ht (collect-info-ext-ht ci)])
(hash-table-for-each ht (lambda (k v)
- (hash-table-put! info k v))))
- info)
+ (hash-table-put! in-ht k v)))))
+ (define/public (get-defined ci)
+ (hash-table-map (collect-info-ht ci) (lambda (k v) k)))
+
+ (define/public (get-undefined ri)
+ (hash-table-map (resolve-info-undef ri) (lambda (k v) k)))
+ ;; ----------------------------------------
+ ;; global-info collection
+
(define/public (collect ds fns)
- (let ([ht (make-hash-table 'equal)])
- (map (lambda (d)
- (collect-part d #f ht null))
- ds)
- ht))
-
- (define/public (collect-part d parent ht number)
- (let ([p-ht (make-hash-table 'equal)])
+ (let ([ci (make-collect-info (make-hash-table 'equal)
+ (make-hash-table 'equal)
+ (make-hash-table)
+ (make-hash-table)
+ "")])
+ (start-collect ds fns ci)
+ ci))
+
+ (define/public (start-collect ds fns ci)
+ (map (lambda (d)
+ (collect-part d #f ci null))
+ ds))
+
+ (define/public (collect-part d parent ci number)
+ (let ([p-ci (make-collect-info (make-hash-table 'equal)
+ (collect-info-ext-ht ci)
+ (collect-info-parts ci)
+ (collect-info-tags ci)
+ (if (part-tag-prefix d)
+ (string-append (collect-info-gen-prefix ci)
+ (part-tag-prefix d)
+ ":")
+ (collect-info-gen-prefix ci)))])
(when (part-title-content d)
- (collect-content (part-title-content d) p-ht))
- (collect-part-tags d p-ht number)
- (collect-content (part-to-collect d) p-ht)
- (collect-flow (part-flow d) p-ht)
+ (collect-content (part-title-content d) p-ci))
+ (collect-part-tags d p-ci number)
+ (collect-content (part-to-collect d) p-ci)
+ (collect-flow (part-flow d) p-ci)
(let loop ([parts (part-parts d)]
[pos 1])
(unless (null? parts)
(let ([s (car parts)])
- (collect-part s d p-ht
+ (collect-part s d p-ci
(cons (if (unnumbered-part? s)
#f
pos)
number))
(loop (cdr parts)
(if (unnumbered-part? s) pos (add1 pos))))))
- (set-part-collected-info! d (make-collected-info
- number
- parent
- p-ht))
- (hash-table-for-each p-ht
- (lambda (k v)
- (hash-table-put! ht k v)))))
-
- (define/public (collect-part-tags d ht number)
+ (hash-table-put! (collect-info-parts ci)
+ d
+ (make-collected-info
+ number
+ parent
+ (collect-info-ht p-ci)))
+ (let ([prefix (part-tag-prefix d)])
+ (hash-table-for-each (collect-info-ht p-ci)
+ (lambda (k v)
+ (when (cadr k)
+ (hash-table-put! (collect-info-ht ci)
+ (if prefix
+ (convert-key prefix k)
+ k)
+ v)))))))
+
+ (define/private (convert-key prefix k)
+ (case (car k)
+ [(part tech)
+ (if (string? (cadr k))
+ (list (car k)
+ (string-append prefix
+ ":"
+ (cadr k)))
+ k)]
+ [(index-entry)
+ (let ([v (convert-key prefix (cadr k))])
+ (if (eq? v (cadr k))
+ k
+ (list 'index-entry v)))]
+ [else k]))
+
+ (define/public (collect-part-tags d ci number)
(for-each (lambda (t)
- (hash-table-put! ht `(part ,t) (list (part-title-content d) number)))
+ (hash-table-put! (collect-info-ht ci)
+ (generate-tag t ci)
+ (list (or (part-title-content d) '("???"))
+ number)))
(part-tags d)))
- (define/public (collect-content c ht)
+ (define/public (collect-content c ci)
(for-each (lambda (i)
- (collect-element i ht))
+ (collect-element i ci))
c))
- (define/public (collect-paragraph p ht)
- (collect-content (paragraph-content p) ht))
+ (define/public (collect-paragraph p ci)
+ (collect-content (paragraph-content p) ci))
- (define/public (collect-flow p ht)
+ (define/public (collect-flow p ci)
(for-each (lambda (p)
- (collect-flow-element p ht))
+ (collect-flow-element p ci))
(flow-paragraphs p)))
- (define/public (collect-flow-element p ht)
+ (define/public (collect-flow-element p ci)
(cond
- [(table? p) (collect-table p ht)]
- [(itemization? p) (collect-itemization p ht)]
- [(blockquote? p) (collect-blockquote p ht)]
+ [(table? p) (collect-table p ci)]
+ [(itemization? p) (collect-itemization p ci)]
+ [(blockquote? p) (collect-blockquote p ci)]
[(delayed-flow-element? p) (void)]
- [else (collect-paragraph p ht)]))
+ [else (collect-paragraph p ci)]))
- (define/public (collect-table i ht)
+ (define/public (collect-table i ci)
(for-each (lambda (d) (when (flow? d)
- (collect-flow d ht)))
+ (collect-flow d ci)))
(apply append (table-flowss i))))
- (define/public (collect-itemization i ht)
- (for-each (lambda (d) (collect-flow d ht))
+ (define/public (collect-itemization i ci)
+ (for-each (lambda (d) (collect-flow d ci))
(itemization-flows i)))
- (define/public (collect-blockquote i ht)
- (for-each (lambda (d) (collect-flow-element d ht))
+ (define/public (collect-blockquote i ci)
+ (for-each (lambda (d) (collect-flow-element d ci))
(blockquote-paragraphs i)))
- (define/public (collect-element i ht)
+ (define/public (collect-element i ci)
(when (target-element? i)
- (collect-target-element i ht))
+ (collect-target-element i ci))
(when (index-element? i)
- (collect-index-element i ht))
+ (collect-index-element i ci))
+ (when (collect-element? i)
+ ((collect-element-collect i) ci))
(when (element? i)
(for-each (lambda (e)
- (collect-element e ht))
+ (collect-element e ci))
(element-content i))))
- (define/public (collect-target-element i ht)
- (hash-table-put! ht (target-element-tag i) (list i)))
-
- (define/public (collect-index-element i ht)
- (hash-table-put! ht `(index-entry ,(index-element-tag i))
- (list (index-element-plain-seq i)
- (index-element-entry-seq i))))
-
- (define/public (lookup part ht key)
- (let ([v (hash-table-get (if part
- (collected-info-info (part-collected-info part))
- ht)
- key
- #f)])
- (or v
- (and part
- (lookup (collected-info-parent
- (part-collected-info part))
- ht
- key)))))
+ (define/public (collect-target-element i ci)
+ (collect-put! ci
+ (generate-tag (target-element-tag i) ci)
+ (list i)))
+
+ (define/public (collect-index-element i ci)
+ (collect-put! ci
+ `(index-entry ,(generate-tag (index-element-tag i) ci))
+ (list (index-element-plain-seq i)
+ (index-element-entry-seq i))))
+
+ ;; ----------------------------------------
+ ;; global-info resolution
+
+ (define/public (resolve ds fns ci)
+ (let ([ri (make-resolve-info ci
+ (make-hash-table)
+ (make-hash-table 'equal))])
+ (start-resolve ds fns ri)
+ ri))
+
+ (define/public (start-resolve ds fns ri)
+ (map (lambda (d)
+ (resolve-part d ri))
+ ds))
+
+ (define/public (resolve-part d ri)
+ (when (part-title-content d)
+ (resolve-content (part-title-content d) d ri))
+ (resolve-flow (part-flow d) d ri)
+ (for-each (lambda (p)
+ (resolve-part p ri))
+ (part-parts d)))
+
+ (define/public (resolve-content c d ri)
+ (for-each (lambda (i)
+ (resolve-element i d ri))
+ c))
+
+ (define/public (resolve-paragraph p d ri)
+ (resolve-content (paragraph-content p) d ri))
+
+ (define/public (resolve-flow p d ri)
+ (for-each (lambda (p)
+ (resolve-flow-element p d ri))
+ (flow-paragraphs p)))
+
+ (define/public (resolve-flow-element p d ri)
+ (cond
+ [(table? p) (resolve-table p d ri)]
+ [(itemization? p) (resolve-itemization p d ri)]
+ [(blockquote? p) (resolve-blockquote p d ri)]
+ [(delayed-flow-element? p)
+ (let ([v ((delayed-flow-element-resolve p) this d ri)])
+ (hash-table-put! (resolve-info-delays ri) p v)
+ (resolve-flow-element v d ri))]
+ [else (resolve-paragraph p d ri)]))
+
+ (define/public (resolve-table i d ri)
+ (for-each (lambda (f) (when (flow? f)
+ (resolve-flow f d ri)))
+ (apply append (table-flowss i))))
+
+ (define/public (resolve-itemization i d ri)
+ (for-each (lambda (f) (resolve-flow f d ri))
+ (itemization-flows i)))
+
+ (define/public (resolve-blockquote i d ri)
+ (for-each (lambda (f) (resolve-flow-element f d ri))
+ (blockquote-paragraphs i)))
+
+ (define/public (resolve-element i d ri)
+ (cond
+ [(delayed-element? i)
+ (resolve-content (or (hash-table-get (resolve-info-delays ri)
+ i
+ #f)
+ (let ([v ((delayed-element-resolve i) this d ri)])
+ (hash-table-put! (resolve-info-delays ri)
+ i
+ v)
+ v))
+ d ri)]
+ [(element? i)
+ (cond
+ [(link-element? i)
+ (let-values ([(dest ext?) (resolve-get/where d ri (link-element-tag i))])
+ (when ext?
+ (hash-table-put! (resolve-info-undef ri)
+ (tag-key (link-element-tag i) ri)
+ #t)))])
+ (for-each (lambda (e)
+ (resolve-element e d ri))
+ (element-content i))]))
;; ----------------------------------------
;; render methods
- (define/public (render ds fns ht)
+ (define/public (render ds fns ri)
(map (lambda (d fn)
(printf " [Output to ~a]\n" fn)
(with-output-to-file fn
(lambda ()
- (render-one d ht fn))
+ (render-one d ri fn))
'truncate/replace))
-
ds
fns))
- (define/public (render-one d ht fn)
- (render-part d ht))
+ (define/public (render-one d ri fn)
+ (render-part d ri))
- (define/public (render-part d ht)
+ (define/public (render-part d ri)
(list
(when (part-title-content d)
- (render-content (part-title-content d) d ht))
- (render-flow (part-flow d) d ht)
- (map (lambda (s) (render-part s ht))
+ (render-content (part-title-content d) d ri))
+ (render-flow (part-flow d) d ri)
+ (map (lambda (s) (render-part s ri))
(part-parts d))))
- (define/public (render-content c part ht)
+ (define/public (render-content c part ri)
(apply append
(map (lambda (i)
- (render-element i part ht))
+ (render-element i part ri))
c)))
- (define/public (render-paragraph p part ht)
- (render-content (paragraph-content p) part ht))
+ (define/public (render-paragraph p part ri)
+ (render-content (paragraph-content p) part ri))
- (define/public (render-flow p part ht)
+ (define/public (render-flow p part ri)
(apply append
(map (lambda (p)
- (render-flow-element p part ht))
+ (render-flow-element p part ri))
(flow-paragraphs p))))
- (define/public (render-flow-element p part ht)
+ (define/public (render-flow-element p part ri)
(cond
[(table? p) (if (auxiliary-table? p)
- (render-auxiliary-table p part ht)
- (render-table p part ht))]
- [(itemization? p) (render-itemization p part ht)]
- [(blockquote? p) (render-blockquote p part ht)]
- [(delayed-flow-element? p) (render-flow-element
- ((delayed-flow-element-render p) this part ht)
- part ht)]
- [else (render-paragraph p part ht)]))
+ (render-auxiliary-table p part ri)
+ (render-table p part ri))]
+ [(itemization? p) (render-itemization p part ri)]
+ [(blockquote? p) (render-blockquote p part ri)]
+ [(delayed-flow-element? p)
+ (render-flow-element (delayed-flow-element-flow-elements p ri) part ri)]
+ [else (render-paragraph p part ri)]))
- (define/public (render-auxiliary-table i part ht)
+ (define/public (render-auxiliary-table i part ri)
null)
- (define/public (render-table i part ht)
+ (define/public (render-table i part ri)
(map (lambda (d) (if (flow? i)
- (render-flow d part ht)
+ (render-flow d part ri)
null))
(apply append (table-flowss i))))
- (define/public (render-itemization i part ht)
- (map (lambda (d) (render-flow d part ht))
+ (define/public (render-itemization i part ri)
+ (map (lambda (d) (render-flow d part ri))
(itemization-flows i)))
- (define/public (render-blockquote i part ht)
- (map (lambda (d) (render-flow-element d part ht))
+ (define/public (render-blockquote i part ri)
+ (map (lambda (d) (render-flow-element d part ri))
(blockquote-paragraphs i)))
- (define/public (render-element i part ht)
+ (define/public (render-element i part ri)
(cond
[(and (link-element? i)
(null? (element-content i)))
- (let ([v (lookup part ht (link-element-tag i))])
+ (let ([v (resolve-get part ri (link-element-tag i))])
(if v
- (render-content (strip-aux (car v)) part ht)
- (render-content (list "[missing]") part ht)))]
+ (render-content (strip-aux (car v)) part ri)
+ (render-content (list "[missing]") part ri)))]
[(element? i)
- (render-content (element-content i) part ht)]
+ (render-content (element-content i) part ri)]
[(delayed-element? i)
- (render-content (force-delayed-element i this part ht) part ht)]
+ (render-content (delayed-element-content i ri) part ri)]
[else
- (render-other i part ht)]))
+ (render-other i part ri)]))
- (define/public (render-other i part ht)
+ (define/public (render-other i part ri)
(list i))
;; ----------------------------------------
@@ -280,34 +404,32 @@
;; ----------------------------------------
- (define/private (do-table-of-contents part ht delta quiet)
- (make-table #f (render-toc part
- (+ delta
- (length (collected-info-number
- (part-collected-info part))))
- #t
- quiet)))
+ (define/private (do-table-of-contents part ri delta quiet)
+ (make-table #f (generate-toc part
+ ri
+ (+ delta
+ (length (collected-info-number
+ (part-collected-info part ri))))
+ #t
+ quiet)))
- (define/public (table-of-contents part ht)
- (do-table-of-contents part ht -1 not))
+ (define/public (table-of-contents part ri)
+ (do-table-of-contents part ri -1 not))
- (define/public (local-table-of-contents part ht)
- (table-of-contents part ht))
+ (define/public (local-table-of-contents part ri)
+ (table-of-contents part ri))
- (define/public (quiet-table-of-contents part ht)
- (do-table-of-contents part ht 1 (lambda (x) #t)))
+ (define/public (quiet-table-of-contents part ri)
+ (do-table-of-contents part ri 1 (lambda (x) #t)))
- (define/private (render-toc part base-len skip? quiet)
- (let ([number (collected-info-number (part-collected-info part))])
+ (define/private (generate-toc part ri base-len skip? quiet)
+ (let ([number (collected-info-number (part-collected-info part ri))])
(let ([subs
- (if (quiet (and (styled-part? part)
- (let ([st(styled-part-style part)])
- (or (eq? 'quiet st)
- (and (list? st) (memq 'quiet st))))
+ (if (quiet (and (part-style? part 'quiet)
(not (= base-len (sub1 (length number))))))
(apply
append
- (map (lambda (p) (render-toc p base-len #f quiet)) (part-parts part)))
+ (map (lambda (p) (generate-toc p ri base-len #f quiet)) (part-parts part)))
null)])
(if skip?
subs
@@ -324,8 +446,8 @@
(format-number number
(list
(make-element 'hspace '(" "))))
- (part-title-content part))
- `(part ,(car (part-tags part)))))))))
+ (or (part-title-content part) '("???")))
+ (car (part-tags part))))))))
subs)])
(if (and (= 1 (length number))
(or (not (car number))
diff --git a/collects/scribble/basic.ss b/collects/scribble/basic.ss
@@ -4,7 +4,9 @@
"struct.ss"
"config.ss"
(lib "list.ss")
- (lib "class.ss"))
+ (lib "class.ss")
+ (lib "main-collects.ss" "setup")
+ (lib "modresolve.ss" "syntax"))
(provide title
section
@@ -18,21 +20,41 @@
(content->string content)
"_"))
- (define (title #:tag [tag #f] #:style [style #f] . str)
+ (define (prefix->string p)
+ (and p
+ (if (string? p)
+ p
+ (module-path-prefix->string p))))
+
+ (define (title #:tag [tag #f] #:tag-prefix [prefix #f] #:style [style #f] . str)
(let ([content (decode-content str)])
- (make-title-decl (or tag (gen-tag content)) style content)))
+ (make-title-decl (prefix->string prefix)
+ `((part ,(or tag (gen-tag content))))
+ style
+ content)))
- (define (section #:tag [tag #f] #:style [style #f] . str)
+ (define (section #:tag [tag #f] #:tag-prefix [prefix #f] #:style [style #f] . str)
(let ([content (decode-content str)])
- (make-part-start 0 (or tag (gen-tag content)) style content)))
+ (make-part-start 0 (prefix->string prefix)
+ `((part ,(or tag (gen-tag content))))
+ style
+ content)))
- (define (subsection #:tag [tag #f] . str)
+ (define (subsection #:tag [tag #f] #:tag-prefix [prefix #f] . str)
(let ([content (decode-content str)])
- (make-part-start 1 (or tag (gen-tag content)) #f content)))
+ (make-part-start 1
+ (prefix->string prefix)
+ `((part ,(or tag (gen-tag content))))
+ #f
+ content)))
- (define (subsubsection #:tag [tag #f] . str)
+ (define (subsubsection #:tag [tag #f] #:tag-prefix [prefix #f] . str)
(let ([content (decode-content str)])
- (make-part-start 2 (or tag (gen-tag content)) #f content)))
+ (make-part-start 2
+ (prefix->string prefix)
+ `((part ,(or tag (gen-tag content))))
+ #f
+ content)))
(define (subsubsub*section #:tag [tag #f] . str)
(let ([content (decode-content str)])
@@ -47,6 +69,14 @@
;; ----------------------------------------
+ (provide module-path-prefix->string)
+
+ (define (module-path-prefix->string p)
+ (format "~a" (path->main-collects-relative
+ (resolve-module-path p #f))))
+
+ ;; ----------------------------------------
+
(provide itemize item item?)
(define (itemize . items)
@@ -124,19 +154,16 @@
(define (section-index . elems)
(make-part-index-decl (map element->string elems) elems))
- (define (gen-target)
- (format "index:~s:~s" (current-inexact-milliseconds) (gensym)))
-
(define (record-index word-seq element-seq tag content)
(make-index-element
#f
- (list (make-target-element #f content tag))
- tag
+ (list (make-target-element #f content `(idx ,tag)))
+ `(idx ,tag)
word-seq
element-seq))
(define (index* word-seq content-seq . s)
- (let ([key (gen-target)])
+ (let ([key (make-generated-tag)])
(record-index word-seq
content-seq
key
@@ -149,7 +176,7 @@
(apply index* word-seq word-seq s)))
(define (as-index . s)
- (let ([key (gen-target)]
+ (let ([key (make-generated-tag)]
[content (decode-content s)])
(record-index (list (content->string content))
(list (make-element #f content))
@@ -158,18 +185,21 @@
(define (index-section tag)
(make-unnumbered-part
- (and tag (list tag))
- (list "Index")
#f
+ `((part , (or tag
+ (make-generated-tag))))
+ '("Index")
+ 'index
null
(make-flow (list (make-delayed-flow-element
- (lambda (renderer sec ht)
+ (lambda (renderer sec ri)
(let ([l null])
(hash-table-for-each
(collected-info-info
(part-collected-info
(collected-info-parent
- (part-collected-info sec))))
+ (part-collected-info sec ri))
+ ri))
(lambda (k v)
(if (and (pair? k)
(eq? 'index-entry (car k)))
@@ -204,8 +234,7 @@
(commas (caddr i))
(car i))))))))
l))))))))
- null
- 'index))
+ null))
;; ----------------------------------------
@@ -214,13 +243,13 @@
(define (table-of-contents)
(make-delayed-flow-element
- (lambda (renderer part ht)
- (send renderer table-of-contents part ht))))
+ (lambda (renderer part ri)
+ (send renderer table-of-contents part ri))))
(define (local-table-of-contents)
(make-delayed-flow-element
- (lambda (renderer part ht)
- (send renderer local-table-of-contents part ht)))))
+ (lambda (renderer part ri)
+ (send renderer local-table-of-contents part ri)))))
diff --git a/collects/scribble/decode.ss b/collects/scribble/decode.ss
@@ -13,16 +13,19 @@
whitespace?)
(provide-structs
- [title-decl ([tag any/c]
+ [title-decl ([tag-prefix (or/c false/c string?)]
+ [tags (listof tag?)]
[style any/c]
[content list?])]
[part-start ([depth integer?]
- [tag (or/c false/c string?)]
+ [tag-prefix (or/c false/c string?)]
+ [tags (listof tag?)]
[style any/c]
[title list?])]
[splice ([run list?])]
[part-index-decl ([plain-seq (listof string?)]
- [entry-seq list?])])
+ [entry-seq list?])]
+ [part-collect-decl ([element element?])])
(define (decode-string s)
(let loop ([l '((#rx"---" mdash)
@@ -52,39 +55,42 @@
null
(list (decode-paragraph (reverse (skip-whitespace accum))))))
- (define (decode-flow* l keys tag style title part-depth)
- (let loop ([l l][next? #f][keys keys][accum null][title title][tag tag][style style])
+ (define (decode-flow* l keys colls tag-prefix tags style title part-depth)
+ (let loop ([l l][next? #f][keys keys][colls colls][accum null][title title][tag-prefix tag-prefix][tags tags][style style])
(cond
[(null? l)
- (let ([tags (map (lambda (k)
- (format "secindex:~a:~a" (current-inexact-milliseconds) (gensym)))
- keys)]
- [tag (or tag (format "sec:~a:~a" (current-inexact-milliseconds) (gensym)))])
- (make-styled-part (cons tag
- tags)
- title
- #f
- (let ([l (map (lambda (k tag)
- (make-index-element
- #f
- null
- `(part ,tag)
- (part-index-decl-plain-seq k)
- (part-index-decl-entry-seq k)))
- keys tags)])
- (if title
- (cons (make-index-element
- #f
- null
- `(part ,tag)
- (list (regexp-replace #px"^(?:A|An|The)\\s" (content->string title)
- ""))
- (list (make-element #f title)))
- l)
- l))
- (make-flow (decode-accum-para accum))
- null
- style))]
+ (let ([k-tags (map (lambda (k)
+ `(idx ,(make-generated-tag)))
+ keys)]
+ [tags (if (null? tags)
+ (list `(part ,(make-generated-tag)))
+ tags)])
+ (make-part tag-prefix
+ (append tags k-tags)
+ title
+ style
+ (let ([l (map (lambda (k tag)
+ (make-index-element
+ #f
+ null
+ tag
+ (part-index-decl-plain-seq k)
+ (part-index-decl-entry-seq k)))
+ keys k-tags)])
+ (append
+ (if title
+ (cons (make-index-element
+ #f
+ null
+ (car tags)
+ (list (regexp-replace #px"^(?:A|An|The)\\s" (content->string title)
+ ""))
+ (list (make-element #f title)))
+ l)
+ l)
+ colls))
+ (make-flow (decode-accum-para accum))
+ null))]
[(title-decl? (car l))
(unless part-depth
(error 'decode
@@ -94,34 +100,35 @@
(error 'decode
"found extra title: ~v"
(car l)))
- (loop (cdr l) next? keys accum
+ (loop (cdr l) next? keys colls accum
(title-decl-content (car l))
- (title-decl-tag (car l))
+ (title-decl-tag-prefix (car l))
+ (title-decl-tags (car l))
(title-decl-style (car l)))]
[(flow-element? (car l))
(let ([para (decode-accum-para accum)]
- [part (decode-flow* (cdr l) keys tag style title part-depth)])
- (make-styled-part (part-tags part)
- (part-title-content part)
- (part-collected-info part)
- (part-to-collect part)
- (make-flow (append para
- (list (car l))
- (flow-paragraphs (part-flow part))))
- (part-parts part)
- (styled-part-style part)))]
+ [part (decode-flow* (cdr l) keys colls tag-prefix tags style title part-depth)])
+ (make-part (part-tag-prefix part)
+ (part-tags part)
+ (part-title-content part)
+ (part-style part)
+ (part-to-collect part)
+ (make-flow (append para
+ (list (car l))
+ (flow-paragraphs (part-flow part))))
+ (part-parts part)))]
[(part? (car l))
(let ([para (decode-accum-para accum)]
- [part (decode-flow* (cdr l) keys tag style title part-depth)])
- (make-styled-part (part-tags part)
- (part-title-content part)
- (part-collected-info part)
- (part-to-collect part)
- (make-flow (append para
- (flow-paragraphs
- (part-flow part))))
- (cons (car l) (part-parts part))
- (styled-part-style part)))]
+ [part (decode-flow* (cdr l) keys colls tag-prefix tags style title part-depth)])
+ (make-part (part-tag-prefix part)
+ (part-tags part)
+ (part-title-content part)
+ (part-style part)
+ (part-to-collect part)
+ (make-flow (append para
+ (flow-paragraphs
+ (part-flow part))))
+ (cons (car l) (part-parts part))))]
[(and (part-start? (car l))
(or (not part-depth)
((part-start-depth (car l)) . <= . part-depth)))
@@ -138,54 +145,57 @@
(part? (car l))))
(let ([para (decode-accum-para accum)]
[s (decode-styled-part (reverse s-accum)
- (part-start-tag s)
+ (part-start-tag-prefix s)
+ (part-start-tags s)
(part-start-style s)
(part-start-title s)
(add1 part-depth))]
- [part (decode-flow* l keys tag style title part-depth)])
- (make-styled-part (part-tags part)
- (part-title-content part)
- (part-collected-info part)
- (part-to-collect part)
- (make-flow para)
- (cons s (part-parts part))
- (styled-part-style part)))
+ [part (decode-flow* l keys colls tag-prefix tags style title part-depth)])
+ (make-part (part-tag-prefix part)
+ (part-tags part)
+ (part-title-content part)
+ (part-style part)
+ (part-to-collect part)
+ (make-flow para)
+ (cons s (part-parts part))))
(if (splice? (car l))
(loop (append (splice-run (car l)) (cdr l)) s-accum)
(loop (cdr l) (cons (car l) s-accum))))))]
[(splice? (car l))
- (loop (append (splice-run (car l)) (cdr l)) next? keys accum title tag style)]
- [(null? (cdr l)) (loop null #f keys (cons (car l) accum) title tag style)]
+ (loop (append (splice-run (car l)) (cdr l)) next? keys colls accum title tag-prefix tags style)]
+ [(null? (cdr l)) (loop null #f keys colls (cons (car l) accum) title tag-prefix tags style)]
[(part-index-decl? (car l))
- (loop (cdr l) next? (cons (car l) keys) accum title tag style)]
+ (loop (cdr l) next? (cons (car l) keys) colls accum title tag-prefix tags style)]
+ [(part-collect-decl? (car l))
+ (loop (cdr l) next? keys (cons (part-collect-decl-element (car l)) colls) accum title tag-prefix tags style)]
[(and (pair? (cdr l))
(splice? (cadr l)))
- (loop (cons (car l) (append (splice-run (cadr l)) (cddr l))) next? keys accum title tag style)]
+ (loop (cons (car l) (append (splice-run (cadr l)) (cddr l))) next? keys colls accum title tag-prefix tags style)]
[(line-break? (car l))
(if next?
- (loop (cdr l) #t keys accum title tag style)
+ (loop (cdr l) #t keys colls accum title tag-prefix tags style)
(let ([m (match-newline-whitespace (cdr l))])
(if m
- (let ([part (loop m #t keys null title tag style)])
- (make-styled-part (part-tags part)
- (part-title-content part)
- (part-collected-info part)
- (part-to-collect part)
- (make-flow (append (decode-accum-para accum)
- (flow-paragraphs (part-flow part))))
- (part-parts part)
- (styled-part-style part)))
- (loop (cdr l) #f keys (cons (car l) accum) title tag style))))]
- [else (loop (cdr l) #f keys (cons (car l) accum) title tag style)])))
-
- (define (decode-part l tag title depth)
- (decode-flow* l null tag #f title depth))
-
- (define (decode-styled-part l tag style title depth)
- (decode-flow* l null tag style title depth))
+ (let ([part (loop m #t keys colls null title tag-prefix tags style)])
+ (make-part (part-tag-prefix part)
+ (part-tags part)
+ (part-title-content part)
+ (part-style part)
+ (part-to-collect part)
+ (make-flow (append (decode-accum-para accum)
+ (flow-paragraphs (part-flow part))))
+ (part-parts part)))
+ (loop (cdr l) #f keys colls (cons (car l) accum) title tag-prefix tags style))))]
+ [else (loop (cdr l) #f keys colls (cons (car l) accum) title tag-prefix tags style)])))
+
+ (define (decode-part l tags title depth)
+ (decode-flow* l null null #f tags #f title depth))
+
+ (define (decode-styled-part l tag-prefix tags style title depth)
+ (decode-flow* l null null tag-prefix tags style title depth))
(define (decode-flow l)
- (part-flow (decode-flow* l null #f #f #f #f)))
+ (part-flow (decode-flow* l null null #f null #f #f #f)))
(define (match-newline-whitespace l)
(cond
@@ -207,7 +217,7 @@
(loop (cdr l)))))
(define (decode l)
- (decode-part l #f #f 0))
+ (decode-part l null #f 0))
(define (decode-paragraph l)
(make-paragraph
diff --git a/collects/scribble/doclang.ss b/collects/scribble/doclang.ss
@@ -43,7 +43,8 @@
(kernel-form-identifier-list #'here)
(syntax->list #'(provide
require
- require-for-syntax))))])
+ require-for-syntax
+ require-for-label))))])
(syntax-case expanded (begin)
[(begin body1 ...)
#`(doc-begin m-id exprs body1 ... . body)]
@@ -53,6 +54,7 @@
(syntax->list #'(require
provide
require-for-syntax
+ require-for-label
define-values
define-syntaxes
define-for-syntaxes))))
diff --git a/collects/scribble/html-render.ss b/collects/scribble/html-render.ss
@@ -5,6 +5,8 @@
(lib "file.ss")
(lib "list.ss")
(lib "runtime-path.ss")
+ (lib "main-doc.ss" "setup")
+ (lib "main-collects.ss" "setup")
(prefix xml: (lib "xml.ss" "xml")))
(provide render-mixin
render-multi-mixin)
@@ -15,12 +17,25 @@
(define current-subdirectory (make-parameter #f))
(define current-output-file (make-parameter #f))
+ (define current-top-part (make-parameter #f))
(define on-separate-page (make-parameter #t))
(define next-separate-page (make-parameter #f))
(define collecting-sub (make-parameter 0))
(define current-no-links (make-parameter #f))
(define extra-breaking? (make-parameter #f))
+ (define (path->relative p)
+ (let ([p (path->main-doc-relative p)])
+ (if (path? p)
+ (path->main-collects-relative p)
+ p)))
+
+ (define (relative->path p)
+ (let ([p (main-doc-relative->path p)])
+ (if (path? p)
+ p
+ (main-collects-relative->path p))))
+
;; ----------------------------------------
;; main mixin
@@ -33,58 +48,57 @@
get-dest-directory
format-number
strip-aux
- lookup
quiet-table-of-contents)
(define/override (get-suffix) #".html")
;; ----------------------------------------
- (define/override (collect ds fns)
- (let ([ht (make-hash-table 'equal)])
- (map (lambda (d fn)
- (parameterize ([current-output-file fn])
- (collect-part d #f ht null)))
- ds
- fns)
- ht))
-
- (define/public (part-whole-page? p ht)
- (let ([dest (lookup p ht `(part ,(car (part-tags p))))])
+ (define/override (start-collect ds fns ci)
+ (map (lambda (d fn)
+ (parameterize ([current-output-file fn]
+ [current-top-part d])
+ (collect-part d #f ci null)))
+ ds
+ fns))
+
+ (define/public (part-whole-page? p ri)
+ (let ([dest (resolve-get p ri (car (part-tags p)))])
(caddr dest)))
- (define/public (current-part-whole-page?)
- #f)
+ (define/public (current-part-whole-page? d)
+ (eq? d (current-top-part)))
- (define/override (collect-part-tags d ht number)
+ (define/override (collect-part-tags d ci number)
(for-each (lambda (t)
- (hash-table-put! ht
- `(part ,t)
- (list (current-output-file)
- (part-title-content d)
- (current-part-whole-page?))))
+ (let ([key (generate-tag t ci)])
+ (collect-put! ci
+ key
+ (list (path->relative (current-output-file))
+ (or (part-title-content d)
+ '("???"))
+ (current-part-whole-page? d)
+ (format "~a" key)))))
(part-tags d)))
- (define/override (collect-target-element i ht)
- (hash-table-put! ht
- (target-element-tag i)
- (list (current-output-file)
- #f
- (page-target-element? i))))
-
+ (define/override (collect-target-element i ci)
+ (let ([key (generate-tag (target-element-tag i) ci)])
+ (collect-put! ci
+ key
+ (list (path->relative (current-output-file))
+ #f
+ (page-target-element? i)
+ (format "~a" key)))))
+
;; ----------------------------------------
(define/private (reveal-subparts? p)
- (and (styled-part? p)
- (let ([s (styled-part-style p)])
- (or (eq? s 'reveal)
- (and (list? s)
- (memq 'reveal s))))))
-
- (define/public (render-toc-view d ht)
+ (part-style? p 'reveal))
+
+ (define/public (render-toc-view d ri)
(let-values ([(top mine)
(let loop ([d d][mine d])
- (let ([p (collected-info-parent (part-collected-info d))])
+ (let ([p (collected-info-parent (part-collected-info d ri))])
(if p
(loop p (if (reveal-subparts? d)
mine
@@ -95,7 +109,7 @@
(div ((class "tocviewtitle"))
(a ((href "index.html")
(class "tocviewlink"))
- ,@(render-content (part-title-content top) d ht)))
+ ,@(render-content (or (part-title-content top) '("???")) d ri)))
(div nbsp)
(table
((class "tocviewlist")
@@ -107,24 +121,24 @@
(td
((align "right"))
,@(if show-number?
- (format-number (collected-info-number (part-collected-info p))
+ (format-number (collected-info-number (part-collected-info p ri))
'((tt nbsp)))
'("-" nbsp)))
(td
- (a ((href ,(let ([dest (lookup p ht `(part ,(car (part-tags p))))])
+ (a ((href ,(let ([dest (resolve-get p ri (car (part-tags p)))])
(format "~a~a~a"
- (from-root (car dest)
+ (from-root (relative->path (car dest))
(get-dest-directory))
(if (caddr dest)
""
"#")
(if (caddr dest)
""
- `(part ,(car (part-tags p)))))))
+ (cadddr dest)))))
(class ,(if (eq? p mine)
"tocviewselflink"
"tocviewlink")))
- ,@(render-content (part-title-content p) d ht))))))
+ ,@(render-content (or (part-title-content p) '("???")) d ri))))))
(let loop ([l (map (lambda (v) (cons v #t)) (part-parts top))])
(cond
[(null? l) null]
@@ -133,92 +147,101 @@
(part-parts (caar l)))
(cdr l))))]
[else (cons (car l) (loop (cdr l)))])))))
- ,@(if (ormap (lambda (p) (part-whole-page? p ht)) (part-parts d))
- null
- (let ([ps (cdr
- (let flatten ([d d])
- (cons d
- (apply
- append
- (letrec ([flow-targets
- (lambda (flow)
- (apply append (map flow-element-targets (flow-paragraphs flow))))]
- [flow-element-targets
- (lambda (e)
- (cond
- [(table? e) (table-targets e)]
- [(paragraph? e) (para-targets e)]
- [(itemization? e)
- (apply append (map flow-targets (itemization-flows e)))]
- [(blockquote? e)
- (apply append (map flow-element-targets (blockquote-paragraphs e)))]
- [(delayed-flow-element? e)
- null]))]
- [para-targets
- (lambda (para)
- (let loop ([c (paragraph-content para)])
- (cond
- [(empty? c) null]
- [else (let ([a (car c)])
- (cond
- [(toc-target-element? a)
- (cons a (loop (cdr c)))]
- [(element? a)
- (append (loop (element-content a))
- (loop (cdr c)))]
- [(delayed-element? a)
- (loop (cons (force-delayed-element a this d ht)
- (cdr c)))]
- [else
- (loop (cdr c))]))])))]
- [table-targets
- (lambda (table)
- (apply append
- (map (lambda (flows)
- (apply append (map (lambda (f)
- (if (eq? f 'cont)
- null
- (flow-targets f)))
- flows)))
- (table-flowss table))))])
- (apply append (map flow-element-targets (flow-paragraphs (part-flow d)))))
- (map flatten (part-parts d))))))])
- (if (null? ps)
- null
- `((div ((class "tocsub"))
- (div ((class "tocsubtitle"))
- "On this page:")
- (table
- ((class "tocsublist")
- (cellspacing "0"))
- ,@(map (lambda (p)
- (parameterize ([current-no-links #t]
- [extra-breaking? #t])
- `(tr
- (td
- ,@(if (part? p)
- `((span ((class "tocsublinknumber"))
- ,@(format-number (collected-info-number (part-collected-info p))
- '((tt nbsp)))))
- '(""))
- (a ((href ,(if (part? p)
- (let ([dest (lookup p ht `(part ,(car (part-tags p))))])
- (format "#~a"
- `(part ,(car (part-tags p)))))
- (format "#~a" (target-element-tag p))))
- (class ,(if (part? p)
- "tocsubseclink"
- "tocsublink")))
- ,@(if (part? p)
- (render-content (part-title-content p) d ht)
- (render-content (element-content p) d ht)))))))
- ps)))))))
+ ,@(render-onthispage-contents d ri top)
,@(apply append
(map (lambda (t)
- (render-table t d ht))
+ (render-table t d ri))
(filter auxiliary-table? (flow-paragraphs (part-flow d)))))))))
- (define/public (render-one-part d ht fn number)
+ (define/private (render-onthispage-contents d ri top)
+ (if (ormap (lambda (p) (part-whole-page? p ri))
+ (part-parts d))
+ null
+ (let* ([nearly-top? (lambda (d)
+ (eq? top (collected-info-parent (part-collected-info d ri))))]
+ [ps ((if (nearly-top? d) values cdr)
+ (let flatten ([d d])
+ (apply
+ append
+ ;; don't include the section if it's in the TOC
+ (if (nearly-top? d)
+ null
+ (list d))
+ ;; get internal targets:
+ (letrec ([flow-targets
+ (lambda (flow)
+ (apply append (map flow-element-targets (flow-paragraphs flow))))]
+ [flow-element-targets
+ (lambda (e)
+ (cond
+ [(table? e) (table-targets e)]
+ [(paragraph? e) (para-targets e)]
+ [(itemization? e)
+ (apply append (map flow-targets (itemization-flows e)))]
+ [(blockquote? e)
+ (apply append (map flow-element-targets (blockquote-paragraphs e)))]
+ [(delayed-flow-element? e)
+ null]))]
+ [para-targets
+ (lambda (para)
+ (let loop ([c (paragraph-content para)])
+ (cond
+ [(empty? c) null]
+ [else (let ([a (car c)])
+ (cond
+ [(toc-target-element? a)
+ (cons a (loop (cdr c)))]
+ [(element? a)
+ (append (loop (element-content a))
+ (loop (cdr c)))]
+ [(delayed-element? a)
+ (loop (cons (delayed-element-content a ri)
+ (cdr c)))]
+ [else
+ (loop (cdr c))]))])))]
+ [table-targets
+ (lambda (table)
+ (apply append
+ (map (lambda (flows)
+ (apply append (map (lambda (f)
+ (if (eq? f 'cont)
+ null
+ (flow-targets f)))
+ flows)))
+ (table-flowss table))))])
+ (apply append (map flow-element-targets (flow-paragraphs (part-flow d)))))
+ (map flatten (part-parts d)))))])
+ (if (null? ps)
+ null
+ `((div ((class "tocsub"))
+ (div ((class "tocsubtitle"))
+ "On this page:")
+ (table
+ ((class "tocsublist")
+ (cellspacing "0"))
+ ,@(map (lambda (p)
+ (parameterize ([current-no-links #t]
+ [extra-breaking? #t])
+ `(tr
+ (td
+ ,@(if (part? p)
+ `((span ((class "tocsublinknumber"))
+ ,@(format-number (collected-info-number
+ (part-collected-info p ri))
+ '((tt nbsp)))))
+ '(""))
+ (a ((href ,(if (part? p)
+ (format "#~a" (tag-key (car (part-tags p)) ri))
+ (format "#~a" (tag-key (target-element-tag p) ri))))
+ (class ,(if (part? p)
+ "tocsubseclink"
+ "tocsublink")))
+ ,@(if (part? p)
+ (render-content (or (part-title-content p) '("???")) d ri)
+ (render-content (element-content p) d ri)))))))
+ ps))))))))
+
+ (define/public (render-one-part d ri fn number)
(parameterize ([current-output-file fn])
(let ([xpr `(html ()
(head
@@ -226,32 +249,28 @@
(content "text-html; charset=utf-8")))
,@(let ([c (part-title-content d)])
(if c
- `((title ,@(format-number number '(nbsp)) ,(content->string c this d ht)))
+ `((title ,@(format-number number '(nbsp)) ,(content->string c this d ri)))
null))
(link ((rel "stylesheet")
(type "text/css")
(href "scribble.css")
(title "default"))))
- (body ,@(render-toc-view d ht)
- (div ((class "main")) ,@(render-part d ht))))])
+ (body ,@(render-toc-view d ri)
+ (div ((class "main")) ,@(render-part d ri))))])
(install-file scribble-css)
(xml:write-xml/content (xml:xexpr->xml xpr)))))
- (define/override (render-one d ht fn)
- (render-one-part d ht fn null))
+ (define/override (render-one d ri fn)
+ (render-one-part d ri fn null))
- (define/override (render-part d ht)
- (let ([number (collected-info-number (part-collected-info d))])
+ (define/override (render-part d ri)
+ (let ([number (collected-info-number (part-collected-info d ri))])
`(,@(if (and (not (part-title-content d))
(null? number))
null
- (if (and (styled-part? d)
- (let ([s (styled-part-style d)])
- (or (eq? s 'hidden)
- (and (list? s)
- (memq 'hidden s)))))
+ (if (part-style? d 'hidden)
(map (lambda (t)
- `(a ((name ,(format "~a" `(part ,t))))))
+ `(a ((name ,(format "~a" (tag-key t ri))))))
(part-tags d))
`((,(case (length number)
[(0) 'h2]
@@ -260,21 +279,21 @@
[else 'h5])
,@(format-number number '((tt nbsp)))
,@(map (lambda (t)
- `(a ((name ,(format "~a" `(part ,t))))))
+ `(a ((name ,(format "~a" (tag-key t ri))))))
(part-tags d))
,@(if (part-title-content d)
- (render-content (part-title-content d) d ht)
+ (render-content (part-title-content d) d ri)
null)))))
- ,@(render-flow* (part-flow d) d ht #f)
+ ,@(render-flow* (part-flow d) d ri #f)
,@(let loop ([pos 1]
[secs (part-parts d)])
(if (null? secs)
null
(append
- (render-part (car secs) ht)
+ (render-part (car secs) ri)
(loop (add1 pos) (cdr secs))))))))
- (define/private (render-flow* p part ht special-last?)
+ (define/private (render-flow* p part ri special-last?)
;; Wrap each table with <p>, except for a trailing table
;; when `special-last?' is #t
(let loop ([f (flow-paragraphs p)])
@@ -283,71 +302,78 @@
[(and (table? (car f))
(or (not special-last?)
(not (null? (cdr f)))))
- (cons `(p ,@(render-flow-element (car f) part ht))
+ (cons `(p ,@(render-flow-element (car f) part ri))
(loop (cdr f)))]
[else
- (append (render-flow-element (car f) part ht)
+ (append (render-flow-element (car f) part ri)
(loop (cdr f)))])))
- (define/override (render-flow p part ht)
- (render-flow* p part ht #t))
+ (define/override (render-flow p part ri)
+ (render-flow* p part ri #t))
- (define/override (render-paragraph p part ht)
+ (define/override (render-paragraph p part ri)
`((p ,@(if (styled-paragraph? p)
`(((class ,(styled-paragraph-style p))))
null)
- ,@(super render-paragraph p part ht))))
+ ,@(super render-paragraph p part ri))))
- (define/override (render-element e part ht)
+ (define/override (render-element e part ri)
(cond
+ [(hover-element? e)
+ `((span ((title ,(hover-element-text e))) ,@(render-plain-element e part ri)))]
[(target-element? e)
- `((a ((name ,(target-element-tag e))))
- ,@(render-plain-element e part ht))]
+ `((a ((name ,(format "~a" (tag-key (target-element-tag e) ri)))))
+ ,@(render-plain-element e part ri))]
[(and (link-element? e)
(not (current-no-links)))
(parameterize ([current-no-links #t])
- (let ([dest (lookup part ht (link-element-tag e))])
+ (let ([dest (resolve-get part ri (link-element-tag e))])
(if dest
`((a ((href ,(format "~a~a~a"
- (from-root (car dest)
+ (from-root (relative->path (car dest))
(get-dest-directory))
(if (caddr dest)
""
"#")
(if (caddr dest)
""
- (link-element-tag e))))
+ (cadddr dest))))
,@(if (string? (element-style e))
`((class ,(element-style e)))
null))
,@(if (null? (element-content e))
- (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"))
- ,@(if (null? (element-content e))
- `(,(format "~s" (link-element-tag e)))
- (render-plain-element e part ht))))))))]
- [else (render-plain-element e part ht)]))
-
- (define/private (render-plain-element e part ht)
+ (render-content (strip-aux (cadr dest)) part ri)
+ (render-content (element-content e) part ri))))
+ (begin
+ (when #f
+ (fprintf (current-error-port)
+ "Undefined link: ~s~n"
+ (tag-key (link-element-tag e) ri)))
+ `((font ((class "badlink"))
+ ,@(if (null? (element-content e))
+ `(,(format "~s" (tag-key (link-element-tag e) ri)))
+ (render-plain-element e part ri))))))))]
+ [else (render-plain-element e part ri)]))
+
+ (define/private (render-plain-element e part ri)
(let ([style (and (element? e)
(element-style e))])
(cond
[(symbol? style)
(case style
- [(italic) `((i ,@(super render-element e part ht)))]
- [(bold) `((b ,@(super render-element e part ht)))]
- [(tt) `((tt ,@(super render-element e part ht)))]
- [(sf) `((b (font ([size "-1"][face "Helvetica"]) ,@(super render-element e part ht))))]
- [(subscript) `((sub ,@(super render-element e part ht)))]
- [(superscript) `((sup ,@(super render-element e part ht)))]
+ [(italic) `((i ,@(super render-element e part ri)))]
+ [(bold) `((b ,@(super render-element e part ri)))]
+ [(tt) `((tt ,@(super render-element e part ri)))]
+ [(no-break) `((span ([class "nobreak"]) ,@(super render-element e part ri)))]
+ [(sf) `((b (font ([size "-1"][face "Helvetica"]) ,@(super render-element e part ri))))]
+ [(subscript) `((sub ,@(super render-element e part ri)))]
+ [(superscript) `((sup ,@(super render-element e part ri)))]
[(hspace) `((span ([class "hspace"])
,@(let ([str (content->string (element-content e))])
(map (lambda (c) 'nbsp) (string->list str)))))]
[else (error 'html-render "unrecognized style symbol: ~e" style)])]
[(string? style)
- `((span ([class ,style]) ,@(super render-element e part ht)))]
+ `((span ([class ,style]) ,@(super render-element e part ri)))]
[(and (pair? style)
(eq? (car style) 'show-color))
`((font ((style ,(format "background-color: ~a"
@@ -357,16 +383,16 @@
(cdr style))))))
(tt nbsp nbsp nbsp nbsp nbsp))
nbsp
- ,@(super render-element e part ht))]
+ ,@(super render-element e part ri))]
[(target-url? style)
(if (current-no-links)
- (super render-element e part ht)
+ (super render-element e part ri)
(parameterize ([current-no-links #t])
- `((a ((href ,(target-url-addr style))) ,@(super render-element e part ht)))))]
+ `((a ((href ,(target-url-addr style))) ,@(super render-element e part ri)))))]
[(image-file? style) `((img ((src ,(install-file (image-file-path style))))))]
- [else (super render-element e part ht)])))
+ [else (super render-element e part ri)])))
- (define/override (render-table t part ht)
+ (define/override (render-table t part ri)
`((table ((cellspacing "0")
,@(case (table-style t)
[(boxed) '((class "boxed"))]
@@ -423,36 +449,36 @@
[(eq? 'cont (car ds)) (loop (+ n 1) (cdr ds))]
[else n])))))
null))
- ,@(render-flow d part ht))
+ ,@(render-flow d part ri))
(loop (cdr ds) (cdr as) (cdr vas)))))))))
(table-flowss t)
(cdr (or (and (list? (table-style t))
(assoc 'row-styles (or (table-style t) null)))
(cons #f (map (lambda (x) #f) (table-flowss t)))))))))
- (define/override (render-blockquote t part ht)
+ (define/override (render-blockquote t part ri)
`((blockquote ,@(if (string? (blockquote-style t))
`(((class ,(blockquote-style t))))
null)
,@(apply append
(map (lambda (i)
- (render-flow-element i part ht))
+ (render-flow-element i part ri))
(blockquote-paragraphs t))))))
- (define/override (render-itemization t part ht)
+ (define/override (render-itemization t part ri)
`((ul
,@(map (lambda (flow)
- `(li ,@(render-flow flow part ht)))
+ `(li ,@(render-flow flow part ri)))
(itemization-flows t)))))
- (define/override (render-other i part ht)
+ (define/override (render-other i part ri)
(cond
[(string? i) (let ([m (and (extra-breaking?)
(regexp-match-positions #rx":" i))])
(if m
(list* (substring i 0 (cdar m))
`(span ((class "mywbr")) " ")
- (render-other (substring i (cdar m)) part ht))
+ (render-other (substring i (cdar m)) part ri))
(list i)))]
[(eq? i 'mdash) `(" " ndash " ")]
[(eq? i 'hline) `((hr))]
@@ -470,7 +496,9 @@
(class %
(inherit render-one
render-one-part
- render-content)
+ render-content
+ part-whole-page?
+ format-number)
(define/override (get-suffix) #"")
@@ -479,10 +507,16 @@
(current-subdirectory))
(super get-dest-directory)))
- (define/private (derive-filename d ht)
+ (define/private (derive-filename d)
(let ([fn (format "~a.html" (regexp-replace*
"[^-a-zA-Z0-9_=]"
- (format "~a" (car (part-tags d)))
+ (let ([s (cadr (car (part-tags d)))])
+ (if (string? s)
+ s
+ (if (part-title-content d)
+ (content->string (part-title-content d))
+ ;; last-ditch effort to make up a unique name:
+ (format "???~a" (eq-hash-code d)))))
"_"))])
(when ((string-length fn) . >= . 48)
(error "file name too long (need a tag):" fn))
@@ -493,28 +527,25 @@
(build-path fn "index.html"))
fns)))
- (define/override (current-part-whole-page?)
+ (define/override (current-part-whole-page? d)
((collecting-sub) . <= . 2))
(define/private (toc-part? d)
- (and (styled-part? d)
- (let ([st (styled-part-style d)])
- (or (eq? 'toc st)
- (and (list? st) (memq 'toc st))))))
+ (part-style? d 'toc))
- (define/override (collect-part d parent ht number)
+ (define/override (collect-part d parent ci number)
(let ([prev-sub (collecting-sub)])
(parameterize ([collecting-sub (if (toc-part? d)
1
(add1 prev-sub))])
(if (= 1 prev-sub)
- (let ([filename (derive-filename d ht)])
+ (let ([filename (derive-filename d)])
(parameterize ([current-output-file (build-path (path-only (current-output-file))
filename)])
- (super collect-part d parent ht number)))
- (super collect-part d parent ht number)))))
+ (super collect-part d parent ci number)))
+ (super collect-part d parent ci number)))))
- (define/override (render ds fns ht)
+ (define/override (render ds fns ri)
(map (lambda (d fn)
(printf " [Output to ~a/index.html]\n" fn)
(unless (directory-exists? fn)
@@ -523,7 +554,7 @@
(let ([fn (build-path fn "index.html")])
(with-output-to-file fn
(lambda ()
- (render-one d ht fn))
+ (render-one d ri fn))
'truncate/replace))))
ds
fns))
@@ -538,8 +569,8 @@
(inherit render-table)
- (define/private (find-siblings d)
- (let ([parent (collected-info-parent (part-collected-info d))])
+ (define/private (find-siblings d ri)
+ (let ([parent (collected-info-parent (part-collected-info d ri))])
(let loop ([l (if parent
(part-parts parent)
(if (null? (part-parts d))
@@ -552,12 +583,12 @@
(cadr l)))]
[else (loop (cdr l) (car l))]))))
- (define/private (part-parent d)
- (collected-info-parent (part-collected-info d)))
+ (define/private (part-parent d ri)
+ (collected-info-parent (part-collected-info d ri)))
- (define/private (navigation d ht)
- (let ([parent (part-parent d)])
- (let*-values ([(prev next) (find-siblings d)]
+ (define/private (navigation d ri)
+ (let ([parent (part-parent d ri)])
+ (let*-values ([(prev next) (find-siblings d ri)]
[(prev) (if prev
(let loop ([prev prev])
(if (and (toc-part? prev)
@@ -575,17 +606,17 @@
parent
(toc-part? parent))
(let-values ([(prev next)
- (find-siblings parent)])
+ (find-siblings parent ri)])
next)]
[else next])]
[(index) (let loop ([d d])
- (let ([p (part-parent d)])
+ (let ([p (part-parent d ri)])
(if p
(loop p)
(let ([subs (part-parts d)])
(and (pair? subs)
(let ([d (car (last-pair subs))])
- (and (equal? '("Index") (part-title-content d))
+ (and (part-style? d 'index)
d)))))))])
`(,@(render-table (make-table
'at-left
@@ -614,9 +645,9 @@
(make-link-element
#f
index-content
- `(part ,(car (part-tags index))))))))))
+ (car (part-tags index)))))))))
null))))
- d ht)
+ d ri)
,@(render-table (make-table
'at-right
(list
@@ -628,7 +659,7 @@
(make-element
(if parent
(make-target-url (if prev
- (derive-filename prev ht)
+ (derive-filename prev)
"index.html"))
"nonavigation")
prev-content)
@@ -637,34 +668,34 @@
(if parent
(make-target-url
(if (toc-part? parent)
- (derive-filename parent ht)
+ (derive-filename parent)
"index.html"))
"nonavigation")
up-content)
sep-element
(make-element
(if next
- (make-target-url (derive-filename next ht))
+ (make-target-url (derive-filename next))
"nonavigation")
next-content))))))))
d
- ht)))))
+ ri)))))
- (define/override (render-part d ht)
- (let ([number (collected-info-number (part-collected-info d))])
+ (define/override (render-part d ri)
+ (let ([number (collected-info-number (part-collected-info d ri))])
(cond
[(and (not (on-separate-page))
(or (= 1 (length number))
(next-separate-page)))
;; Render as just a link, and put the actual
;; content in a new file:
- (let* ([filename (derive-filename d ht)]
+ (let* ([filename (derive-filename d)]
[full-path (build-path (path-only (current-output-file))
filename)])
(parameterize ([on-separate-page #t])
(with-output-to-file full-path
(lambda ()
- (render-one-part d ht full-path number))
+ (render-one-part d ri full-path number))
'truncate/replace)
null))]
[else
@@ -673,14 +704,14 @@
[on-separate-page #f])
(if sep?
;; Navigation bars;
- `(,@(navigation d ht)
+ `(,@(navigation d ri)
(p nbsp)
- ,@(super render-part d ht)
+ ,@(super render-part d ri)
(p nbsp)
- ,@(navigation d ht)
+ ,@(navigation d ri)
(p nbsp))
;; Normal section render
- (super render-part d ht))))])))
+ (super render-part d ri))))])))
(super-new)))
diff --git a/collects/scribble/latex-render.ss b/collects/scribble/latex-render.ss
@@ -18,13 +18,12 @@
render-flow-element
render-content
install-file
- format-number
- lookup)
+ format-number)
(define (define-color s s2)
(printf "\\newcommand{\\~a}[1]{{\\mytexttt{\\color{~a}{#1}}}}\n" s s2))
- (define/override (render-one d ht fn)
+ (define/override (render-one d ri fn)
(printf "\\documentclass{article}\n")
(printf "\\parskip=10pt%\n")
(printf "\\parindent=0pt%\n")
@@ -75,17 +74,16 @@
(printf "\\begin{document}\n\\sloppy\n")
(when (part-title-content d)
(printf "\\title{")
- (render-content (part-title-content d) d ht)
+ (render-content (part-title-content d) d ri)
(printf "}\\maketitle\n"))
- (render-part d ht)
+ (render-part d ri)
(printf "\\end{document}\n"))
- (define/override (render-part d ht)
- (let ([number (collected-info-number (part-collected-info d))])
+ (define/override (render-part d ri)
+ (let ([number (collected-info-number (part-collected-info d ri))])
(when (and (part-title-content d)
(pair? number))
- (when (and (styled-part? d)
- (eq? 'index (styled-part-style d)))
+ (when (part-style? d 'index)
(printf "\\twocolumn\n\\parskip=0pt\n\\addcontentsline{toc}{section}{Index}\n"))
(printf "\\~a~a{"
(case (length number)
@@ -97,20 +95,19 @@
(not (car number)))
"*"
""))
- (render-content (part-title-content d) d ht)
+ (render-content (part-title-content d) d ri)
(printf "}")
- (when (and (styled-part? d)
- (eq? 'index (styled-part-style d)))
+ (when (part-style? d 'index)
(printf "\n\n")))
(for-each (lambda (t)
- (printf "\\label{t:~a}" (t-encode `(part ,t))))
+ (printf "\\label{t:~a}" (t-encode (tag-key t ri))))
(part-tags d))
- (render-flow (part-flow d) d ht)
- (for-each (lambda (sec) (render-part sec ht))
+ (render-flow (part-flow d) d ri)
+ (for-each (lambda (sec) (render-part sec ri))
(part-parts d))
null))
- (define/override (render-paragraph p part ht)
+ (define/override (render-paragraph p part ri)
(printf "\n\n")
(let ([margin? (and (styled-paragraph? p)
(equal? "refpara" (styled-paragraph-style p)))])
@@ -118,28 +115,35 @@
(printf "\\marginpar{\\footnotesize "))
(if (toc-paragraph? p)
(printf "\\newpage \\tableofcontents \\newpage")
- (super render-paragraph p part ht))
+ (super render-paragraph p part ri))
(when margin?
(printf "}")))
(printf "\n\n")
null)
- (define/override (render-element e part ht)
+ (define/override (render-element e part ri)
(let ([part-label? (and (link-element? e)
(pair? (link-element-tag e))
(eq? 'part (car (link-element-tag e)))
(null? (element-content e)))])
(parameterize ([show-link-page-numbers #f])
(when (target-element? e)
- (printf "\\label{t:~a}" (t-encode (target-element-tag e))))
+ (printf "\\label{t:~a}" (t-encode (tag-key (target-element-tag e) ri))))
(when part-label?
(printf "\\S")
- (render-content (let ([dest (lookup part ht (link-element-tag e))])
+ (render-content (let ([dest (resolve-get part ri (link-element-tag e))])
(if dest
- (format-number (cadr dest) null)
+ (if (list? (cadr dest))
+ (format-number (cadr dest) null)
+ (begin
+ (fprintf (current-error-port)
+ "Internal tag error: ~s -> ~s\n"
+ (link-element-tag e)
+ dest)
+ '("!!!")))
(list "???")))
part
- ht)
+ ri)
(printf " ``"))
(let ([style (and (element? e)
(element-style e))]
@@ -147,7 +151,7 @@
(printf "{\\~a{" s)
(parameterize ([rendering-tt (or tt?
(rendering-tt))])
- (super render-element e part ht))
+ (super render-element e part ri))
(printf "}}"))])
(cond
[(symbol? style)
@@ -155,6 +159,7 @@
[(italic) (wrap e "textit" #f)]
[(bold) (wrap e "textbf" #f)]
[(tt) (wrap e "mytexttt" #t)]
+ [(nobreak) (super render-element e part ri)]
[(sf) (wrap e "textsf" #f)]
[(subscript) (wrap e "textsub" #f)]
[(superscript) (wrap e "textsuper" #f)]
@@ -170,12 +175,12 @@
[(image-file? style)
(let ([fn (install-file (image-file-path style))])
(printf "\\includegraphics{~a}" fn))]
- [else (super render-element e part ht)])))
+ [else (super render-element e part ri)])))
(when part-label?
(printf "''"))
(when (and (link-element? e)
(show-link-page-numbers))
- (printf ", \\pageref{t:~a}" (t-encode (link-element-tag e))))
+ (printf ", \\pageref{t:~a}" (t-encode (tag-key (link-element-tag e) ri))))
null))
(define/private (t-encode s)
@@ -192,7 +197,7 @@
(format "x~x" (char->integer c))]))
(string->list (format "~s" s)))))
- (define/override (render-table t part ht)
+ (define/override (render-table t part ri)
(let* ([boxed? (eq? 'boxed (table-style t))]
[index? (eq? 'index (table-style t))]
[inline? (and (not boxed?)
@@ -262,7 +267,7 @@
[else n]))])
(unless (= cnt 1)
(printf "\\multicolumn{~a}{l}{" cnt))
- (render-flow (car flows) part ht)
+ (render-flow (car flows) part ri)
(unless (= cnt 1)
(printf "}"))
(unless (null? (list-tail flows cnt))
@@ -284,25 +289,25 @@
""))))))
null)
- (define/override (render-itemization t part ht)
+ (define/override (render-itemization t part ri)
(printf "\n\n\\begin{itemize}\n")
(for-each (lambda (flow)
(printf "\n\n\\item ")
- (render-flow flow part ht))
+ (render-flow flow part ri))
(itemization-flows t))
(printf "\n\n\\end{itemize}\n")
null)
- (define/override (render-blockquote t part ht)
+ (define/override (render-blockquote t part ri)
(printf "\n\n\\begin{quote}\n")
(parameterize ([current-table-mode (list "blockquote" t)])
(for-each (lambda (e)
- (render-flow-element e part ht))
+ (render-flow-element e part ri))
(blockquote-paragraphs t)))
(printf "\n\n\\end{quote}\n")
null)
- (define/override (render-other i part ht)
+ (define/override (render-other i part ri)
(cond
[(string? i) (display-protected i)]
[(symbol? i) (display
@@ -362,11 +367,11 @@
;; ----------------------------------------
- (define/override (table-of-contents sec ht)
+ (define/override (table-of-contents sec ri)
;; FIXME: isn't local to the section
(make-toc-paragraph null))
- (define/override (local-table-of-contents part ht)
+ (define/override (local-table-of-contents part ri)
(make-paragraph null))
;; ----------------------------------------
diff --git a/collects/scribble/manual.ss b/collects/scribble/manual.ss
@@ -10,6 +10,8 @@
(lib "class.ss")
(lib "stxparam.ss"))
(require-for-syntax (lib "stxparam.ss"))
+ (require-for-label (lib "lang.ss" "big")
+ (lib "class.ss"))
(provide (all-from "basic.ss"))
@@ -50,10 +52,24 @@
(define (to-element/id s)
(make-element "schemesymbol" (list (to-element/no-color s))))
- (define (keep-s-expr ctx s v)
+ (define-syntax (keep-s-expr stx)
+ (syntax-case stx ()
+ [(_ ctx s srcloc)
+ (let ([sv (syntax-e #'s)])
+ (if (or (number? sv)
+ (boolean? sv)
+ (and (pair? sv)
+ (identifier? (car sv))
+ (module-identifier=? #'cons (car sv))))
+ ;; We know that the context is irrelvant
+ #'s
+ ;; Context may be relevant:
+ #'(*keep-s-expr s ctx)))]))
+ (define (*keep-s-expr s ctx)
(if (symbol? s)
(make-just-context s ctx)
s))
+
(define (add-sq-prop s name val)
(if (eq? name 'paren-shape)
(make-shaped-parens s val)
@@ -158,9 +174,9 @@
(define (exec . str)
(make-element 'tt (decode-content str)))
(define (Flag . str)
- (make-element 'tt (cons "-" (decode-content str))))
+ (make-element 'no-break (list (make-element 'tt (cons "-" (decode-content str))))))
(define (DFlag . str)
- (make-element 'tt (cons "--" (decode-content str))))
+ (make-element 'no-break (list (make-element 'tt (cons "--" (decode-content str))))))
(define (envvar . str)
(make-element 'tt (decode-content str)))
(define (indexed-envvar . str)
@@ -198,9 +214,8 @@
(elem (method a b) " in " (scheme a))]))
(define (*method sym id)
- (let ([tag (format "~a::~a"
- (register-scheme-definition id)
- sym)])
+ (let ([tag (method-tag (register-scheme-definition id #t)
+ sym)])
(make-element
"schemesymbol"
(list (make-link-element
@@ -208,6 +223,9 @@
(list (symbol->string sym))
tag)))))
+ (define (method-tag vtag sym)
+ (list 'meth
+ (format "~a::~a" (cadr vtag) sym)))
;; ----------------------------------------
@@ -222,7 +240,7 @@
(provide deftech tech techlink)
- (define (*tech make-elem style s)
+ (define (*tech make-elem style doc s)
(let* ([c (decode-content s)]
[s (regexp-replace* #px"[-\\s]+"
(regexp-replace
@@ -235,26 +253,27 @@
" ")])
(make-elem style
c
- (format "tech-term:~a" s))))
+ (list 'tech (doc-prefix doc s)))))
(define (deftech . s)
(let* ([e (apply defterm s)]
- [t (*tech make-target-element #f (list e))])
+ [t (*tech make-target-element #f #f (list e))])
(make-index-element #f
(list t)
(target-element-tag t)
(list (element->string e))
(list e))))
- (define (tech . s)
- (*tech make-link-element "techlink" s))
+ (define (tech #:doc [doc #f] . s)
+ (*tech make-link-element "techlink" doc s))
- (define (techlink . s)
- (*tech make-link-element #f s))
+ (define (techlink #:doc [doc #f] . s)
+ (*tech make-link-element #f doc s))
;; ----------------------------------------
- (provide defproc defproc* defstruct defthing defparam defboolparam
+ (provide declare-exporting
+ defproc defproc* defstruct defthing defparam defboolparam
defform defform* defform/subs defform*/subs defform/none
defidform
specform specform/subs
@@ -262,6 +281,33 @@
schemegrammar schemegrammar*
var svar void-const undefined-const)
+ (define-syntax declare-exporting
+ (syntax-rules ()
+ [(_ lib ...) (*declare-exporting '(lib ...))]))
+
+ (define (*declare-exporting libs)
+ (make-part-collect-decl
+ (make-collect-element #f
+ null
+ (lambda (ri)
+ (collect-put! ri '(exporting-libraries #f)libs)))))
+
+ (define-syntax (quote-syntax/loc stx)
+ (syntax-case stx ()
+ [(_ id)
+ (with-syntax ([loc
+ (let ([s #'id])
+ (list (syntax-source s)
+ (syntax-line s)
+ (syntax-column s)
+ (syntax-position s)
+ (syntax-span s)))])
+ #'(let ([s (quote-syntax id)])
+ (datum->syntax-object s
+ (syntax-e s)
+ 'loc
+ s)))]))
+
(define void-const
(schemeresultfont "#<void>"))
(define undefined-const
@@ -304,13 +350,13 @@
(syntax-rules ()
[(_ (id arg ...) result desc ...)
(defproc* [[(id arg ...) result]] desc ...)]))
- (define-syntax defproc*
+ (define-syntax defproc*
(syntax-rules ()
[(_ [[(id arg ...) result] ...] desc ...)
(defproc* #:mode procedure #:within #f [[(id arg ...) result] ...] desc ...)]
[(_ #:mode m #:within cl [[(id arg ...) result] ...] desc ...)
- (*defproc 'm (quote-syntax cl)
- (list (quote-syntax id) ...)
+ (*defproc 'm (quote-syntax/loc cl)
+ (list (quote-syntax/loc id) ...)
'[(id arg ...) ...]
(list (list (lambda () (arg-contract arg)) ...) ...)
(list (lambda () (schemeblock0 result)) ...)
@@ -328,7 +374,7 @@
(define-syntax **defstruct
(syntax-rules ()
[(_ name ([field field-contract] ...) immutable? transparent? desc ...)
- (*defstruct (quote-syntax name) 'name
+ (*defstruct (quote-syntax/loc name) 'name
'([field field-contract] ...) (list (lambda () (schemeblock0 field-contract)) ...)
#t #t (lambda () (list desc ...)))]))
(define-syntax (defform*/subs stx)
@@ -347,7 +393,7 @@
[spec-id
(syntax-case #'spec ()
[(name . rest) #'name])])
- #'(*defforms (quote-syntax spec-id) '(lit ...)
+ #'(*defforms (quote-syntax/loc spec-id) '(lit ...)
'(spec spec1 ...)
(list (lambda (x) (schemeblock0 new-spec))
(lambda (ignored) (schemeblock0 spec1)) ...)
@@ -381,7 +427,7 @@
(define-syntax (defidform stx)
(syntax-case stx ()
[(_ spec-id desc ...)
- #'(*defforms (quote-syntax spec-id) null
+ #'(*defforms (quote-syntax/loc spec-id) null
'(spec-id)
(list (lambda (x) (make-paragraph (list x))))
null
@@ -440,7 +486,7 @@
(define-syntax defthing
(syntax-rules ()
[(_ id result desc ...)
- (*defthing (quote-syntax id) 'id (quote-syntax result) (lambda () (list desc ...)))]))
+ (*defthing (quote-syntax/loc id) 'id (quote-syntax result) (lambda () (list desc ...)))]))
(define-syntax defparam
(syntax-rules ()
[(_ id arg contract desc ...)
@@ -494,6 +540,27 @@
type-sym)
""))))
+ (define (annote-exporting-library e)
+ (make-delayed-element
+ (lambda (render p ri)
+ (let ([from (resolve-get p ri '(exporting-libraries #f))])
+ (if (and from
+ (pair? from))
+ (list (make-hover-element
+ #f
+ (list e)
+ (string-append
+ "Provided from: "
+ (let loop ([from from])
+ (if (null? (cdr from))
+ (format "~s" (car from))
+ (format "~s, ~a"
+ (car from)
+ (loop (cdr from))))))))
+ (list e))))
+ (lambda () e)
+ (lambda () e)))
+
(define (*defproc mode within-id
stx-ids prototypes arg-contractss result-contracts content-thunk)
(let ([spacer (hspace 1)]
@@ -589,34 +656,40 @@
(hspace 1)
(if first?
(let* ([mname (car prototype)]
- [tag (format "~a::~a"
- (register-scheme-definition within-id)
- mname)]
+ [ctag (register-scheme-definition within-id #t)]
+ [tag (method-tag ctag mname)]
[content (list (*method mname within-id))])
- (make-toc-target-element
- #f
- (list (make-index-element #f
- content
- tag
- (list (symbol->string mname))
- content))
- tag))
+ (if tag
+ (make-toc-target-element
+ #f
+ (list (make-index-element #f
+ content
+ tag
+ (list (symbol->string mname))
+ content))
+ tag)
+ (car content)))
(*method (car prototype) within-id))))]
[else
(if first?
- (let ([tag (register-scheme-definition stx-id)]
- [content (list (to-element (make-just-context (car prototype)
- stx-id)))])
- (make-toc-target-element
- #f
- (list (make-index-element #f
- content
- tag
- (list (symbol->string (car prototype)))
- content))
- tag))
- (to-element (make-just-context (car prototype)
- stx-id)))])]
+ (let ([tag (register-scheme-definition stx-id #t)]
+ [content (list
+ (annote-exporting-library
+ (to-element (make-just-context (car prototype)
+ stx-id))))])
+ (if tag
+ (make-toc-target-element
+ #f
+ (list (make-index-element #f
+ content
+ tag
+ (list (symbol->string (car prototype)))
+ content))
+ tag)
+ (car content)))
+ (annote-exporting-library
+ (to-element (make-just-context (car prototype)
+ stx-id))))])]
[(flat-size) (+ (prototype-size (cdr prototype) + +)
(element-width tagged))]
[(short?) (or (flat-size . < . 40)
@@ -799,16 +872,19 @@
(register-scheme-definition
(datum->syntax-object stx-id
(string->symbol
- name)))])
- (inner-make-target-element
- #f
- (list
- (make-index-element #f
- (list content)
- tag
- (list name)
- (list (schemeidfont (make-element "schemevaluelink" (list name))))))
- tag))
+ name))
+ #t)])
+ (if tag
+ (inner-make-target-element
+ #f
+ (list
+ (make-index-element #f
+ (list content)
+ tag
+ (list name)
+ (list (schemeidfont (make-element "schemevaluelink" (list name))))))
+ tag)
+ content))
(cdr wrappers))))
(define (*defstruct stx-id name fields field-contracts immutable? transparent? content-thunk)
@@ -826,9 +902,10 @@
(make-target-element*
make-toc-target-element
stx-id
- (to-element (if (pair? name)
- (make-just-context (car name) stx-id)
- stx-id))
+ (annote-exporting-library
+ (to-element (if (pair? name)
+ (make-just-context (car name) stx-id)
+ stx-id)))
(let ([name (if (pair? name)
(car name)
name)])
@@ -975,16 +1052,19 @@
(list (make-flow
(list
(make-paragraph
- (list (let ([tag (register-scheme-definition stx-id)]
- [content (list (to-element (make-just-context name stx-id)))])
- (make-toc-target-element
- #f
- (list (make-index-element #f
- content
- tag
- (list (symbol->string name))
- content))
- tag))
+ (list (let ([tag (register-scheme-definition stx-id #t)]
+ [content (list (annote-exporting-library
+ (to-element (make-just-context name stx-id))))])
+ (if tag
+ (make-toc-target-element
+ #f
+ (list (make-index-element #f
+ content
+ tag
+ (list (symbol->string name))
+ content))
+ tag)
+ (car content)))
spacer ":" spacer
(to-element result-contract))))))))
(content-thunk))))
@@ -1026,25 +1106,32 @@
(make-paragraph
(list
(to-element
- `(,x
- . ,(cdr form)))))))
+ `(,x . ,(cdr form)))))))
(and kw-id
(eq? form (car forms))
- (let ([tag (register-scheme-form-definition kw-id)]
- [content (list (to-element (make-just-context (if (pair? form)
- (car form)
- form)
- kw-id)))])
- (make-toc-target-element
- #f
- (if kw-id
- (list (make-index-element #f
- content
- tag
- (list (symbol->string (syntax-e kw-id)))
- content))
- content)
- tag))))))))
+ (let ([tag (register-scheme-definition kw-id #t)]
+ [stag (register-scheme-form-definition kw-id)]
+ [content (list (annote-exporting-library
+ (to-element (make-just-context (if (pair? form)
+ (car form)
+ form)
+ kw-id))))])
+ (if tag
+ (make-toc-target-element
+ #f
+ (list
+ (make-toc-target-element
+ #f
+ (if kw-id
+ (list (make-index-element #f
+ content
+ tag
+ (list (symbol->string (syntax-e kw-id)))
+ content))
+ content)
+ tag))
+ stag)
+ (car content)))))))))
forms form-procs)
(if (null? sub-procs)
null
@@ -1156,17 +1243,25 @@
(make-paragraph (list (hspace 2) (apply tt s))))
(define (elemtag t . body)
- (make-target-element #f (decode-content body) t))
+ (make-target-element #f (decode-content body) `(elem ,t)))
(define (elemref t . body)
- (make-link-element #f (decode-content body) t))
+ (make-link-element #f (decode-content body) `(elem ,t)))
(provide elemtag elemref)
- (define (secref s)
- (make-link-element #f null `(part ,s)))
- (define (seclink tag . s)
- (make-link-element #f (decode-content s) `(part ,tag)))
+ (define (doc-prefix doc s)
+ (if doc
+ (format "~a:~a"
+ (module-path-prefix->string doc)
+ s)
+ s))
+
+ (define (secref s #:doc [doc #f])
+ (make-link-element #f null `(part ,(doc-prefix doc s))))
+ (define (seclink tag #:doc [doc #f] . s)
+ (make-link-element #f (decode-content s) `(part ,(doc-prefix doc tag))))
(define (*schemelink stx-id id . s)
- (make-link-element #f (decode-content s) (register-scheme-definition stx-id)))
+ (make-link-element #f (decode-content s) (or (register-scheme-definition stx-id)
+ (format "--UNDEFINED:~a--" (syntax-e stx-id)))))
(define-syntax schemelink
(syntax-rules ()
[(_ id . content) (*schemelink (quote-syntax id) 'id . content)]))
@@ -1261,7 +1356,7 @@
(define id val)))]))
(define-syntax (class-doc-info stx)
- (syntax-case stx (object%)
+ (syntax-case* stx (object%) module-label-identifier=?
[(_ object%) #'#f]
[(_ id) (class-id->class-doc-info-id #'id)]))
@@ -1357,18 +1452,22 @@
(list (make-flow
(list
(make-paragraph
- (list (let ([tag (register-scheme-definition stx-id)]
- [content (list (to-element stx-id))])
- ((if whole-page?
- make-page-target-element
- make-toc-target-element)
- #f
- (list (make-index-element #f
- content
- tag
- (list (symbol->string (syntax-e stx-id)))
- content))
- tag))
+ (list (let ([tag (register-scheme-definition stx-id #t)]
+ [content (list (annote-exporting-library (to-element stx-id)))])
+ (if tag
+ ((if whole-page?
+ make-page-target-element
+ make-toc-target-element)
+ #f
+ (if whole-page?
+ content ; title is already an index entry
+ (list (make-index-element #f
+ content
+ tag
+ (list (symbol->string (syntax-e stx-id)))
+ content)))
+ tag)
+ (car content)))
spacer ":" spacer
(if super
(scheme class?)
@@ -1403,12 +1502,12 @@
[(_ name super (intf ...) body ...)
(define-class-doc-info name
(syntax-parameterize ([current-class (quote-syntax name)])
- (register-class (quote-syntax name)
+ (register-class (quote-syntax/loc name)
(class-doc-info super)
(list (class-doc-info intf) ...)
(lambda (whole-page?)
(list
- (*defclass (quote-syntax name)
+ (*defclass (quote-syntax/loc name)
(quote-syntax super)
(list (quote-syntax intf) ...)
whole-page?)))
@@ -1419,12 +1518,12 @@
[(_ name (intf ...) body ...)
(define-class-doc-info name
(syntax-parameterize ([current-class (quote-syntax name)])
- (register-class (quote-syntax name)
+ (register-class (quote-syntax/loc name)
#f
(list (class-doc-info intf) ...)
(lambda (whole-page?)
(list
- (*defclass (quote-syntax name)
+ (*defclass (quote-syntax/loc name)
#f
(list (quote-syntax intf) ...)
whole-page?)))
diff --git a/collects/scribble/run.ss b/collects/scribble/run.ss
@@ -67,7 +67,7 @@
(when dir
(make-directory* dir))
- (let ([renderer (new ((current-render-mixin) render% )
+ (let ([renderer (new ((current-render-mixin) render%)
[dest-dir dir])])
(let* ([fns (map (lambda (fn)
(let-values ([(base name dir?) (split-path fn)])
@@ -82,8 +82,15 @@
[files (reverse (current-info-input-files))])
(if (null? files)
info
- (loop (send renderer load-info (car files) info)
+ (loop (let ([s (with-input-from-file (car files) read)])
+ (send renderer deserialize-info s info)
+ info)
(cdr files))))])
- (send renderer render docs fns info))
- (when (current-info-output-file)
- (send renderer save-info (current-info-output-file) info)))))))
+ (let ([r-info (send renderer resolve docs fns info)])
+ (send renderer render docs fns r-info)
+ (when (current-info-output-file)
+ (let ([s (send renderer serialize-info r-info)])
+ (with-output-to-file (current-info-output-file)
+ (lambda ()
+ (write s))
+ 'truncate/replace))))))))))
diff --git a/collects/scribble/scheme.ss b/collects/scribble/scheme.ss
@@ -1,9 +1,10 @@
-(module scheme mzscheme
+(module scheme (lib "lang.ss" "big")
(require "struct.ss"
"basic.ss"
(lib "class.ss")
(lib "for.ss")
- (lib "modcollapse.ss" "syntax"))
+ (lib "main-collects.ss" "setup")
+ (lib "modresolve.ss" "syntax"))
(provide define-code
to-element
@@ -33,13 +34,7 @@
(define opt-color "schemeopt")
(define current-keyword-list
- ;; This is temporary, until the MzScheme manual is filled in...
- (make-parameter null #;'(require
- provide
- new send else => and or
- define-syntax syntax-rules define-struct
- quasiquote unquote unquote-splicing
- syntax quasisyntax unsyntax unsyntax-splicing)))
+ (make-parameter null))
(define current-variable-list
(make-parameter null))
(define current-meta-list
@@ -51,7 +46,76 @@
(define-struct spaces (pre cnt post))
- (define (typeset c multi-line? prefix1 prefix suffix color?)
+ (define (literalize-spaces i)
+ (let ([m (regexp-match-positions #rx" +" i)])
+ (if m
+ (make-spaces (literalize-spaces (substring i 0 (caar m)))
+ (- (cdar m) (caar m))
+ (literalize-spaces (substring i (cdar m))))
+ i)))
+
+ (define (typeset-atom c out color? quote-depth)
+ (let-values ([(s it? sub?)
+ (let ([c (syntax-e c)])
+ (let ([s (format "~s" c)])
+ (if (and (symbol? c)
+ ((string-length s) . > . 1)
+ (char=? (string-ref s 0) #\_))
+ (values (substring s 1) #t #f)
+ (values s #f #f))))]
+ [(is-var?) (and (identifier? c)
+ (memq (syntax-e c) (current-variable-list)))])
+ (if (or (element? (syntax-e c))
+ (delayed-element? (syntax-e c)))
+ (out (syntax-e c) #f)
+ (out (if (and (identifier? c)
+ color?
+ (quote-depth . <= . 0)
+ (not (or it? is-var?)))
+ (let ([tag (register-scheme c)])
+ (if tag
+ (make-delayed-element
+ (lambda (renderer sec ri)
+ (let* ([vtag `(def ,tag)]
+ [stag `(form ,tag)]
+ [sd (resolve-get sec ri stag)])
+ (list
+ (cond
+ [sd
+ (make-link-element "schemesyntaxlink" (list s) stag)]
+ [else
+ (make-link-element "schemevaluelink" (list s) vtag)]))))
+ (lambda () s)
+ (lambda () s))
+ s))
+ (literalize-spaces s))
+ (cond
+ [(positive? quote-depth) value-color]
+ [(let ([v (syntax-e c)])
+ (or (number? v)
+ (string? v)
+ (bytes? v)
+ (char? v)
+ (regexp? v)
+ (byte-regexp? v)
+ (boolean? v)))
+ value-color]
+ [(identifier? c)
+ (cond
+ [is-var?
+ variable-color]
+ [(and (identifier? c)
+ (memq (syntax-e c) (current-keyword-list)))
+ keyword-color]
+ [(and (identifier? c)
+ (memq (syntax-e c) (current-meta-list)))
+ meta-color]
+ [it? variable-color]
+ [else symbol-color])]
+ [else paren-color])
+ (string-length s)))))
+
+ (define (gen-typeset c multi-line? prefix1 prefix suffix color?)
(let* ([c (syntax-ize c 0)]
[content null]
[docs null]
@@ -80,6 +144,10 @@
[(and (element? v)
(= 1 (length (element-content v))))
(sz-loop (car (element-content v)))]
+ [(element? v)
+ (element-width v)]
+ [(delayed-element? v)
+ (element-width v)]
[(spaces? v)
(+ (sz-loop (spaces-pre v))
(spaces-cnt v)
@@ -176,13 +244,6 @@
c)
(loop (cdr l)
(cons (car l) prev))))]))))))
- (define (literalize-spaces i)
- (let ([m (regexp-match-positions #rx" +" i)])
- (if m
- (make-spaces (literalize-spaces (substring i 0 (caar m)))
- (- (cdar m) (caar m))
- (literalize-spaces (substring i (cdar m))))
- i)))
(define (no-fancy-chars s)
(cond
[(eq? s 'rsquo) "'"]
@@ -359,65 +420,10 @@
(set! src-col (+ orig-col (syntax-span c)))))]
[else
(advance c init-line!)
- (let-values ([(s it? sub?)
- (let ([c (syntax-e c)])
- (let ([s (format "~s" c)])
- (if (and (symbol? c)
- ((string-length s) . > . 1)
- (char=? (string-ref s 0) #\_))
- (values (substring s 1) #t #f)
- (values s #f #f))))]
- [(is-var?) (and (identifier? c)
- (memq (syntax-e c) (current-variable-list)))])
- (if (element? (syntax-e c))
- (out (syntax-e c) #f)
- (out (if (and (identifier? c)
- color?
- (quote-depth . <= . 0)
- (not (or it? is-var?)))
- (make-delayed-element
- (lambda (renderer sec ht)
- (let* ([vtag (register-scheme-definition c)]
- [stag (register-scheme-form-definition c)]
- [vd (hash-table-get ht vtag #f)]
- [sd (hash-table-get ht stag #f)])
- (list
- (cond
- [sd
- (make-link-element "schemesyntaxlink" (list s) stag)]
- [vd
- (make-link-element "schemevaluelink" (list s) vtag)]
- [else s]))))
- (lambda () s)
- (lambda () s))
- (literalize-spaces s))
- (cond
- [(positive? quote-depth) value-color]
- [(or (number? (syntax-e c))
- (string? (syntax-e c))
- (bytes? (syntax-e c))
- (char? (syntax-e c))
- (regexp? (syntax-e c))
- (byte-regexp? (syntax-e c))
- (boolean? (syntax-e c)))
- value-color]
- [(identifier? c)
- (cond
- [is-var?
- variable-color]
- [(and (identifier? c)
- (memq (syntax-e c) (current-keyword-list)))
- keyword-color]
- [(and (identifier? c)
- (memq (syntax-e c) (current-meta-list)))
- meta-color]
- [it? variable-color]
- [else symbol-color])]
- [else paren-color])
- (string-length s)))
- (set! src-col (+ src-col (or (syntax-span c) 1)))
- #;
- (hash-table-put! next-col-map src-col dest-col))])))
+ (typeset-atom c out color? quote-depth)
+ (set! src-col (+ src-col (or (syntax-span c) 1)))
+ #;
+ (hash-table-put! next-col-map src-col dest-col)])))
(out prefix1 #f)
(set! dest-col 0)
(hash-table-put! next-col-map init-col dest-col)
@@ -436,6 +442,25 @@
(make-table "schemeblock" (map list (reverse docs))))
(make-sized-element #f (reverse content) dest-col))))
+ (define (typeset c multi-line? prefix1 prefix suffix color?)
+ (let* ([c (syntax-ize c 0)]
+ [s (syntax-e c)])
+ (if (or multi-line?
+ (eq? 'code:blank s)
+ (pair? s)
+ (vector? s)
+ (box? s)
+ (null? s)
+ (hash-table? s))
+ (gen-typeset c multi-line? prefix1 prefix suffix color?)
+ (typeset-atom c
+ (case-lambda
+ [(elem color)
+ (make-sized-element (and color? color) (list elem) (or (syntax-span c) 1))]
+ [(elem color len)
+ (make-sized-element (and color? color) (list elem) len)])
+ color? 0))))
+
(define (to-element c)
(typeset c #f "" "" "" #t))
@@ -457,15 +482,15 @@
(cond
[(syntax? v)
(let ([mk `(,#'d->s
- (quote-syntax ,v)
+ (quote-syntax ,(datum->syntax-object v 'defcode))
,(syntax-case v (uncode)
[(uncode e) #'e]
[else (stx->loc-s-expr (syntax-e v))])
- (list 'code
- ,(syntax-line v)
- ,(syntax-column v)
- ,(syntax-position v)
- ,(syntax-span v)))])
+ '(code
+ ,(syntax-line v)
+ ,(syntax-column v)
+ ,(syntax-position v)
+ ,(syntax-span v)))])
(let ([prop (syntax-property v 'paren-shape)])
(if prop
`(,#'stx-prop ,mk 'paren-shape ,prop)
@@ -484,27 +509,43 @@
[(_ expr) #`(typeset-code #,(cvt #'expr))]
[(_ expr (... ...))
#`(typeset-code #,(cvt #'(code:line expr (... ...))))])))]
+ [(_ code typeset-code uncode d->s)
+ #'(define-code code typeset-code uncode d->s syntax-property)]
[(_ code typeset-code uncode)
#'(define-code code typeset-code uncode datum->syntax-object syntax-property)]
[(_ code typeset-code) #'(define-code code typeset-code unsyntax)]))
- (define (register-scheme-definition stx)
+ (define (register-scheme stx [warn-if-no-label? #f])
(unless (identifier? stx)
(error 'register-scheme-definition "not an identifier: ~e" (syntax-object->datum stx)))
- (format "definition:~a"
- (let ([b (identifier-binding stx)])
- (cond
- [(not b) (format "top:~a" (syntax-e stx))]
- [(eq? b 'lexical) (format "lexical:~a" (syntax-e stx))]
- [else (format "module:~a:~a"
- (if (module-path-index? (car b))
- (collapse-module-path-index (car b) '(lib "ack.ss" "scribble"))
- (car b))
- (cadr b))]))))
+ (let ([b (identifier-label-binding stx)])
+ (if (or (not b)
+ (eq? b 'lexical))
+ (if warn-if-no-label?
+ (begin
+ (fprintf (current-error-port)
+ "~a\n"
+ ;; Call raise-syntax-error to capture error message:
+ (with-handlers ([exn:fail:syntax? (lambda (exn)
+ (exn-message exn))])
+ (raise-syntax-error 'WARNING
+ "no for-label binding of identifier"
+ stx)))
+ (format ":NOLABEL:~a" (syntax-e stx)))
+ #f)
+ (format ":~a:~a"
+ (if (module-path-index? (car b))
+ (let ([p (resolve-module-path-index (car b) #f)])
+ (path->main-collects-relative p))
+ (car b))
+ (cadr b)))))
+
+ (define (register-scheme-definition stx [warn-if-no-label? #f])
+ `(def ,(register-scheme stx warn-if-no-label?)))
- (define (register-scheme-form-definition stx)
- (format "form~s" (register-scheme-definition stx)))
+ (define (register-scheme-form-definition stx [warn-if-no-label? #f])
+ `(form ,(register-scheme stx warn-if-no-label?)))
(define syntax-ize-hook (make-parameter (lambda (v col) #f)))
@@ -551,7 +592,11 @@
(just-context-ctx v)))]
[(and (list? v)
(pair? v)
- (memq (car v) '(quote unquote unquote-splicing)))
+ (memq (let ([s (car v)])
+ (if (just-context? s)
+ (just-context-val s)
+ s))
+ '(quote unquote unquote-splicing)))
(let ([c (syntax-ize (cadr v) (+ col 1))])
(datum->syntax-object #f
(list (syntax-ize (car v) col)
diff --git a/collects/scribble/scribble.css b/collects/scribble/scribble.css
@@ -140,6 +140,10 @@
text-decoration: none;
}
+ .nobreak {
+ white-space: nowrap;
+ }
+
.title {
font-size: 200%;
font-weight: normal;
diff --git a/collects/scribble/struct.ss b/collects/scribble/struct.ss
@@ -1,8 +1,56 @@
-(module struct mzscheme
+(module struct (lib "lang.ss" "big")
(require (lib "contract.ss")
(lib "serialize.ss"))
+ ;; ----------------------------------------
+
+ (define-struct collect-info (ht ext-ht parts tags gen-prefix))
+ (define-struct resolve-info (ci delays undef))
+
+ (define (part-collected-info part ri)
+ (hash-table-get (collect-info-parts (resolve-info-ci ri))
+ part))
+
+
+ (define (collect-put! ci key val)
+ (hash-table-put! (collect-info-ht ci)
+ key
+ val))
+
+ (define (resolve-get/where part ri key)
+ (let ([key (tag-key key ri)])
+ (let ([v (hash-table-get (if part
+ (collected-info-info (part-collected-info part ri))
+ (collect-info-ht (resolve-info-ci ri)))
+ key
+ #f)])
+ (cond
+ [v (values v #f)]
+ [part (resolve-get/where (collected-info-parent
+ (part-collected-info part ri))
+ ri
+ key)]
+ [else
+ (let ([v (hash-table-get (collect-info-ext-ht (resolve-info-ci ri))
+ key
+ #f)])
+ (values v #t))]))))
+
+ (define (resolve-get part ri key)
+ (let-values ([(v ext?) (resolve-get/where part ri key)])
+ v))
+
+ (provide
+ (struct collect-info (ht ext-ht parts tags gen-prefix))
+ (struct resolve-info (ci delays undef))
+ part-collected-info
+ collect-put!
+ resolve-get
+ resolve-get/where)
+
+ ;; ----------------------------------------
+
(provide provide-structs)
(define-syntax (provide-structs stx)
@@ -36,12 +84,12 @@
fields+cts)))))]))
(provide tag?)
- (define (tag? s) (or (string? s)
- (and (pair? s)
- (symbol? (car s))
- (pair? (cdr s))
- (string? (cadr s))
- (null? (cddr s)))))
+ (define (tag? s) (and (pair? s)
+ (symbol? (car s))
+ (pair? (cdr s))
+ (or (string? (cadr s))
+ (generated-tag? (cadr s)))
+ (null? (cddr s))))
(provide flow-element?)
(define (flow-element? p)
@@ -52,21 +100,21 @@
(delayed-flow-element? p)))
(provide-structs
- [part ([tags (listof tag?)]
+ [part ([tag-prefix (or/c false/c string?)]
+ [tags (listof tag?)]
[title-content (or/c false/c list?)]
- [collected-info (or/c false/c collected-info?)]
+ [style any/c]
[to-collect list?]
[flow flow?]
[parts (listof part?)])]
- [(styled-part part) ([style any/c])]
- [(unnumbered-part styled-part) ()]
+ [(unnumbered-part part) ()]
[flow ([paragraphs (listof flow-element?)])]
[paragraph ([content list?])]
[(styled-paragraph paragraph) ([style any/c])]
[table ([style any/c]
[flowss (listof (listof (or/c flow? (one-of/c 'cont))))])]
[(auxiliary-table table) ()]
- [delayed-flow-element ([render (any/c part? any/c . -> . flow-element?)])]
+ [delayed-flow-element ([resolve (any/c part? resolve-info? . -> . flow-element?)])]
[itemization ([flows (listof flow?)])]
[blockquote ([style any/c]
[paragraphs (listof flow-element?)])]
@@ -81,6 +129,7 @@
[plain-seq (listof string?)]
[entry-seq list?])]
[(aux-element element) ()]
+ [(hover-element element) ([text string?])]
;; specific renders support other elements, especially strings
[collected-info ([number (listof (or/c false/c integer?))]
@@ -89,46 +138,32 @@
[target-url ([addr string?])]
[image-file ([path path-string?])])
-
+
;; ----------------------------------------
;; Delayed element has special serialization support:
- (define-values (struct:delayed-element
- make-delayed-element
- delayed-element?
- delayed-element-ref
- delayed-element-set!)
- (make-struct-type 'delayed-element #f
- 3 1 #f
- (list (cons prop:serializable
- (make-serialize-info
- (lambda (d)
- (unless (delayed-element-ref d 3)
- (error 'serialize-delayed-element
- "cannot serialize a delayed element that was not resolved: ~e"
- d))
- (vector (delayed-element-ref d 3)))
- #'deserialize-delayed-element
- #f
- (or (current-load-relative-directory) (current-directory)))))))
- (define-syntax delayed-element (list-immutable #'struct:delayed-element
- #'make-delayed-element
- #'delayed-element?
- (list-immutable #'delayed-element-plain
- #'delayed-element-sizer
- #'delayed-element-render)
- (list-immutable #'set-delayed-element-plain!
- #'set-delayed-element-sizer!
- #'set-delayed-element-render!)
- #t))
- (define delayed-element-render (make-struct-field-accessor delayed-element-ref 0))
- (define delayed-element-sizer (make-struct-field-accessor delayed-element-ref 1))
- (define delayed-element-plain (make-struct-field-accessor delayed-element-ref 2))
- (define set-delayed-element-render! (make-struct-field-mutator delayed-element-set! 0))
- (define set-delayed-element-sizer! (make-struct-field-mutator delayed-element-set! 1))
- (define set-delayed-element-plain! (make-struct-field-mutator delayed-element-set! 2))
+ (define-struct delayed-element (resolve sizer plain)
+ #:property
+ prop:serializable
+ (make-serialize-info
+ (lambda (d)
+ (let ([ri (current-serialize-resolve-info)])
+ (unless ri
+ (error 'serialize-delayed-element
+ "current-serialize-resolve-info not set"))
+ (with-handlers ([exn:fail:contract?
+ (lambda (exn)
+ (error 'serialize-delayed-element
+ "serialization failed (wrong resolve info?); ~a"
+ (exn-message exn)))])
+ (vector
+ (make-element #f (delayed-element-content d ri))))))
+ #'deserialize-delayed-element
+ #f
+ (or (current-load-relative-directory) (current-directory))))
+
(provide/contract
- (struct delayed-element ([render (any/c part? any/c . -> . list?)]
+ (struct delayed-element ([resolve (any/c part? resolve-info? . -> . list?)]
[sizer (-> any)]
[plain (-> any)])))
@@ -136,12 +171,90 @@
(define deserialize-delayed-element
(make-deserialize-info values values))
- (provide force-delayed-element)
- (define (force-delayed-element d renderer sec ht)
- (or (delayed-element-ref d 3)
- (let ([v ((delayed-element-ref d 0) renderer sec ht)])
- (delayed-element-set! d 3 v)
- v)))
+ (provide delayed-element-content)
+ (define (delayed-element-content e ri)
+ (hash-table-get (resolve-info-delays ri) e))
+
+ (provide delayed-flow-element-flow-elements)
+ (define (delayed-flow-element-flow-elements p ri)
+ (hash-table-get (resolve-info-delays ri) p))
+
+ (provide current-serialize-resolve-info)
+ (define current-serialize-resolve-info (make-parameter #f))
+
+ ;; ----------------------------------------
+
+ (define-struct (collect-element element) (collect)
+ #:property
+ prop:serializable
+ (make-serialize-info
+ (lambda (d)
+ (vector (collect-element-collect d)))
+ #'deserialize-collect-element
+ #f
+ (or (current-load-relative-directory) (current-directory))))
+
+ (provide deserialize-collect-element)
+ (define deserialize-collect-element
+ (make-deserialize-info values values))
+
+ (provide/contract
+ [struct collect-element ([style any/c]
+ [content list?]
+ [collect (collect-info? . -> . any)])])
+
+ ;; ----------------------------------------
+
+ (define-struct generated-tag ()
+ #:property
+ prop:serializable
+ (make-serialize-info
+ (lambda (g)
+ (let ([ri (current-serialize-resolve-info)])
+ (unless ri
+ (error 'serialize-generated-tag
+ "current-serialize-resolve-info not set"))
+ (let ([t (hash-table-get (collect-info-tags
+ (resolve-info-ci ri))
+ g
+ #f)])
+ (if t
+ (vector t)
+ (error 'serialize-generated-tag
+ "serialization failed (wrong resolve info?)")))))
+ #'deserialize-generated-tag
+ #f
+ (or (current-load-relative-directory) (current-directory))))
+
+ (provide
+ (struct generated-tag ()))
+
+ (provide deserialize-generated-tag)
+ (define deserialize-generated-tag
+ (make-deserialize-info values values))
+
+ (provide generate-tag tag-key)
+
+ (define (generate-tag tg ci)
+ (if (generated-tag? (cadr tg))
+ (let ([t (cadr tg)])
+ (list (car tg)
+ (let ([tags (collect-info-tags ci)])
+ (or (hash-table-get tags t #f)
+ (let ([key (format "gentag:~a~a"
+ (collect-info-gen-prefix ci)
+ (hash-table-count tags))])
+ (hash-table-put! tags t key)
+ key)))))
+ tg))
+
+ (define (tag-key tg ri)
+ (if (generated-tag? (cadr tg))
+ (list (car tg)
+ (hash-table-get (collect-info-tags
+ (resolve-info-ci ri))
+ (cadr tg)))
+ tg))
;; ----------------------------------------
@@ -151,8 +264,8 @@
(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)))]))
+ [(c renderer sec ri) (c->s c (lambda (e)
+ (element->string e renderer sec ri)))]))
(define (c->s c do-elem)
(apply string-append
@@ -171,12 +284,12 @@
[(rsquo) "'"]
[(rarr) "->"]
[else (format "~s" c)])])]
- [(c renderer sec ht)
+ [(c renderer sec ri)
(cond
- [(element? c) (content->string (element-content c) renderer sec ht)]
+ [(element? c) (content->string (element-content c) renderer sec ri)]
[(delayed-element? c)
- (content->string (force-delayed-element c renderer sec ht)
- renderer sec ht)]
+ (content->string (delayed-element-content c ri)
+ renderer sec ri)]
[else (element->string c)])]))
;; ----------------------------------------
@@ -226,5 +339,14 @@
;; ----------------------------------------
+ (provide part-style?)
+
+ (define (part-style? p s)
+ (let ([st (part-style p)])
+ (or (eq? s st)
+ (and (list? st) (memq s st)))))
+
+ ;; ----------------------------------------
+
)
diff --git a/collects/scribblings/scribble/basic.scrbl b/collects/scribblings/scribble/basic.scrbl
@@ -96,6 +96,11 @@ removed.}
@scheme[pre-flow] list is parsed with @scheme[decode-flow].
}
+@defproc[(item? [v any/c]) boolean?]{
+
+Returns @scheme[#t] if @scheme[v] is an item produced by
+@scheme[item], @scheme[#f] otherwise.}
+
@defform[(include-section module-path)]{ Requires @scheme[module-path]
and returns its @scheme[doc] export (without making any imports
visible to the enclosing context). Since this form expands to
diff --git a/collects/scribblings/scribble/decode.scrbl b/collects/scribblings/scribble/decode.scrbl
@@ -5,7 +5,7 @@
@title[#:tag "decode"]{Text Decoder}
The @file{decode.ss} library helps you write document content in a
-natural way---more like plain text, except for @elem["@"] escapes.
+natural way---more like plain text, except for @litchar["@"] escapes.
Roughly, it processes a stream of strings to produces instances of the
@file{struct.ss} datatypes (see @secref["struct"]).
@@ -34,24 +34,26 @@ special text conversions:
Decodes a document, producing a part. In @scheme[lst], instances of
@scheme[splice] are inlined into the list. An instance of
@scheme[title-decl] supplies the title for the part. Instances of
-@scheme[index-section-decl] (that preceed any sub-part) add index
-entries that point to the section. Instances of @scheme[part-start] at
-level 0 trigger sub-part parsing. Instances of @scheme[section]
-trigger are used as-is as subsections, and instances of
-@scheme[paragraph] and other flow-element datatypes are used as-is in
-the enclosing flow.
+@scheme[part-index-decl] (that precede any sub-part) add index entries
+that point to the section. Instances of @scheme[part-collect-decl] add
+elements to the part that are used only during the @techlink{collect
+pass}. Instances of @scheme[part-start] at level 0 trigger sub-part
+parsing. Instances of @scheme[section] trigger are used as-is as
+subsections, and instances of @scheme[paragraph] and other
+flow-element datatypes are used as-is in the enclosing flow.
}
@defproc[(decode-part [lst list?]
- [tag string?]
+ [tags (listof string?)]
[title (or/c false/c list?)]
[depth excat-nonnegative-integer?])
part?]{
-Like @scheme[decode], but given a tag for the section, a title (if
-@scheme[#f], then a @scheme[title-decl] instance is used if found),
-and a depth for @scheme[part-start]s to trigger sub-part parsing.
+Like @scheme[decode], but given a list of tag string for the part, a
+title (if @scheme[#f], then a @scheme[title-decl] instance is used if
+found), and a depth for @scheme[part-start]s to trigger sub-part
+parsing.
}
@@ -90,28 +92,41 @@ otherwise.
}
-@defstruct[title-decl ([tag any/c]
+@defstruct[title-decl ([tag-prefix (or/c false/c string?)]
+ [tags (listof string?)]
+ [style any/c]
[content list?])]{
-See @scheme[decode] and @scheme[decode-part].
+See @scheme[decode] and @scheme[decode-part]. The @scheme[tag-prefix]
+and @scheme[style] fields are propagated to the resulting
+@scheme[part].
}
@defstruct[part-start ([depth integer?]
- [tag (or/c false/c string?)]
+ [tag-prefix (or/c false/c string?)]
+ [tags (listof string?)]
+ [style any/c]
[title list?])]{
-See @scheme[decode] and @scheme[decode-part].
+Like @scheme[title-decl], but for a sub-part. See @scheme[decode] and
+@scheme[decode-part].
}
@defstruct[part-index-decl ([plain-seq (listof string?)]
- [content-seq list?])]{
+ [entry-seq list?])]{
See @scheme[decode]. The two fields are as for @scheme[index-element].
}
+@defstruct[part-collect-decl ([element element?])]{
+
+See @scheme[decode].
+
+}
+
@defstruct[splice ([run list?])]{
See @scheme[decode], @scheme[decode-part], and @scheme[decode-flow].
diff --git a/collects/scribblings/scribble/how-to.scrbl b/collects/scribblings/scribble/how-to.scrbl
@@ -0,0 +1,474 @@
+#reader(lib "docreader.ss" "scribble")
+@require[(lib "manual.ss" "scribble")
+ (lib "bnf.ss" "scribble")]
+@require["utils.ss"]
+
+@title{How to Scribble Documentation}
+
+@;----------------------------------------
+@section[#:tag "getting-started"]{Getting Started}
+
+To document a collection or @|PLaneT| package:
+
+@itemize{
+
+ @item{Create a file in your collection or planet package with the
+ file extension @file{.scrbl}. The remainder of these
+ instructions assume that the file is called @file{manual.scrbl}.}
+
+ @item{Start @file{manual.scrbl} like this:
+@verbatim[#<<EOS
+ #reader(lib "docreader.ss" "scribble")
+ @begin[(require (lib "manual.ss" "scribble"))]
+
+ @title{My Library}
+
+ Welcome to my documentation: @scheme[(list 'testing 1 2 3)].
+EOS
+]
+
+ The first line starts the file in ``text'' mode, and
+ introduces the @litchar["@"] syntax to use Scheme bindings.
+ The second line introduces bindings like @scheme[title] and
+ @scheme[scheme] for writing PLT Scheme documentation. The
+ @scheme[title] call (using @litchar["@"]) produces a title
+ declaration in the text stream.}
+
+ @item{Add the following entry to your collect or package's
+ @file{info.ss}:
+
+ @schemeblock[
+ (define scribblings '(("manual.scrbl" ())))
+ ]
+
+ The @scheme[()] above is a list of options. When your document
+ gets large enough that you want it split into multiple pages,
+ add the @scheme['multi-page] option (omitting the quote, since
+ the whole right-hand side of the definition is already
+ quoted).}
+
+ @item{Run @exec{setup-plt} to build your documentation. For a
+ collection, optionally supply @Flag{l} followed by the
+ collection name to limit the build process to the collection.}
+
+ @item{The generated documentation is
+ @file{compiled/doc/manual/index.html} within the collection or
+ @|PLaneT| package directory.}
+
+}
+
+@; ----------------------------------------
+@section{Document Syntax}
+
+Whether in ``text'' mode or Scheme mode, @litchar["@"] in a document
+provides an escape to Scheme mode. The syntax of @litchar["@"] is
+
+@schemeblock[
+ #, @BNF-seq[@litchar["@"]
+ @nonterm{cmd}
+ @litchar{[} @kleenestar{@nonterm{datum}} @litchar{]}
+ @litchar["{"] @nonterm{text-body} @litchar["}"]]
+]
+
+where all three parts after @litchar["@"] are optional, but at least
+one must be present. No spaces are allowed between
+
+@itemize{
+
+ @item{@litchar["@"] and @nonterm{cmd}, @litchar["["], or @litchar["{"]}
+
+ @item{@nonterm{cmd} and @litchar["["] or @litchar["{"]; or}
+
+ @item{@litchar["]"] and @litchar["{"].}
+
+}
+
+A @nonterm{cmd} or @nonterm{datum} is a Scheme datum, while a
+@nonterm{text-body} is itself in text mode.
+
+The expansion of a @litchar["@"] form into Scheme code is
+
+@schemeblock[
+ (#, @nonterm{cmd} #, @kleenestar{@nonterm{datum}} #, @kleenestar{@nonterm{parsed-body}})
+]
+
+where @kleenestar{@nonterm{parsed-body}} is the parse result of the
+@nonterm{text-body}. It often turns out to be a sequence of Scheme
+strings.
+
+In practice, the @nonterm{cmd} is normally a Scheme identifier that is
+bound to a procedure or syntactic form. If the procedure or form
+expects further text to typeset, then @litchar["{"] @litchar["}"]
+supplies the text. If the form expects other data, typically
+@litchar["["] @litchar["]"] is used to surround Scheme arguments,
+instead. Sometimes, both @litchar["["] @litchar["]"] and @litchar["{"]
+@litchar["}"] are used, where the former surround Scheme arguments
+that precede text to typeset.
+
+Thus,
+
+@verbatim[#<<EOS
+ @title{My Library}
+ @scheme[(list 'testing 1 2 3)]
+ @section[#:tag "here"]{You Are Here}
+EOS
+]
+
+means
+
+@schemeblock[
+(title "My Library")
+(scheme (list 'testing 1 2 3))
+(section #:tag "here" "You Are Here")
+]
+
+For more information on the syntax of @litchar["@"], see
+@secref["reader"].
+
+In a document that starts @tt{#reader(lib "docreader.ss" "scribble")},
+the top level is a text-mode sequence. The parsed sequence is further
+decoded to turn it into a hierarchy of sections and paragraphs. For
+example, a linear sequence of @scheme[section] declarations with
+interleaved text is turned into a list of @scheme[part] instances with
+all text assigned to a particular part. See @secref["decode"] for more
+information on the decoding process.
+
+@; ----------------------------------------
+@section[#:tag "scheme-hyperlinks"]{Scheme Typesetting and Hyperlinks}
+
+With the document source in @secref["getting-started"], the Scheme
+expression @scheme[(#,(schemeidfont "list") 'testing 1 2 3)] is
+typeset properly, but the @schemeidfont{list} identifier is not
+hyperlinked to the usual definition. To cause @schemeidfont{list} to
+be hyperlinked, add the following to the @tt["@begin"] body:
+
+@schemeblock[
+(require-for-label (lib "big.ss" "lang"))
+]
+
+This @scheme[require-for-label] declaration introduces a document-time
+binding for each export of the @scheme[(lib "big.ss" "lang")]
+module. When the document is built, the @scheme[scheme] form detects
+the binding for @scheme[list], and so it generates a reference to the
+specification of @scheme[list]. The setup process detects the
+reference, and it finds the matching specification in the existing
+documentation, and it ultimately directs the hyperlink to that
+specification.
+
+Hyperlinks based on @scheme[require-for-label] and @scheme[scheme] are
+the preferred mechanism for linking to information outside of a single
+document. Such links require no information about where and how a
+binding is documented elsewhere:
+
+@verbatim[#<<EOS
+ #reader(lib "docreader.ss" "scribble")
+ @begin[(require (lib "manual.ss" "scribble"))
+ (require-for-label (lib "lang.ss" "big"))]
+
+ @title{My Library}
+
+ See also @scheme[list].
+EOS
+]
+
+The @scheme[scheme] form typesets a Scheme expression for inline text,
+so it ignores the source formatting of the expression. The
+@scheme[schemeblock] form, in contrast, typesets inset Scheme code,
+and it preserves the expression's formatting from the document source.
+
+@verbatim[#<<EOS
+ #reader(lib "docreader.ss" "scribble")
+ @begin[(require (lib "manual.ss" "scribble"))
+ (require-for-label (lib "lang.ss" "big"))]
+
+ @title{My Library}
+
+ Some example Scheme code:
+
+ @schemeblock[
+ (define (nobody-understands-me what)
+ (list "When I think of all the"
+ what
+ "I've tried so hard to explain!"))
+ (nobody-understands-me "glorble snop")
+ ]
+EOS
+]
+
+
+@; ----------------------------------------
+@section[#:tag "section-hyperlinks"]{Section Hyperlinks}
+
+A @scheme[section] declaration in a document can include a
+@scheme[#:tag] argument that declares a hyperlink-target tag. The
+@scheme[secref] function generates a hyperlink, using the section name
+as the text of the hyperlink. Use @scheme[seclink] to create a
+hyperlink with text other than the section title.
+
+The following example illustrates section hyperlinks:
+
+@verbatim[#<<EOS
+ #reader(lib "docreader.ss" "scribble")
+ @begin[(require (lib "manual.ss" "scribble"))
+ (require-for-label (lib "lang.ss" "big"))]
+
+
+ @title{My Library}
+
+ Welcome to my documentation: @scheme[(list 'testing 1 2 3)].
+
+ @table-of-contents[]
+
+
+ @section[#:tag "chickens"]{Philadelphia Chickens}
+
+ Dancing tonight!
+
+
+ @section{Reprise}
+
+ See @secref{chickens}.
+EOS
+]
+
+Since the page is so short, it the hyperlinks are more effective if
+ you change the @file{info.ss} file to add the @scheme['multi-file]
+ flag:
+
+@schemeblock[
+(define scribblings '(("manual.scrbl" (multi-page))))
+]
+
+A section can have a @techlink{tag prefix} that applies to all tags as
+seen from outside the section. Such a prefix is automatically given to
+each top-level document as processed by @exec{setup-plt}. Thus,
+referencing a section tag in a different document requires using a
+prefix, which is based on the target document's main source file. The
+following example links to a section in the PLT Scheme reference
+manual:
+
+@verbatim[#<<EOS
+ #reader(lib "docreader.ss" "scribble")
+ @begin[(require (lib "manual.ss" "scribble"))
+ (require-for-label (lib "lang.ss" "big"))
+ (define ref-src
+ '(lib "reference.scrbl" "scribblings" "reference"))]
+
+ @title{My Library}
+
+ See also @italic{@secref[#:doc reference-src]{pairs}}.
+EOS
+]
+
+As mentioned in @secref{scheme-hyperlinks}, however, cross-document
+references based on @scheme[require-for-label] and @scheme[scheme] are
+usually better than to cross-document references using
+@scheme[secref].
+
+@; ----------------------------------------
+@section{Defining Scheme Bindings}
+
+Use @scheme[defproc] to document a procedure, @scheme[defform] to
+document a syntactic form, @scheme[defstruct] to document a structure
+type, etc. These forms provide consistent formatting of definitions,
+and they declare hyperlink targets for @scheme[scheme]-based
+hyperlinks.
+
+To document a @scheme[my-helper] procedure that is exported by
+@file{helper.ss} in the collection that contains @file{manual.scrbl},
+first use @scheme[require-for-label] to import the binding information
+of @file{helper.ss}. Then use @scheme[defproc] to document the
+procedure:
+
+@verbatim[#<<EOS
+ #reader(lib "docreader.ss" "scribble")
+ @begin[(require (lib "manual.ss" "scribble"))
+ (require-for-label (lib "lang.ss" "big")
+ "helper.ss")]
+
+ @title{My Library}
+
+ @defproc[(my-helper [lst list?])
+ (listof
+ (not/c (one-of/c 'cow)))]{
+
+ Replaces each @scheme['cow] in @scheme[lst] with
+ @scheme['aardvark].}
+EOS
+]
+
+In @scheme[defproc], a contract is specified with each argument to the
+procedure. In this example, the contract for the @scheme[_lst]
+argument is @scheme[list?], which is the contract for a list. After
+the closing parenthesis that ends the argument sequence, the contract
+of the result must be given; in this case, @scheme[my-helper]
+guarantees a result that is a list where none of the elements are
+@scheme['cow].
+
+Some things to notice in this example and the documentation that it
+generates:
+
+@itemize{
+
+ @item{The @scheme[list?], @scheme[listof], @|etc| elements of
+ contracts are hyperlinked to their documentation.}
+
+ @item{The result contract is formatted in the generated documentation
+ in the same way as in the source. That is, the source layout of
+ contracts is preserved. (In this case, putting the contract all
+ on one line would be better.)}
+
+ @item{In the prose that documents @scheme[my-helper], @scheme[_lst]
+ is automatically typeset in italic, matching the typesetting in
+ the blue box. The @scheme[scheme] form essentially knows that
+ it's used in the scope of a procedure with argument
+ @scheme[_lst].}
+
+ @item{If you use @scheme[my-helper] in any documentation now, as long
+ as that documentation source also has a
+ @scheme[require-for-label] of @file{my-helper.ss}, then the
+ reference is hyperlinked to the definition above.}
+
+}
+
+See @scheme[defproc*], @scheme[defform], @|etc| for more information
+on forms to document Scheme bindings.
+
+@; ----------------------------------------
+@section{Showing Scheme Examples}
+
+The @scheme[examples] form from @scheme[(lib "eval.ss" "scribble")]
+helps you generate examples in your documentation. @bold{Warning:} the
+@scheme[examples] form is especially likely to change or be replaced.
+
+To use @scheme[examples], the procedures to document must be suitable
+for use at documentation time; in fact, @scheme[examples] uses
+bindings introduced into the document source by
+@scheme[require]. Thus, to generate examples using @scheme[my-helper]
+from the previous section, then @file{helper.ss} must be imported both
+via @scheme[require-for-label] and @scheme[require]:
+
+@verbatim[#<<EOS
+ #reader(lib "docreader.ss" "scribble")
+ @begin[(require (lib "manual.ss" "scribble")
+ (lib "eval.ss" "scribble") ; <--- added
+ "helper.ss") ; <--- added
+ (require-for-label (lib "lang.ss" "big")
+ "helper.ss")]
+
+ @title{My Library}
+
+ @defproc[(my-helper [lst list?])
+ (listof (not/c (one-of/c 'cow)))]{
+
+ Replaces each @scheme['cow] in @scheme[lst] with
+ @scheme['aardvark].
+
+ @examples[
+ (my-helper '())
+ (my-helper '(cows such remarkable cows))
+ ]}
+EOS
+]
+
+@;----------------------------------------
+@section{Splitting the Document Source}
+
+In general, a @file{.scrbl} file produces a @techlink{part}. A part
+produced by a document's main source (as specified in the
+@scheme{info.ss} file) represents the whole document. The
+@scheme[include-section] procedure can be used to incorporate a part
+as a sub-part of the enclosing part.
+
+In @file{manual.scrbl}:
+
+@verbatim[#<<EOS
+ #reader(lib "docreader.ss" "scribble")
+ @begin[(require (lib "manual.ss" "scribble"))]
+
+ @title{My Library}
+
+ @include-section["cows.scrbl"]
+ @include-section["aardvarks.scrbl"]
+EOS
+]
+
+In @file{cows.scrbl}:
+
+@verbatim[#<<EOS
+ #reader(lib "docreader.ss" "scribble")
+ @begin[(require (lib "manual.ss" "scribble"))]
+
+ @title{Cows}
+
+ Wherever they go, it's a quite a show.
+EOS
+]
+
+In @file{aardvarks.scrbl}:
+
+@verbatim[#<<EOS
+ #reader(lib "docreader.ss" "scribble")
+ @begin[(require (lib "manual.ss" "scribble"))
+ (require-for-label (lib "lang.ss" "big")
+ "helper.ss")]
+
+ @title{Aardvarks}
+
+ @defproc[(my-helper [lst list?])
+ (listof (not/c (one-of/c 'cow)))]{
+
+ Replaces each @scheme['cow] in @scheme[lst] with
+ @scheme['aardvark].}
+EOS
+]
+
+
+@;----------------------------------------
+@section{Multi-Page Sections}
+
+Setting the @scheme['multi-page] option (see
+@secref["section-hyperlinks"]) causes each top-level section of a
+document to be rendered as a separate HTML page.
+
+To push sub-sections onto separate pages, use the @scheme['toc] style
+for the enclosing section (as started by @scheme[title],
+@scheme[section], @scheme[subsection], etc.) and use
+@scheme[local-table-of-contents] to generate hyperlinks to the
+sub-sections.
+
+Revising @file{cows.scrbl} from the previous section:
+
+@verbatim[#<<EOS
+ #reader(lib "docreader.ss" "scribble")
+ @begin[(require (lib "manual.ss" "scribble"))]
+
+ @title[#:style '(toc)]{Cows}
+
+ @local-table-of-contents[]
+
+ @section[#:tag "singing"]{Singing}
+ Wherever they go, it's a quite a show.
+
+ @section{Dancing}
+ See @secref["singing"].
+EOS
+]
+
+To run this example, remember to change @file{info.ss} to add the
+@scheme['multi-page] style. You may also want to add a call to
+@scheme[table-of-contents] in @file{manual.scrbl}.
+
+The difference between @scheme[table-of-contents] and
+@scheme[local-table-of-contents] is that the latter is ignored for
+Latex output.
+
+When using @scheme[local-table-of-contents], often it makes sense to
+include introductory text before the call of
+@scheme[local-table-of-contents]. When the introductory text is less
+important and when when local table of contents is short, putting the
+introductory text after the call of @scheme[local-table-of-contents]
+make be appropriate.
+
+@;----------------------------------------
+@include-section["style.scrbl"]
diff --git a/collects/scribblings/scribble/info.ss b/collects/scribblings/scribble/info.ss
@@ -0,0 +1,3 @@
+(module info (lib "infotab.ss" "setup")
+ (define name "Scribblings: Scribble")
+ (define scribblings '(("scribble.scrbl" (multi-page main-doc)))))
diff --git a/collects/scribblings/scribble/manual.scrbl b/collects/scribblings/scribble/manual.scrbl
@@ -57,7 +57,7 @@ produces
]
The @scheme[unsyntax] form is regonized via
-@scheme[module-identifier=?], so if you want to typeset code that
+@scheme[free-identifier=?], so if you want to typeset code that
includes @scheme[unsyntax], you can simply hide the usual binding:
@SCHEMEBLOCK[
@@ -68,8 +68,7 @@ includes @scheme[unsyntax], you can simply hide the usual binding:
]
Or use @scheme[SCHEMEBLOCK], whose escape form is @scheme[UNSYNTAX]
-instead of @scheme[unsyntax]. See also @scheme[define-code] from
-@file{scheme.ss}.
+instead of @scheme[unsyntax].
A few other escapes are recognized symbolically:
@@ -546,5 +545,5 @@ centered table with the @scheme[pre-flow] parsed by
@defproc[(commandline [pre-content any/c] ...) paragraph?]{Produces
an inset command-line example (e.g., in typewriter font).}
-@defproc[(margin-code [pre-content any/c] ...) paragraph?]{Produces
+@defproc[(margin-note [pre-content any/c] ...) paragraph?]{Produces
a paragraph to be typeset in the margin instead of inlined.}
diff --git a/collects/scribblings/scribble/reader.scrbl b/collects/scribblings/scribble/reader.scrbl
@@ -721,9 +721,19 @@ an example of this.
@;--------------------------------------------------------------------
@section{Interface}
-The @file{reader.ss} module provides very little functionality for
-advanced needs.
+The @file{reader.ss} module provides functionality for advanced needs.
+@; The `with-scribble-read' trick below shadows `read' and
+@; `read-syntax' with for-label bindings from the Scribble reader
+
+@define-syntax[with-scribble-read
+ (syntax-rules ()
+ [(_)
+ (...
+ (begin
+ (require-for-label (lib "reader.ss" "scribble"))
+
+@; *** Start reader-import section ***
@defproc[(read [in input-port? (current-input-port)]) any]{}
@defproc[(read-syntax [source-name any/c (object-name in)]
[in input-port? (current-input-port)])
@@ -807,3 +817,8 @@ Installs the Scribble readtable as the default. Useful for REPL
experimentation. (Note: enables line and column tracking.) The given
keyword arguments are used with `make-at-readtable'.
}
+
+@; *** End reader-import section ***
+))])]
+@with-scribble-read[]
+
+\ No newline at end of file
diff --git a/collects/scribblings/scribble/renderer.scrbl b/collects/scribblings/scribble/renderer.scrbl
@@ -1,6 +1,7 @@
#reader(lib "docreader.ss" "scribble")
@require[(lib "manual.ss" "scribble")]
@require["utils.ss"]
+@require-for-label[(lib "class.ss")]
@title[#:tag "renderer"]{Renderer}
@@ -29,3 +30,56 @@ See @file{base-render.ss} for more information about the methods of
the renderer. Documents built with higher layers, such as
@file{manual.ss}, generally do not call the render object's methods
directly.
+
+@defclass[render% object% ()]{
+
+Represents a renderer.
+
+@defconstructor[([dest-dir path-string?])]{
+
+Creates a renderer whose output goes to @scheme[dest-dir].
+
+}
+
+
+@defmethod[(collect [srcs (listof path-string?)]
+ [dests (listof path-string?)])
+ collect-info?]{
+
+
+}
+
+@defmethod[(resolve [srcs (listof path-string?)]
+ [dests (listof path-string?)]
+ [ci collect-info?])
+ resolve-info?]{
+
+
+}
+
+@defmethod[(render [srcs (listof path-string?)]
+ [dests (listof path-string?)]
+ [ri resolve-info?])
+ void?]{
+
+
+}
+
+@defmethod[(serialize-info [ri resolve-info?])
+ any/c]{
+
+Serializes the collected info in @scheme[ri].
+
+}
+
+@defmethod[(deserialize-info [v any/c]
+ [ci collect-info?])
+ void?]{
+
+Adds the deserialized form of @scheme[v] to @scheme[ci].
+
+}
+
+}
+
+@include-class[render%]
diff --git a/collects/scribblings/scribble/scribble.scrbl b/collects/scribblings/scribble/scribble.scrbl
@@ -3,7 +3,8 @@
@require[(lib "bnf.ss" "scribble")]
@require["utils.ss"]
-@title{PLT Scribble}
+@title[#:tag-prefix '(lib "scribble.scrbl" "scribblings" "scribble")
+ #:tag "top"]{PLT Scribble}
The @file{scribble} collection provides libraries that can be used to
create documents from Scheme.
@@ -11,6 +12,9 @@ create documents from Scheme.
@table-of-contents[]
@; ------------------------------------------------------------------------
+@include-section["how-to.scrbl"]
+
+@; ------------------------------------------------------------------------
@section{Scribble Layers}
Scribble is made of independently usable parts. For example, the
@@ -26,23 +30,24 @@ The layers are:
with @"@"-forms for conveniently embedding a mixin of text and
escapes. See @secref["reader"].}
- @item{@file{struct.ss}: a set of document datatypes, which define the
- basic layout of a document. See @secref["struct"].}
+ @item{@file{struct.ss}: a set of document datatypes and utilities
+ that define the basic layout and processing of a document. See
+ @secref["struct"].}
@item{@file{base-render.ss} with @file{html-render.ss},
@file{latex-render.ss}, or @file{text-render.ss}: A base
renderer and mixins that generate documents in various formats
- from instances of the @file{struct.ss} datatype. See
+ from instances of the @file{struct.ss} datatypes. See
@secref["renderer"].}
@item{@file{decode.ss}: Processes a stream of text, section-start
markers, etc. to produce instances of the @file{struct.ss}
- datatype. See @secref["decode"].}
+ datatypes. See @secref["decode"].}
@item{@file{doclang.ss}: to be used for the initial import of a
module; processes the module top level through
@file{decode.ss}, and otherwise provides all of
- @scheme[mzscheme]. See @secref["doclang"].}
+ @schememodname[big]. See @secref["doclang"].}
@item{@file{docreader.ss}: a reader that is meant to tbe used to
process an entire file; it essentially combines
@@ -88,4 +93,3 @@ information.
@include-section["basic.scrbl"]
@include-section["manual.scrbl"]
@include-section["eval.scrbl"]
-@include-section["style.scrbl"]
diff --git a/collects/scribblings/scribble/struct.scrbl b/collects/scribblings/scribble/struct.scrbl
@@ -2,50 +2,66 @@
@require[(lib "manual.ss" "scribble")]
@require["utils.ss"]
-@title[#:tag "struct"]{Document Structures}
-
-A single document is represented as a @defterm{part}:
+@title[#:tag "struct"]{Document Structures And Processing}
+
+A document is represented as a @techlink{part}, as described in
+ @secref["parts"]. This representation is intended to
+ independent of its eventual rendering, and it is intended to be
+ immutable; rendering extensions and specific data in a document can
+ collude arbitrarily, however.
+
+A document is processed in three passes. The first pass is the
+ @deftech{collect pass}, which globally collects information in the
+ document, such as targets for hyperlinking. The second pass is the
+ @deftech{resolve pass}, which matches hyperlink references with
+ targets and expands delayed elements (where the expansion should not
+ contribute new hyperlink targets). The final pass is the
+ @deftech{render pass}, which generates the resulting document. None
+ of the passes mutate the document, but instead collect information in
+ side @scheme[collect-info] and @scheme[resolve-info] tables.
+
+@; ------------------------------------------------------------------------
+
+@section[#:tag "parts"]{Parts}
+
+A @deftech{part} is an instance of @scheme[part]; among other things,
+ it has a title @techlink{content}, an initial @techlink{flow}, and a
+ list of subsection @techlink{parts}. An @scheme[unnumbered-part] is
+ the same as a @scheme[part], but it isn't numbered. There's no
+ difference between a part and a full document; a particular source
+ module just as easily defines a subsection (incorporated via
+ @scheme[include-section]) as a document.
+
+A @deftech{flow} is an instance of @scheme[flow]; it has a list of
+ @techlink{flow elements}.
+
+A @deftech{flow element} is either a @techlink{table}, an
+ @techlink{itemization}, @techlink{blockquote}, @techlink{paragraph},
+ or a @techlink{delayed flow element}.
@itemize{
- @item{A @defterm{part} is an instance of @scheme[part]; it has a list
- of @defterm{tags} used as link targets, a title
- @defterm{content}, a list of @defterm{elements} that supply
- information during the ``collect'' phase but are not rendered,
- an initial @defterm{flow}, and a list of subsection
- @defterm{part}s. After the ``collect'' phase of rendering, it
- also has @defterm{collected info}. A @scheme[styled-part]
- includes an extra style flag. An @scheme[unnumbered-part] is
- the same as a @scheme[styled-part], but it isn't numbered.}
-
- @item{A @defterm{flow} is an instance of @scheme[flow]; it has a list
- of @defterm{flow element}s.}
-
- @item{A @defterm{flow element} is either a @defterm{table}, an
- @defterm{itemization}, @defterm{blockquote}, @defterm{paragraph}, or a
- @defterm{delayed flow element}.
+ @item{A @deftech{table} is an instance of @scheme[table]; it
+ has a list of list of @techlink{flows} with a particular
+ style. In Latex output, each table cell is typeset as a
+ single line.}
- @itemize{
+ @item{A @deftech{itemization} is an instance of @scheme[itemization];
+ it has a list of @techlink{flows}.}
- @item{A @defterm{table} is an instance of @scheme[table]; it has a
- list of list of @defterm{flow}s with a particular style.}
-
- @item{A @defterm{itemization} is an instance of @scheme[itemization];
- it has a list of flows.}
-
- @item{A @defterm{blockquote} is an instance of
+ @item{A @deftech{blockquote} is an instance of
@scheme[blockquote]; it has list of flow elements that
are indented according to a specified style.}
- @item{A @defterm{paragraph} is an instance of @scheme[paragraph]; it
- has a list of @defterm{element}s.
+ @item{A @deftech{paragraph} is an instance of
+ @scheme[paragraph]; it has a @deftech{content}, which is
+ a list of @techlink{elements}:
@itemize{
- @item{An element can be a string, one of a few symbols, an instance of
- @scheme[element] (possibly @scheme[link-element],
- @scheme[target-element], or
- @scheme[index-element]), a @defterm{delayed
+ @item{An @deftech{element} can be a string, one of a few
+ symbols, an instance of @scheme[element] (possibly
+ @scheme[link-element], etc.), a @techlink{delayed
element}, or anything else allowed by the current
renderer.
@@ -66,26 +82,21 @@ A single document is represented as a @defterm{part}:
@scheme['ndash], @scheme['ldquo],
@scheme['lsquo], @scheme['rsquo],
@scheme['rarr], or @scheme['prime]; it is
- drawn as the corresponding HTML entity.}
+ rendered as the corresponding HTML entity
+ (even for Latex output).}
@item{An instance of @scheme[element] has a list of
- @defterm{element}s plus a style. The style's
- interpretation depends on the rendrer; it can
- be one of a few special symbols that are
- recognized by all renderers: @scheme['tt],
- @scheme['italic], @scheme['bold],
- @scheme['sf], @scheme['subscript],
- @scheme['superscript], or @scheme['hspace].
- A string corresponds to a CSS class, LaTeX
- macro, or something else renderer-specific.
- Instances of @scheme[target-url] and
- @scheme[image-file] may also be supported.}
+ @techlink{elements} plus a style. The style's
+ interpretation depends on the rendrer, but it
+ can be one of a few special symbols (such as
+ @scheme['bold]) that are recognized by all
+ renderers.}
@item{An instance of @scheme[link-element] has a
- @defterm{tag} for the target of the link.}
+ @techlink{tag} for the target of the link.}
@item{An instance of @scheme[target-element] has a
- @defterm{tag} to be referenced by
+ @techlink{tag} to be referenced by
@scheme[link-element]s. An instance of the
subtype @scheme[toc-target-element] is
treated like a kind of section label, to be
@@ -93,16 +104,23 @@ A single document is represented as a @defterm{part}:
output.}
@item{An instance of @scheme[index-element] has a
- @defterm{tag} (as a target), a list of
+ @techlink{tag} (as a target), a list of
strings for the keywords (for sorting and
- search), and a list of @defterm{element}s to
+ search), and a list of @techlink{elements} to
appear in the end-of-document index.}
- @item{A @defterm{delayed element} is an instance of
+ @item{An instance of @scheme[collect-element] has a
+ procedure that is called in the
+ @techlink{collect pass} of document
+ processing to record information used by
+ later passes.}
+
+ @item{A @deftech{delayed element} is an instance of
@scheme[delayed-element], which has a
- procedure that produces a
- @defterm{element}. The ``collect'' phase of
- rendering ignores delayed flow elements.}
+ procedure that is called in the
+ @techlink{resolve pass} of document
+ processing to obtain @defterm{content} (i.e.,
+ a list of @defterm{elements}).}
@item{An instance of @scheme[aux-element] is
excluded in the text of a link when it
@@ -110,43 +128,99 @@ A single document is represented as a @defterm{part}:
}}}}
- @item{A @defterm{delayed flow element} is an instance of
+ @item{A @deftech{delayed flow element} is an instance of
@scheme[delayed-flow-element], which has a procedure that
- produces a @defterm{flow element}. The ``collect'' phase
- of rendering ignores delayed flow elements.}
-
- }}
-
- @item{The @defterm{collected info} of a part includes its number, its
- parent part (or @scheme[#f]), and information about link
- targets and index entries within the part.}
-
- @item{A @defterm{tag} is eiter a string or a list containing a symbol
- and a string.}
+ is called in the @techlink{resolve pass} of document
+ processing to obtain a @defterm{flow element}.}
}
-Note that there's no difference between a part and a full document. A
-particular source module just as easily defines a subsection
-(incoprated via @scheme[include-section]) as a document.
-
-@defstruct[part ([tags (listof tag?)]
+@; ------------------------------------------------------------------------
+
+@section[#:tag "tags"]{Tags}
+
+A @deftech{tag} is a list containing a symbol and a string. The symbol
+ effectively identifies the type of the tag, such as @scheme['part]
+ for a tag that links to a part, or @scheme['def] for a Scheme
+ function definition.
+
+A section can have a @deftech{tag prefix}, which is effectively
+ prefixed onto the string part of each @scheme['part] and
+ @scheme['tech] tag within the part for reference outside the part,
+ including the tags in the @scheme[tags] field. Typically, a
+ document's main part has a tag prefix that applies to the whole
+ document; references to sections and defined terms within the
+ document from other documents must include the prefix plus a
+ separating @litchar{:}, while references within the same document
+ omit the prefix. Part prefixes can be used within a document as well,
+ to help disambiguate references within the document.
+
+Some procedures accept a ``tag'' that is just the string part of the
+ full tag, where the symbol part is supplied automatically. For
+ example, @scheme[section] and @scheme[secref] both accept a string
+ ``tag'', where @scheme['part] is implicit.
+
+@; ------------------------------------------------------------------------
+
+@section[#:tag "passes"]{Collected and Resolved Information}
+
+The @techlink{collect pass}, @techlink{resolve pass}, and
+@techlink{render pass} processing steps all produce information that
+is specific to a rendering mode. Concretely, the operations are all
+represented as methods on a @scheme[render%] object.
+
+The result of the @method[render% collect] method is a
+@scheme[collect-info] instance. This result is provided back as an
+argument to the @method[render% resolve] method, which produces a
+@scheme[resolve-info] value that encapsulates the results from both
+iterations. The @scheme[resolve-info] value is provided back to the
+@method[render% resolve] method for final rendering.
+
+Optionally, before the @method[render% resolve] method is called,
+serialized information from other documents can be folded into the
+@scheme[collect-info] instance via the @method[render%
+deserialize-info] method. Other methods provide serialized information
+out of the collected and resolved records.
+
+During the @techlink{collect pass}, the procedure associated with a
+@scheme[collect-element] instance can register information with
+@scheme[collect-put!].
+
+During the @techlink{resolve pass}, collected information for a part
+can be extracted with @scheme[part-collected-info], which includes a
+part's number and its parent part (or @scheme[#f]). More generally,
+the @scheme[resolve-get] method looks up information previously
+collected. This resolve-time information is normally obtained by the
+procedure associated with a @techlink{delayed flow element} or
+@techlink{delayed element}.
+
+The @scheme[resolve-get] information accepts both a @scheme[part] and
+a @scheme[resolve-info] argument. The @scheme[part] argument enables
+searching for information in each enclosing part before sibling parts.
+
+@; ------------------------------------------------------------------------
+
+@section{Structure Reference}
+
+@defstruct[part ([tag-prefix (or/c false/c string?)]
+ [tags (listof tag?)]
[title-content (or/c false/c list?)]
- [collected-info (or/c false/c collected-info?)]
+ [style any/c]
[to-collect list?]
[flow flow?]
[parts (listof part?)])]{
-Each element of @scheme[tags] is actually wrapped as @scheme[`(part
-,_tag)] as a target for links; functions like @scheme[seclink]
-similarly insert the @scheme[`(part ,_tag)] wrapper.
-
-}
+The @scheme[tag-prefix] field determines the optional @techlink{tag
+prefix} for the part.
+The @scheme[tags] indicates a list of @techlink{tags} that each link
+to the section.
-@defstruct[(styled-part part) ([style any/c])]{
+The @scheme[title-content] field holds the part's title, if any.
-The currently recognized values for @scheme[style] are as follows:
+The @scheme[style] field is normally either a symbol or a list of
+symbols. The currently recognized style symbols (alone or in a list)
+are as follows:
@itemize{
@@ -155,69 +229,132 @@ The currently recognized values for @scheme[style] are as follows:
@item{@scheme['index] --- the part represents an index.}
+ @item{@scheme['reveal] --- shows sub-parts when this part is
+ displayed in a table-of-contents panel in HTML output (which
+ normally shows only the top-level sections).}
+
+ @item{@scheme['hidden] --- the part title is not shown in rendered output.}
+
}
+The @scheme[to-collect] field contains @techlink{content} that is
+inspected during the @techlink{collect pass}, but ignored in later
+passes (i.e., it doesn't directly contribute to the output).
+
+The @scheme[flow] field contains the part's initial flow (before
+sub-parts).
+
+The @scheme[parts] field contains sub-parts.
+
}
-@defstruct[(unnumbered-part styled-part) ()]{
+
+@defstruct[(unnumbered-part part) ()]{
Although a section number is computed for an ``unnumbered'' section
-during the ``collect'' phase, the number is not rendered.
+during the @techlink{collect pass}, the number is not rendered.
}
+
@defstruct[flow ([paragraphs (listof flow-element?)])]{
+A @techlink{flow} has a list of flow elements.
+
}
@defstruct[paragraph ([content list?])]{
+A @techlink{paragraph} has a list of elements.
+
}
@defstruct[(styled-paragraph paragraph) ([style any/c])]{
+
+The @scheme[style] is normally a string that corresponds to a CSS
+class for HTML output.
+
}
@defstruct[table ([style any/c]
- [flowss (listof (listof flow?))])]{
+ [flowss (listof (listof (or/c flow? (one-of/c 'cont))))])]{
+
+A @techlink{table} has, roughly, a list of list of flows. A cell in
+the table can span multiple columns by using @scheme['cont] instead of
+a flow in the following columns (i.e., for all but the first in a set
+of cells that contain a single flow).
}
-@defstruct[delayed-flow-element ([render (any/c part? any/c . -> . flow-element?)])]{
+@defstruct[itemization ([flows (listof flow?)])]{
-For the @scheme[render] procedure, the first argument corresponds to
-the rendering context, the second to the immediately enclosing
-section, and the last argument correspond to global information
-(possibly psanning multiple documents).
+A @techlink{itemization} has a list of flows.
}
+@defstruct[blockquote ([style any/c]
+ [paragraphs (listof flow-element?)])]{
-@defstruct[itemization ([flows (listof flow?)])]{
+A @techlink{blockquote} has a style and a list of flow elements. The
+@scheme[style] field is normally a string that corresponds to a CSS
+class for HTML output.
}
-@defstruct[blockquote ([style any/c]
- [flows (listof flow-element?)])]{
+@defstruct[delayed-flow-element ([resolve (any/c part? resolve-info? . -> . flow-element?)])]{
+
+The @scheme[resolve] procedure is called during the @techlink{resolve
+pass} to obtain a normal flow element. The first argument to
+@scheme[resolve] is the renderer.
}
+
@defstruct[element ([style any/c]
[content list?])]{
+The @scheme[style] field is normally either
+
+@itemize{
+
+ @item{a string, which corresponds to a CSS class for HTML output;}
+
+ @item{one of the symbols that all renderers recognize: @scheme['tt],
+ @scheme['italic], @scheme['bold], @scheme['sf],
+ @scheme['subscript], @scheme['superscript], or
+ @scheme['hspace];}
+
+ @item{an instance of @scheme[target-url] to generate a hyperlink; or}
+
+ @item{an instance of @scheme[image-file] to support an inline image.}
+
+}
+
+The @scheme[content] field is a list of @techlink{elements}.
+
}
+
@defstruct[(target-element element) ([tag tag?])]{
+Declares the content as a hyperlink target for @scheme[tag].
+
}
+
@defstruct[(toc-target-element target-element) ()]{
+Like @scheme[target-element], the content is also a kind of section
+label to be shown in the ``on this page'' table for HTML output.
+
}
-@defstruct[(link-element element) ([tag any/c]
- [complain-if-fail? boolean?])]{
+
+@defstruct[(link-element element) ([tag any/c])]{
+
+Hyperlinks the content to @scheme[tag].
}
@@ -227,49 +364,69 @@ section, and the last argument correspond to global information
[entry-seq list?])]{
The @scheme[plain-seq] specifies the keys for sorting, where the first
-element is the main key, the second is a sub-key, etc. The
-@scheme[entry-seq] list must have the same length, and it provides the
-form of each key to render in the final document. See also
-@scheme[index].
+ element is the main key, the second is a sub-key, etc. The
+ @scheme[entry-seq] list must have the same length, and it provides
+ the form of each key to render in the final document. See also
+ @scheme[index].
}
+
@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].
+ 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?)]
+@defstruct[delayed-element ([resolve (any/c part? resolve-info? . -> . list?)]
[sizer (-> any/c)]
[plain (-> any/c)])]{
The @scheme[render] procedure's arguments are the same as for
-@scheme[delayed-flow-element]. Unlike @scheme[delayed-flow-element],
-the result of the @scheme[render] procedure's argument is remembered
-on the first call. Furthemore, the element can be marshelled (e.g.,
-for an index entry or a section-title entry) only if it has been
-rendered first.
+ @scheme[delayed-flow-element]. Unlike @scheme[delayed-flow-element],
+ the result of the @scheme[render] procedure's argument is remembered
+ on the first call.
The @scheme[sizer] field is a procedure that produces a substitute
-element for the delayed element for the purposes of determine the
-element's width (see @scheme[element-width]).
+ element for the delayed element for the purposes of determining the
+ element's width (see @scheme[element-width]).
The @scheme[plain] field is a procedure that produces a substitute for
-the element when needed before the ``collect'' phase.
+ the element when needed before the @techlink{collect pass}.
}
+
+@defstruct[(collect-element element) ([collect (collect-info . -> . any)])]{
+
+Like @scheme[element], but the @scheme[collect] procedure is called
+during the @techlink{collect pass}. The @scheme[collect] procedure
+normally calls @scheme[collect-put!].
+
+}
+
+
@defstruct[collected-info ([number (listof (or/c false/c integer?))]
[parent (or/c false/c part?)]
[info any/c])]{
-Computed for each part by the ``collect'' phase.
+Computed for each part by the @techlink{collect pass}.
}
+
+@defstruct[target-url ([addr string?])]{
+
+Used as a style for an @scheme[element].}
+
+
+@defstruct[image-file ([path path-string?])]{
+
+Used as a style for an @scheme[element].}
+
+
@defproc[(flow-element? [v any/c]) boolean?]{
Returns @scheme[#t] if @scheme[v] is a @scheme[paragraph],
@@ -281,13 +438,22 @@ Returns @scheme[#t] if @scheme[v] is a @scheme[paragraph],
@defproc[(tag? [v any/c]) boolean?]{
-Returns @scheme[#t] if @scheme[v] is acceptable as a link tag,
-@scheme[#f], otherwise. Currently, an acceptable tag is either a
-string or a list containing a symbol and a string.}
+Returns @scheme[#t] if @scheme[v] is acceptable as a link tag, which
+is a list containing a symbol and either a string or a
+@scheme[generated-tag] instance.}
+
+
+@defstruct[generated-tag ()]{
+
+A placeholder for a tag to be generated during the @scheme{collect
+ pass}. Use @scheme[tag-key] to convert a tag containing a
+ @scheme[generated-tag] instance to one containing a string.
+
+}
@defproc*[([(content->string (content list?)) string?]
- [(content->string (content list?) (p part?) (info any/c)) string?])]{
+ [(content->string (content list?) (p part?) (info resolve-info?)) string?])]{
Converts a list of elements to a single string (essentially
rendering the content as ``plain text'').
@@ -299,7 +465,65 @@ element (if it has not been forced already).}
@defproc*[([(element->string (element any/c)) string?]
- [(element->string (element any/c) (p part?) (info any/c)) string?])]{
+ [(element->string (element any/c) (p part?) (info resolve-info?)) string?])]{
Like @scheme[content->string], but for a single element.
}
+
+@defproc[(element-width (element any/c)) nonnegative-exact-integer?]{
+
+Returns the width in characters of the given element.}
+
+
+@defproc[(flow-element-width (e flow-element?)) nonnegative-exact-integer?]{
+
+Returns the width in characters of the given flow element.}
+
+@defstruct[collect-info ([ht any/c] [ext-ht any/c] [parts any/c] [tags any/c] [gen-prefix any/c])]{
+
+Encapsulates information accumulated (or being accumulated) from the
+@techlink{collect pass}. The fields are exposed, but not currently
+intended for external use.
+
+}
+
+@defstruct[resolve-info ([ci any/c] [delays any/c] [undef any/c])]{
+
+Encapsulates information accumulated (or being accumulated) from the
+@techlink{resolve pass}. The fields are exposed, but not currently
+intended for external use.
+
+}
+
+@defproc[(collect-put! [ci collect-info?] [key any/c] [val any/c])
+ void?]{
+
+Registers information in @scheme[ci]. This procedure should be called
+only during the @techlink{collect pass}.
+
+}
+
+@defproc[(resolve-get [ri resolve-info?] [key any/c])
+ void?]{
+
+Extract information during the @techlink{resolve pass} or
+@techlink{render pass} from @scheme[ri], where the information was
+previously registered during the @techlink{collect pass}. See also
+@secref["passes"].
+
+}
+
+@defproc[(part-collected-info [p part?]
+ [ri resolve-info?])
+ collected-info?]{
+
+Returns the information collected for @scheme[p] as recorded within
+@scheme[ri].
+
+}
+
+@defproc[(tag-key [t tag?] [ri resolve-info?]) tag?]{
+
+Converts a @scheme[generated-tag] value with @scheme[t] to a string.
+
+}
diff --git a/collects/scribblings/scribble/style.scrbl b/collects/scribblings/scribble/style.scrbl
@@ -2,12 +2,10 @@
@require[(lib "manual.ss" "scribble")]
@require["utils.ss"]
-@title[#:tag "reference-style"]{PLT Reference Style Guide}
-
-@italic{Notes toward an eventual guide chapter...}
+@title[#:tag "reference-style"]{Style Guide}
In the descriptive body of @scheme[defform], @scheme[defproc], etc.,
-do not start with ``This...'' Instead, start with a sentence whose
+do not start with ``This ...'' Instead, start with a sentence whose
implicit subject is the form or value being described. Thus, the
description will often start with ``Produces.'' Refer to arguments by
name.
@@ -20,24 +18,6 @@ expression position within a syntactic form. Use @schemeidfont{body}
for a form (definition or expression) in an internal-definition
position.
-Break up HTML documents into multiple pages by using the @scheme['toc]
-section style in combination with
-@scheme[local-table-of-contents]. The @scheme[local-table-of-contents]
-should go after a short introduction, if any. In some cases, a longer
-introduction is better placed after the
-@scheme[local-table-of-contents] call, especially if the contents are
-short.
-
-Favor hyperlinks installed by @scheme[scheme] instead of explicit
-section links produced by @scheme[secref]. In particular, there's
-rarely a need to have both links (e.g., ``see @scheme[scheme] in
-@secref["scribble:manual:code"]'').
-
-Link tags are resolved relative to surrounding sections, but if you
-think anyone will ever refer to a link targer, try to pick a tag that
-will be globally unique. For example, all of the section tags in the
-PLT Scheme reference start with @litchar["mz:"].
-
Pay attention to the difference between identifiers and meta-variables
when using @scheme[scheme], especially outside of @scheme[defproc] or
@scheme[defform]. Prefix a meta-variable with @litchar{_}; for
diff --git a/collects/scribblings/scribble/utils.ss b/collects/scribblings/scribble/utils.ss
@@ -6,6 +6,23 @@
(prefix scribble: (lib "reader.ss" "scribble"))
(lib "string.ss"))
+ (define-syntax bounce-for-label
+ (syntax-rules ()
+ [(_ mod) (begin
+ (require-for-label mod)
+ (provide-for-label (all-from mod)))]
+ [(_ mod ...) (begin (bounce-for-label mod) ...)]))
+
+ (bounce-for-label (lib "lang.ss" "big")
+ (lib "struct.ss" "scribble")
+ (lib "base-render.ss" "scribble")
+ (lib "decode.ss" "scribble")
+ (lib "basic.ss" "scribble")
+ (lib "manual.ss" "scribble")
+ (lib "scheme.ss" "scribble")
+ (lib "eval.ss" "scribble")
+ (lib "bnf.ss" "scribble"))
+
(provide scribble-examples litchar/lines)
(define (litchar/lines . strs)
