checkpoint GUI manual work

svn: r7117

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)
+                       ,@(map (lambda (pp)
-                                `(tr
+                                (let ([p (car pp)]
-                                  (td 
+                                      [show-number? (cdr pp)])
-                                   ((align "right"))
+                                  `(tr
-                                   ,@(format-number (collected-info-number (part-collected-info p))
+                                    (td 
-                                                    '((tt nbsp))))
+                                     ((align "right"))
-                                  (td
+                                     ,@(if show-number?
-                                   (a ((href ,(let ([dest (lookup p ht `(part ,(car (part-tags p))))])
+                                           (format-number (collected-info-number (part-collected-info p))
-                                                (format "~a~a~a" 
+                                                          '((tt nbsp)))
-                                                        (from-root (car dest)
+                                           '("-" nbsp)))
-                                                                   (get-dest-directory))
+                                    (td
-                                                        (if (caddr dest)
+                                     (a ((href ,(let ([dest (lookup p ht `(part ,(car (part-tags p))))])
-                                                            ""
+                                                  (format "~a~a~a" 
-                                                            "#")
+                                                          (from-root (car dest)
-                                                        (if (caddr dest)
+                                                                     (get-dest-directory))
-                                                            ""
+                                                          (if (caddr dest)
-                                                            `(part ,(car (part-tags p)))))))
+                                                              ""
-                                       (class ,(if (eq? p mine)
+                                                              "#")
-                                                   "tocviewselflink"
+                                                          (if (caddr dest)
-                                                   "tocviewlink")))
+                                                              ""
-                                      ,@(render-content (part-title-content p) d ht)))))
+                                                              `(part ,(car (part-tags p)))))))
-                              (part-parts top))))
+                                         (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)
+                  (if (and (styled-part? d)
-                        [(0) 'h2]
+                           (let ([s (styled-part-style d)])
-                        [(1) 'h3]
+                             (or (eq? s 'hidden)
-                        [(2) 'h4]
+                                 (and (list? s)
-                        [else 'h5])
+                                      (memq 'hidden s)))))
-                     ,@(format-number number '((tt nbsp)))
+                      (map (lambda (t)
-                     ,@(map (lambda (t)
                               `(a ((name ,(format "~a" `(part ,t))))))
-                            (part-tags d))
+                           (part-tags d))
-                     ,@(if (part-title-content d)
+                      `((,(case (length number)
-                           (render-content (part-title-content d) d ht)
+                            [(0) 'h2]
-                           null))))
+                            [(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)])

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))
+                             (if (eq? mode 'new)
-                                                    (hspace 1)
+                                 (make-element #f (list (schemeparenfont "[")
-                                                    (to-element (cadr v))))
+                                                        (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
+                         (lambda (whole-page?)
-                          (list
+                           (append
-                           (*defclass (quote-syntax name)
+                            (list
-                                      (quote-syntax super)
+                             (*defclass (quote-syntax name)
-                                      (list (quote-syntax intf) ...)))
+                                        (quote-syntax super)
-                          (list body ...))))]))
+                                        (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
+                         (lambda (whole-page?)
-                          (list
+                           (append
-                           (*defclass (quote-syntax name)
+                            (list
-                                      #f
+                             (*defclass (quote-syntax name)
-                                      (list (quote-syntax intf) ...)))
+                                        #f
-                          (list body ...))))]))
+                                        (list (quote-syntax intf) ...)
+                                        whole-page?))
+                            (list body ...)))))]))
 
   (define-syntax (defconstructor*/* stx)
     (syntax-case stx ()

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?)]

collects/scribblings/gui/diagrams.ss

@@ -8,7 +8,12 @@
            short-windowing-diagram
            windowing-diagram
            event-diagram
-           menu-diagram)
+           menu-diagram
+           editor-diagram
+           snip-diagram
+           style-diagram
+           admin-diagram
+           stream-diagram)
 
   (define (diagram->table d)
     (make-table
@@ -103,4 +108,52 @@ DIAG
                 |- menu-item%                        
                 |- checkable-menu-item%
 DIAG
+)
+
+  (define editor-diagram
+#<<DIAG
+  editor<%>
+   |- text%                   
+   |- pasteboard%
+DIAG
+)
+
+  (define snip-diagram
+#<<DIAG
+  snip%                   readable-snip<%>
+   |- string-snip%
+   |   |- tab-snip%
+   |- image-snip%
+   |- editor-snip%
+DIAG
+)
+ 
+  (define admin-diagram
+#<<DIAG
+  editor-canvas%       
+
+  editor-admin<%>                   snip-admin%
+   |- editor-snip-editor-admin<%>
+
+  editor-wordbreak-map%   keymap%
+DIAG
+)
+ 
+  (define style-diagram
+#<<DIAG
+  style<%>         style-delta%       add-color<%>
+  style-list%                         mult-color<%>
+DIAG
+)
+
+  (define stream-diagram
+#<<DIAG
+ editor-data%
+ editor-data-class%                     snip-class%
+ editor-data-class-list<%>              snip-class-list<%>
+ 
+ editor-stream-in%                   editor-stream-out%
+ editor-stream-in-base%              editor-stream-out-base%
+  |- editor-stream-in-bytes-base%     |- editor-stream-out-bytes-base%
+DIAG
 ))

collects/scribblings/gui/draw-classes.scrbl

@@ -2,7 +2,7 @@
 @require["common.ss"]
 @require["diagrams.ss"]
 
-@title[#:style '(toc quiet)]{Drawing Class Reference}
+@title[#:style '(toc quiet)]{Drawing Classes}
 
 @local-table-of-contents[]
 

collects/scribblings/gui/draw-funcs.scrbl

@@ -1,7 +1,7 @@
 #reader(lib "docreader.ss" "scribble")
 @require["common.ss"]
 
-@title{Drawing Function Reference}
+@title{Drawing Functions}
 
 @local-table-of-contents[]
 

collects/scribblings/gui/draw-overview.scrbl

@@ -3,7 +3,7 @@
 @require["common.ss"]
 @require["diagrams.ss"]
 
-@title[#:tag "mr:drawing-overview"]{Drawing Guide}
+@title[#:tag "mr:drawing-overview"]{Drawing}
 
 Drawing in MrEd requires a @deftech{device context} (@deftech{DC}),
  which is an instance of the @scheme[dc<%>] interface. For example,

collects/scribblings/gui/editor-classes.scrbl

@@ -2,7 +2,29 @@
 @require["common.ss"]
 @require["diagrams.ss"]
 
-@title[#:style '(toc quiet)]{Editor Class Reference}
+@title[#:style '(toc quiet)]{Editor Classes}
+
+Editors:
+
+@diagram->table[editor-diagram]
+
+Snips:
+
+@diagram->table[snip-diagram]
+
+Displays, Administrators, and Mappings:
+
+@diagram->table[editor-diagram]
+
+Styles:
+
+@diagram->table[style-diagram]
+
+Streams for Saving and Cut-and-Paste:
+
+@diagram->table[stream-diagram]
+
+Alphabetical:
 
 @local-table-of-contents[]
 
@@ -10,8 +32,17 @@
 @require["editor-intf.scrbl"]
 @require["editor-admin-class.scrbl"]
 @require["editor-canvas-class.scrbl"]
+@require["editor-data-class.scrbl"]
+@require["editor-data-class-class.scrbl"]
+@require["editor-data-class-list-intf.scrbl"]
 @require["editor-snip-editor-admin-intf.scrbl"]
 @require["editor-snip-class.scrbl"]
+@require["editor-stream-in-class.scrbl"]
+@require["editor-stream-in-base-class.scrbl"]
+@require["editor-stream-in-bytes-base-class.scrbl"]
+@require["editor-stream-out-class.scrbl"]
+@require["editor-stream-out-base-class.scrbl"]
+@require["editor-stream-out-bytes-base-class.scrbl"]
 @require["editor-wordbreak-map-class.scrbl"]
 @require["image-snip-class.scrbl"]
 @require["keymap-class.scrbl"]
@@ -20,6 +51,8 @@
 @require["readable-snip-intf.scrbl"]
 @require["snip-class.scrbl"]
 @require["snip-admin-class.scrbl"]
+@require["snip-class-class.scrbl"]
+@require["snip-class-list-intf.scrbl"]
 @require["string-snip-class.scrbl"]
 @require["style-intf.scrbl"]
 @require["style-delta-class.scrbl"]
@@ -31,7 +64,17 @@
 @include-class[editor<%>]
 @include-class[editor-admin%]
 @include-class[editor-canvas%]
+@include-class[editor-data%]
+@include-class[editor-data-class%]
+@include-class[editor-data-class-list<%>]
+@include-class[editor-snip-editor-admin<%>]
 @include-class[editor-snip%]
+@include-class[editor-stream-in%]
+@include-class[editor-stream-in-base%]
+@include-class[editor-stream-in-bytes-base%]
+@include-class[editor-stream-out%]
+@include-class[editor-stream-out-base%]
+@include-class[editor-stream-out-bytes-base%]
 @include-class[editor-wordbreak-map%]
 @include-class[image-snip%]
 @include-class[keymap%]
@@ -40,6 +83,8 @@
 @include-class[readable-snip<%>]
 @include-class[snip%]
 @include-class[snip-admin%]
+@include-class[snip-class%]
+@include-class[snip-class-list<%>]
 @include-class[string-snip%]
 @include-class[style<%>]
 @include-class[style-delta%]

collects/scribblings/gui/editor-overview.scrbl

@@ -2,7 +2,7 @@
 @require[(lib "bnf.ss" "scribble")]
 @require["common.ss"]
 
-@title[#:tag "mr:editor-overview"]{Editor Guide}
+@title[#:tag "mr:editor-overview"]{Editor}
 
 The editor toolbox provides a foundation for two common kinds of
  applications:

collects/scribblings/gui/editor-stream-classes.scrbl

@@ -1,31 +0,0 @@
-#reader(lib "docreader.ss" "scribble")
-@require["common.ss"]
-@require["diagrams.ss"]
-
-@title[#:style '(toc quiet)]{Editor Stream Class Reference}
-
-@local-table-of-contents[]
-
-@require["editor-data-class.scrbl"]
-@require["editor-data-class-class.scrbl"]
-@require["editor-data-class-list-intf.scrbl"]
-@require["editor-stream-in-class.scrbl"]
-@require["editor-stream-in-base-class.scrbl"]
-@require["editor-stream-in-bytes-base-class.scrbl"]
-@require["editor-stream-out-class.scrbl"]
-@require["editor-stream-out-base-class.scrbl"]
-@require["editor-stream-out-bytes-base-class.scrbl"]
-@require["snip-class-class.scrbl"]
-@require["snip-class-list-intf.scrbl"]
-
-@include-class[editor-data%]
-@include-class[editor-data-class%]
-@include-class[editor-data-class-list<%>]
-@include-class[editor-stream-in%]
-@include-class[editor-stream-in-base%]
-@include-class[editor-stream-in-bytes-base%]
-@include-class[editor-stream-out%]
-@include-class[editor-stream-out-base%]
-@include-class[editor-stream-out-bytes-base%]
-@include-class[snip-class%]
-@include-class[snip-class-list<%>]

collects/scribblings/gui/gui.scrbl

@@ -14,6 +14,7 @@ This manual describes MrEd.
 
 @include-section["guide.scrbl"]
 @include-section["reference.scrbl"]
+@include-section["config.scrbl"]
 
 @;------------------------------------------------------------------------
 

collects/scribblings/gui/guide.scrbl

@@ -1,7 +1,7 @@
 #reader(lib "docreader.ss" "scribble")
 @require["common.ss"]
 
-@title[#:style 'toc]{Guide}
+@title[#:style '(toc reveal)]{Guide}
 
 For documentation purposes, the MrEd toolbox is organized into three
 parts:

collects/scribblings/gui/reference.scrbl

@@ -1,7 +1,7 @@
 #reader(lib "docreader.ss" "scribble")
 @require["common.ss"]
 
-@title[#:style 'toc]{Reference}
+@title[#:style '(toc reveal)]{Reference}
 
 @local-table-of-contents[]
 
@@ -10,5 +10,4 @@
 @include-section["draw-classes.scrbl"]
 @include-section["draw-funcs.scrbl"]
 @include-section["editor-classes.scrbl"]
-@include-section["editor-stream-classes.scrbl"]
 @include-section["editor-funcs.scrbl"]

collects/scribblings/gui/win-classes.scrbl

@@ -2,7 +2,7 @@
 @require["common.ss"]
 @require["diagrams.ss"]
 
-@title[#:style '(toc quiet)]{Windowing Class Reference}
+@title[#:style '(toc quiet)]{Windowing Classes}
 
 Windows and controls:
 

collects/scribblings/gui/win-funcs.scrbl

@@ -1,7 +1,7 @@
 #reader(lib "docreader.ss" "scribble")
 @require["common.ss"]
 
-@title{Windowing Function Reference}
+@title{Windowing Functions}
 
 @local-table-of-contents[]
 

collects/scribblings/gui/win-overview.scrbl

@@ -3,7 +3,7 @@
 @require["common.ss"]
 @require["diagrams.ss"]
 
-@title[#:tag "mr:windowing-overview"]{Windowing Guide}
+@title[#:tag "mr:windowing-overview"]{Windowing}
 
 @section{Basic GUI Building Blocks}