doc and scribble work

svn: r6431

original commit: 47367688789cd2b0a74677c95d5da74630bf7396

collects/scribble/base-render.ss

@@ -103,6 +103,7 @@
         (cond
          [(table? p) (collect-table p ht)]
          [(itemization? p) (collect-itemization p ht)]
+         [(blockquote? p) (collect-blockquote p ht)]
          [(delayed-flow-element? p) (void)]
          [else (collect-paragraph p ht)]))
         
@@ -114,6 +115,10 @@
         (for-each (lambda (d) (collect-flow d ht))
                   (itemization-flows i)))
 
+      (define/public (collect-blockquote i ht)
+        (for-each (lambda (d) (collect-flow-element d ht))
+                  (blockquote-paragraphs i)))
+
       (define/public (collect-element i ht)
         (when (target-element? i)
           (collect-target-element i ht))
@@ -189,6 +194,7 @@
         (cond
          [(table? p) (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)]
@@ -202,6 +208,10 @@
         (map (lambda (d) (render-flow d part ht))
              (itemization-flows i)))
       
+      (define/public (render-blockquote i part ht)
+        (map (lambda (d) (render-flow-element d part ht))
+             (blockquote-paragraphs i)))
+      
       (define/public (render-element i part ht)
         (cond
          [(and (link-element? i)

collects/scribble/decode.ss

@@ -71,10 +71,7 @@
               (title-decl-content (car l))
               (title-decl-tag (car l))
               (title-decl-style (car l)))]
-       [(or (paragraph? (car l))
+       [(flow-element? (car l))
-            (table? (car l))
-            (itemization? (car l))
-            (delayed-flow-element? (car l)))
         (let ([para (decode-accum-para accum)]
               [part (decode-flow* (cdr l) tag style title part-depth)])
           (make-styled-part (part-tag part)

collects/scribble/html-render.ss

@@ -201,6 +201,15 @@
                                                (cons #f (map (lambda (x) #f) flows)))))))
                         (table-flowss t)))))
 
+      (define/override (render-blockquote t part ht)
+        `((blockquote ,@(if (string? (blockquote-style t))
+                            `(((class ,(blockquote-style t))))
+                            null)
+                      ,@(apply append
+                               (map (lambda (i)
+                                      (render-flow-element i part ht))
+                                    (blockquote-paragraphs t))))))
+
       (define/override (render-itemization t part ht)
         `((ul
            ,@(map (lambda (flow)

collects/scribble/latex-render.ss

@@ -14,6 +14,7 @@
       (define/override (get-suffix) #".tex")
 
       (inherit render-flow
+               render-flow-element
                render-content
                install-file
                format-number
@@ -50,6 +51,7 @@
         (printf "\\newcommand{\\textsub}[1]{$_{#1}$}\n")
         (printf "\\newcommand{\\textsuper}[1]{$^{#1}$}\n")
         (printf "\\newcommand{\\refcontent}[1]{#1}\n")
+        (printf "\\definecolor{PaleBlue}{rgb}{0.90,0.90,1.0}\n")
         (printf "\\definecolor{LightGray}{rgb}{0.90,0.90,0.90}\n")
         (printf "\\newcommand{\\schemeinput}[1]{\\colorbox{LightGray}{\\hspace{-0.5ex}\\schemeinputcol{#1}\\hspace{-0.5ex}}}\n")
         (printf "\\begin{document}\n")
@@ -153,7 +155,13 @@
               (if index?
                   (printf "\n\n\\begin{theindex}\n")
                   (printf "\n\n~a\\begin{~a}~a{@{}~a}\n"
-                          (if boxed? "\\vspace{4ex}\\hrule\n\\vspace{-2ex}\n" "")
+                          (if boxed? 
+                              (format "{~a\\begin{picture}(1,0)\\put(0,0){\\line(1,0){1}}\\end{picture}}~a\n\\nopagebreak\n" 
+                                      "\\setlength{\\unitlength}{\\linewidth}"
+                                      (if (equal? tableform "longtable")
+                                          "\\vspace{-5ex}"
+                                          "\n\n"))
+                              "")
                           tableform
                           opt
                           (apply string-append
@@ -185,6 +193,15 @@
         (printf "\n\n\\end{itemize}\n")
         null)
 
+      (define/override (render-blockquote t part ht)
+        (printf "\n\n\\begin{quote}\n")
+        (parameterize ([current-table-depth (add1 (current-table-depth))])
+          (for-each (lambda (e)
+                      (render-flow-element e part ht))
+                    (blockquote-paragraphs t)))
+        (printf "\n\n\\end{quote}\n")
+        null)
+
       (define/override (render-other i part ht)
         (cond
          [(string? i) (display-protected i)]

collects/scribble/manual.ss

@@ -137,7 +137,7 @@
 
   ;; ----------------------------------------
 
-  (provide defproc defproc* defstruct defthing defform 
+  (provide defproc defproc* defstruct defthing defform defform/none
            specsubform specsubform/inline
            var svar void-const)
 
@@ -174,7 +174,11 @@
                                                                       #'name)
                                                 #'rest)
                                                #'spec)])])
-         #'(*defform 'spec (lambda (x) (schemeblock0 new-spec)) (lambda () (list desc ...))))]))
+         #'(*defform #t 'spec (lambda (x) (schemeblock0 new-spec)) (lambda () (list desc ...))))]))
+  (define-syntax (defform/none stx)
+    (syntax-case stx ()
+      [(_ spec desc ...)
+       #'(*defform #f 'spec (lambda (ignored) (schemeblock0 spec)) (lambda () (list desc ...)))]))
   (define-syntax specsubform
     (syntax-rules ()
       [(_ spec desc ...)
@@ -375,11 +379,15 @@
                        (to-element result-contract))))))))
       (content-thunk))))
 
-  (define (*defform form form-proc content-thunk)
+  (define (meta-symbol? s) (memq s '(... ...+ ?)))
+
+  (define (*defform kw? form form-proc content-thunk)
     (parameterize ([current-variable-list
-                    (let loop ([form (cdr form)])
+                    (let loop ([form (if kw? (cdr form) form)])
                       (cond
-                       [(symbol? form) (list form)]
+                       [(symbol? form) (if (meta-symbol? form)
+                                           null
+                                           (list form))]
                        [(pair? form) (append (loop (car form))
                                              (loop (cdr form)))]
                        [else null]))])
@@ -397,26 +405,36 @@
                            (to-element
                             `(,x
                               . ,(cdr form)))))))
