diff --git a/collects/scribble/html-render.ss b/collects/scribble/html-render.ss
index 0aad6228..e0957f5c 100644
--- a/collects/scribble/html-render.ss
+++ b/collects/scribble/html-render.ss
@@ -68,16 +68,27 @@
(define/override (collect-target-element i ht)
(hash-table-put! ht
(target-element-tag i)
- (list (current-output-file) #f #f)))
+ (list (current-output-file)
+ #f
+ (page-target-element? i))))
;; ----------------------------------------
+ (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)
(let-values ([(top mine)
(let loop ([d d][mine d])
(let ([p (collected-info-parent (part-collected-info d))])
(if p
- (loop p d)
+ (loop p (if (reveal-subparts? d)
+ mine
+ d))
(values d mine))))])
`((div ((class "tocset"))
(div ((class "tocview"))
@@ -89,28 +100,39 @@
(table
((class "tocviewlist")
(cellspacing "0"))
- ,@(map (lambda (p)
- `(tr
- (td
- ((align "right"))
- ,@(format-number (collected-info-number (part-collected-info p))
- '((tt nbsp))))
- (td
- (a ((href ,(let ([dest (lookup p ht `(part ,(car (part-tags p))))])
- (format "~a~a~a"
- (from-root (car dest)
- (get-dest-directory))
- (if (caddr dest)
- ""
- "#")
- (if (caddr dest)
- ""
- `(part ,(car (part-tags p)))))))
- (class ,(if (eq? p mine)
- "tocviewselflink"
- "tocviewlink")))
- ,@(render-content (part-title-content p) d ht)))))
- (part-parts top))))
+ ,@(map (lambda (pp)
+ (let ([p (car pp)]
+ [show-number? (cdr pp)])
+ `(tr
+ (td
+ ((align "right"))
+ ,@(if show-number?
+ (format-number (collected-info-number (part-collected-info p))
+ '((tt nbsp)))
+ '("-" nbsp)))
+ (td
+ (a ((href ,(let ([dest (lookup p ht `(part ,(car (part-tags p))))])
+ (format "~a~a~a"
+ (from-root (car dest)
+ (get-dest-directory))
+ (if (caddr dest)
+ ""
+ "#")
+ (if (caddr dest)
+ ""
+ `(part ,(car (part-tags p)))))))
+ (class ,(if (eq? p mine)
+ "tocviewselflink"
+ "tocviewlink")))
+ ,@(render-content (part-title-content p) d ht))))))
+ (let loop ([l (map (lambda (v) (cons v #t)) (part-parts top))])
+ (cond
+ [(null? l) null]
+ [(reveal-subparts? (caar l))
+ (cons (car l) (loop (append (map (lambda (v) (cons v #f))
+ (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
@@ -219,18 +241,26 @@
`(,@(if (and (not (part-title-content d))
(null? number))
null
- `((,(case (length number)
- [(0) 'h2]
- [(1) 'h3]
- [(2) 'h4]
- [else 'h5])
- ,@(format-number number '((tt nbsp)))
- ,@(map (lambda (t)
+ (if (and (styled-part? d)
+ (let ([s (styled-part-style d)])
+ (or (eq? s 'hidden)
+ (and (list? s)
+ (memq 'hidden s)))))
+ (map (lambda (t)
`(a ((name ,(format "~a" `(part ,t))))))
- (part-tags d))
- ,@(if (part-title-content d)
- (render-content (part-title-content d) d ht)
- null))))
+ (part-tags d))
+ `((,(case (length number)
+ [(0) 'h2]
+ [(1) 'h3]
+ [(2) 'h4]
+ [else 'h5])
+ ,@(format-number number '((tt nbsp)))
+ ,@(map (lambda (t)
+ `(a ((name ,(format "~a" `(part ,t))))))
+ (part-tags d))
+ ,@(if (part-title-content d)
+ (render-content (part-title-content d) d ht)
+ null)))))
,@(render-flow* (part-flow d) d ht #f)
,@(let loop ([pos 1]
[secs (part-parts d)])
diff --git a/collects/scribble/manual.ss b/collects/scribble/manual.ss
index 7a543152..0d9310bb 100644
--- a/collects/scribble/manual.ss
+++ b/collects/scribble/manual.ss
@@ -440,7 +440,7 @@
(define-syntax defthing
(syntax-rules ()
[(_ id result desc ...)
- (*defthing (quote-syntax id) 'id 'result (lambda () (list desc ...)))]))
+ (*defthing (quote-syntax id) 'id (quote-syntax result) (lambda () (list desc ...)))]))
(define-syntax defparam
(syntax-rules ()
[(_ id arg contract desc ...)
@@ -508,9 +508,15 @@
(cond
[(pair? v)
(if (keyword? (car v))
- (make-element #f (list (to-element (car v))
- (hspace 1)
- (to-element (cadr v))))
+ (if (eq? mode 'new)
+ (make-element #f (list (schemeparenfont "[")
+ (schemeidfont (keyword->string (car v)))
+ (hspace 1)
+ (to-element (cadr v))
+ (schemeparenfont "]")))
+ (make-element #f (list (to-element (car v))
+ (hspace 1)
+ (to-element (cadr v)))))
(to-element (car v)))]
[(eq? v '...+)
dots1]
@@ -527,7 +533,8 @@
[(symbol? (car s)) (string-length (symbol->string (car s)))]
[(pair? (car s))
(if (keyword? (caar s))
- (+ (string-length (keyword->string (caar s)))
+ (+ (if (eq? mode 'new) 2 0)
+ (string-length (keyword->string (caar s)))
3
(string-length (symbol->string (cadar s))))
(string-length (symbol->string (caar s))))]
@@ -1236,7 +1243,7 @@
(define class-decls (make-hash-table 'equal))
- (define-struct decl (name super intfs body))
+ (define-struct decl (name super intfs mk-body))
(define-struct constructor (def))
(define-struct meth (mode desc def))
(define-struct spec (def))
@@ -1251,20 +1258,20 @@
(define (*include-class name)
(let ([decl (hash-table-get class-decls (register-scheme-definition name))])
(make-splice
- (cons (section (to-element (decl-name decl)))
+ (cons (section #:style 'hidden (to-element (decl-name decl)))
(map (lambda (i)
(cond
[(constructor? i) ((constructor-def i))]
[(meth? i)
((meth-def i) (meth-desc i))]
[else i]))
- (decl-body decl))))))
+ ((decl-mk-body decl) #t))))))
(define-syntax include-class
(syntax-rules ()
[(_ id) (*include-class (quote-syntax id))]))
- (define (*defclass stx-id super intfs)
+ (define (*defclass stx-id super intfs whole-page?)
(let ([spacer (hspace 1)])
(make-table
'boxed
@@ -1275,7 +1282,9 @@
(make-paragraph
(list (let ([tag (register-scheme-definition stx-id)]
[content (list (to-element stx-id))])
- (make-toc-target-element
+ ((if whole-page?
+ make-page-target-element
+ make-toc-target-element)
#f
(list (make-index-element #f
content
@@ -1319,12 +1328,14 @@
(register-class (quote-syntax name)
(quote-syntax super)
(list (quote-syntax intf) ...)
- (append
- (list
- (*defclass (quote-syntax name)
- (quote-syntax super)
- (list (quote-syntax intf) ...)))
- (list body ...))))]))
+ (lambda (whole-page?)
+ (append
+ (list
+ (*defclass (quote-syntax name)
+ (quote-syntax super)
+ (list (quote-syntax intf) ...)
+ whole-page?))
+ (list body ...)))))]))
(define-syntax definterface
(syntax-rules ()
@@ -1333,12 +1344,14 @@
(register-class (quote-syntax name)
#f
(list (quote-syntax intf) ...)
- (append
- (list
- (*defclass (quote-syntax name)
- #f
- (list (quote-syntax intf) ...)))
- (list body ...))))]))
+ (lambda (whole-page?)
+ (append
+ (list
+ (*defclass (quote-syntax name)
+ #f
+ (list (quote-syntax intf) ...)
+ whole-page?))
+ (list body ...)))))]))
(define-syntax (defconstructor*/* stx)
(syntax-case stx ()
diff --git a/collects/scribble/struct.ss b/collects/scribble/struct.ss
index ff0b6c5f..10adbd82 100644
--- a/collects/scribble/struct.ss
+++ b/collects/scribble/struct.ss
@@ -74,6 +74,7 @@
[content list?])]
[(target-element element) ([tag tag?])]
[(toc-target-element target-element) ()]
+ [(page-target-element target-element) ()]
[(link-element element) ([tag tag?])]
[(index-element element) ([tag tag?]
[plain-seq (listof string?)]