-                   (make-target-element
+                   (and kw?
-                    #f
+                        (make-target-element
-                    (list (to-element (car form)))
+                         #f
-                    (register-scheme-form-definition (car form)))))))))
+                         (list (to-element (car form)))
+                         (register-scheme-form-definition (car form))))))))))
         (content-thunk)))))
 
   (define (*specsubform form form-thunk content-thunk)
     (parameterize ([current-variable-list
-                    (let loop ([form form])
+                    (append (let loop ([form form])
-                      (cond
+                              (cond
-                       [(symbol? form) (list form)]
+                               [(symbol? form) (if (meta-symbol? form)
-                       [(pair? form) (append (loop (car form))
+                                                   null
-                                             (loop (cdr form)))]
+                                                   (list form))]
-                       [else null]))])
+                               [(pair? form) (append (loop (car form))
-      (make-splice
+                                                     (loop (cdr form)))]
+                               [else null]))
+                            (current-variable-list))])
+      (make-blockquote
+       "leftindent"
        (cons
-        (if form-thunk
+        (make-table
-            (form-thunk)
+         'boxed
-            (to-element form))
+         (list (list
-        (content-thunk)))))
+                (make-flow
+                 (list
+                  (if form-thunk
+                      (form-thunk)
+                      (make-paragraph (list (to-element form)))))))))
+        (flow-paragraphs (decode-flow (content-thunk)))))))
 
   (define (*var id)
     (to-element (*var-sym id)))
@@ -451,6 +469,17 @@
       (index (string-append (content->string (element-content c)) "s") 
              c)))
   (provide pidefterm)
+
+  ;; ----------------------------------------
+
+  (provide where-is-one-of
+           is-one-of)
+
+  (define (where-is-one-of id)
+    (make-element #f (list "where " id " is one of")))
+
+  (define (is-one-of id)
+    (make-element #f (list id " is one of")))
   
   ;; ----------------------------------------
 

collects/scribble/scheme.ss

@@ -71,22 +71,25 @@
                                         (make-element 'tt (list v)))
                                     content))
                 (set! dest-col (+ dest-col (if (string? v) (string-length v) 1)))))))
-      (define (advance c init-line!)
+      (define advance 
-        (let ([c (syntax-column c)]
+        (case-lambda
-              [l (syntax-line c)]
+         [(c init-line! delta)
-              [span (syntax-span c)])
+          (let ([c (+ delta (syntax-column c))]
-          (when (and l (l . > . line))
+                [l (syntax-line c)]
-            (out "\n" no-color)
+                [span (syntax-span c)])
-            (set! line l)
+            (when (and l (l . > . line))
-            (init-line!))
+              (out "\n" no-color)
-          (when c
+              (set! line l)
-            (let ([d-col (hash-table-get col-map src-col src-col)])
+              (init-line!))
-              (let ([amt (+ (- c src-col) (- d-col dest-col))])
+            (when c
-                (when (positive? amt)
+              (let ([d-col (hash-table-get col-map src-col src-col)])
-                  (let ([old-dest-col dest-col])
+                (let ([amt (+ (- c src-col) (- d-col dest-col))])
-                    (out (make-element 'hspace (list (make-string amt #\space))) #f)
+                  (when (positive? amt)
-                    (set! dest-col (+ old-dest-col amt))))))
+                    (let ([old-dest-col dest-col])
-            (set! src-col (+ c (or span 1))))))
+                      (out (make-element 'hspace (list (make-string amt #\space))) #f)
+                      (set! dest-col (+ old-dest-col amt))))))
+              (set! src-col (+ c (or span 1)))))]
+         [(c init-line!) (advance c init-line! 0)]))
       (define (convert-infix c quote-depth)
         (let ([l (syntax->list c)])
           (and l
@@ -240,7 +243,8 @@
                   ((loop init-line! quote-depth) (car l))
                   (lloop (cdr l))]
                  [else
-                  (out " . " (if (positive? quote-depth) value-color paren-color))
+                  (advance l init-line! -2)
+                  (out ". " (if (positive? quote-depth) value-color paren-color))
                   (set! src-col (+ src-col 3))
                   (hash-table-put! col-map src-col dest-col)
                   ((loop init-line! quote-depth) l)]))

collects/scribble/scribble.css

@@ -26,6 +26,11 @@
                 border: 0.5em solid #F5F5DC;
                }
 
+               .leftindent { 
+                margin-left: 1em;
+                margin-right: 0em;
+               }
+
                h1,h2,h3,h4,h5,h6 {
                margin-top: .5em;
                }

collects/scribble/struct.ss

@@ -48,6 +48,7 @@
     (or (paragraph? p)
         (table? p)
         (itemization? p)
+        (blockquote? p)
         (delayed-flow-element? p)))
 
   (provide-structs 
@@ -65,6 +66,8 @@
            [flowss (listof (listof flow?))])]
    [delayed-flow-element ([render (any/c part? any/c . -> . flow-element?)])]
    [itemization ([flows (listof flow?)])]
+   [blockquote ([style any/c]
+                [paragraphs (listof flow-element?)])]
    ;; content = list of elements
    [element ([style any/c]
              [content list?])]

collects/scribblings/scribble/manual.scrbl

@@ -159,112 +159,103 @@ in a form definition.}
 @; ------------------------------------------------------------------------
 @section{Definition Reference}
 
-@defform[(defproc (identifier arg-spec ...) result-contract-expr-datum pre-flow ...)]{Produces 
+@defform[(defproc (id arg-spec ...) 
-a sequence of flow elements (encaptured in a @scheme[splice]) to
+                  result-contract-expr-datum 
-document a procedure named @scheme[identifier]. The
+                  pre-flow ...)]{
-@scheme[identifier] is registered so that @scheme[scheme]-typeset uses
+
+Produces a sequence of flow elements (encaptured in a @scheme[splice])
+to document a procedure named @scheme[id]. The
+@scheme[id] is registered so that @scheme[scheme]-typeset uses
 of the identifier are hyperlinked to this documentation.
 
 Each @scheme[arg-spec] must have one of the following forms:
 
-@itemize{
+@specsubform[(arg-id contract-expr-datum)]{
-
+       An argument whose contract is specified by
- @item{@specsubform/inline[(arg-identifier contract-expr-datum)]{---
-       an argument whose contract is specified by
        @scheme[contract-expr-datum] which is typeset via
-       @scheme[scheme].}}
+       @scheme[scheme].}
 
- @item{@specsubform/inline[(arg-identifier contract-expr-datum
+@specsubform[(arg-id contract-expr-datum default-expr)]{
-       default-expr)]{ --- like the previous case, but with a default
+       Like the previous case, but with a default value. All arguments
-       value. All arguments with a default value must be grouped
+       with a default value must be grouped together, but they can be
-       together, but they can be in the middle of required
+       in the middle of required arguments.}
-       arguments.}}
 
- @item{@specsubform/inline[(keyword arg-identifier
+@specsubform[(keyword arg-id contract-expr-datum)]{
-       contract-expr-datum)]{ --- like the first case, but for a
+       Like the first case, but for a keyword-based argument.}
-       keyword-based argument.}}
 
- @item{@specsubform/inline[(keyword arg-identifier contract-expr-datum
+@specsubform[(keyword arg-id contract-expr-datum default-expr)]{
-       default-expr)]{ --- like the previous case, but with a default
+       Like the previous case, but with a default
-       value.}}
+       value.}
 
- @item{@scheme[...0] --- any number of the preceding argument
+@specsubform[#, @schemeidfont{...0}]{ Any number of the preceding argument
-      (normally at the end)}
+      (normally at the end).}
 
- @item{@scheme[...1] --- one or more of the preceding argument
+@specsubform[#, @schemeidfont{...1}]{One or more of the preceding argument
-       (normally at the end)}
+       (normally at the end).}
-
-}
 
 The @scheme[result-contract-expr-datum] is typeset via
 @scheme[scheme], and it represents a contract on the procedure's
 result.
 
 The @scheme[pre-flow]s list is parsed as a flow that documents the
-procedure. In this description, references to @svar[arg-identifier]s
+procedure. In this description, references to @svar[arg-id]s
 are typeset as procedure arguments.
 
 The typesetting of all data before the @scheme[pre-flow]s ignores the
 source layout.}
 
 
-@defform[(defproc* (((identifier arg-spec ...) result-contract-expr-datum) ...) pre-flow ...)]{Like
+@defform[(defproc* ([(id arg-spec ...) 
-@scheme[defproc], but for multiple cases with the same @scheme[identifier].
+                     result-contract-expr-datum] ...) 
-}
+                   pre-flow ...)]{
+
+Like @scheme[defproc], but for multiple cases with the same
+@scheme[id].  }
 
 
-@defform[(defform (identifier . datum) pre-flow ...)]{Produces a 
+@defform[(defform (id . datum) pre-flow ...)]{Produces a 
 a sequence of flow elements (encaptured in a @scheme[splice]) to
-document a syntaic form named by @scheme[identifier]. The
+document a syntatic form named by @scheme[id]. The
-@scheme[identifier] is registered so that @scheme[scheme]-typeset uses
+@scheme[id] is registered so that @scheme[scheme]-typeset uses
 of the identifier are hyperlinked to this documentation.
 
 The @scheme[pre-flow]s list is parsed as a flow that documents the
 procedure. In this description, a reference to any identifier in
 @scheme[datum] is typeset as a sub-form non-terminal.
 
-The typesetting of @scheme[(identifier . datum)] preserves the source
+The typesetting of @scheme[(id . datum)] preserves the source
 layout, like @scheme[scheme], and unlike @scheme[defproc].}
 
 
-@defform[(specsubform/inline datum pre-flow ...)]{Similar to
+@defform[(specsubform datum pre-flow ...)]{Similar to
 @scheme[defform], but without any specific identifier being defined,
-without the output format that highlights a definition, and with
+and the table and flow are typeset indented. This form is intended for
-@scheme[datum] as an element rather than a table. This form is
+use when refining the syntax of a non-terminal used in a
-intended for use when refining the syntax of a non-terminal used in a
+@scheme[defform] or other @scheme[specsubform]. For example, it is
-@scheme[defform], @scheme[specsubform], or other
+used in the documentation for @scheme[defproc] in the itemization of
-@scheme[specsubform/inline]. For example, it is used in the
+possible shapes for @svar[arg-spec].
-documentation for @scheme[defproc] in the itemization of possible
-shapes for @svar[arg-spec].
 
 The @scheme[pre-flow]s list is parsed as a flow that documents the
 procedure. In this description, a reference to any identifier in
 @scheme[datum] is typeset as a sub-form non-terminal.}
 
 
-@defform[(specsubform datum pre-flow ...)]{Like
+@defform[(defthing id contract-expr-datum pre-flow ...)]{Like
-@scheme[specsubform/inline], but the @scheme[datum] is typeset in the
-resulting flow as a table instead of an element.}
-
-
-@defform[(defthing identifier contract-expr-datum pre-flow ...)]{Like
 @scheme[defproc], but for a non-procedure binding.}
 
-@defform[(defstruct struct-name ([field-name contract-expr-datum] ...) pre-flow ...)]{Similar 
+@defform[(defstruct struct-name ([field-name contract-expr-datum] ...) 
-to @scheme[defform], but for a structure definition.
+                    pre-flow ...)]{
+
+Similar to @scheme[defform], but for a structure definition.
 
 The @scheme[struct-name] can be either of the following:
 
-@itemize{
+@specsubform[id]{A structure type with no
+       specified supertype.}
 
- @item{@specsubform/inline[identifier]{--- a structure type with no
+@specsubform[(id super-id)]{A type with indicated supertype.}
-       specified supertype.}}
-
- @item{@specsubform/inline[(identifier super-identifier)]{ --- a structure
- type with indicated supertype.}}
-
-}}
 
+}
 
 @; ------------------------------------------------------------------------
 @section{Various String Forms}