Add the contents of the "blue boxes" in the docs to the upper-right

corner of the definitions window, based on the information that check
syntax computes

This commit contains two separate changes to make this work:

  - adding a new renderer, based on the text renderer, that
    pulls out the contents of the blue boxes and saves them
    in the doc/ directories (specifically in the files named
    contract-blueboxes.rktd)

  - extend check syntax to use and display the information
    build by the new renderer

original commit: 0c6734f782867b0401db15eb687fd246552e17b5

collects/scribble/base-render.rkt

@@ -11,10 +11,37 @@
          file/convertible
          "render-struct.rkt")
 
-(provide render%)
+(provide render%
+         render<%>)
+
+(define render<%>
+  (interface ()
+    traverse
+    collect
+    resolve
+    render
+    serialize-info
+    deserialize-info
+    get-external
+    get-undefined
+    
+    ;; undocumented:
+    current-render-mode
+    get-substitutions
+    render-part
+    render-flow
+    render-intrapara-block
+    render-table
+    render-itemization
+    render-paragraph
+    render-content
+    render-nested-flow
+    render-block
+    render-other
+    get-dest-directory))
 
 (define render%
-  (class object%
+  (class* object% (render<%>)
 
     (init-field dest-dir
                 [refer-to-existing-files #f]

collects/scribble/contract-render.rkt

@@ -0,0 +1,182 @@
+#lang racket/base
+(require racket/class racket/match
+         (prefix-in text: "text-render.rkt")
+         "base-render.rkt"
+         "core.rkt"
+         (only-in slideshow/pict pict?)
+         file/convertible)
+(provide override-render-mixin-single
+         override-render-mixin-multi)
+
+(define (override-render-mixin multi?)
+  (mixin (render<%>) ()
+    (super-new)
+    (define/override (render srcs dests ri)
+      (super render srcs dests ri)
+      
+      (for ([part (in-list srcs)]
+            [dest (in-list dests)])
+        (define p (open-output-string))
+        (define index-table (make-hash))
+        (port-count-lines! p)
+        (parameterize ([the-renderer text-renderer]
+                       [the-part part]
+                       [the-ri ri]
+                       [the-text-p p])
+          (r-part part 'block index-table))
+        (define table-str (format "~s\n" index-table))
+        (define cb.rktd 
+          (cond
+            [multi?
+             (build-path dest "contract-blueboxes.rktd")]
+            [else
+             (define-values (base name dir?) (split-path dest))
+             (build-path base "contract-blueboxes.rktd")]))
+        (call-with-output-file cb.rktd
+          (λ (port)
+            (fprintf port "~a\n" (string-utf-8-length table-str))
+            (display table-str port)
+            (display (get-output-string p) port))
+          #:exists 'truncate)))
+    
+    (inherit get-dest-directory)
+    (define text-renderer (new (text:render-mixin render%)
+                               [dest-dir (get-dest-directory)]))))
+
+(define the-renderer (make-parameter #f))
+(define the-part (make-parameter #f))
+(define the-ri (make-parameter #f))
+(define the-text-p (make-parameter #f))
+
+;; mode is either
+;;     'block -- search for the blue blocks
+;;  or (cons number number) -- search for tags in a block
+(define (r-parts parts mode index-table)
+  (for ([part (in-list parts)])
+    (r-part part mode index-table)))
+
+(define (r-part part mode index-table)
+  (r-blocks (part-blocks part) mode index-table)
+  (r-parts (part-parts part) mode index-table))
+
+(define (r-blocks blocks mode index-table)
+  (for ([block (in-list blocks)])
+    (r-block block mode index-table)))
+
+(define (r-block block mode index-table)
+  (match block
+    [(struct nested-flow (style blocks))
+     (check-and-continue style block mode index-table r-blocks blocks)]
+    [(struct compound-paragraph (style blocks)) 
+     (check-and-continue style block mode index-table r-blocks blocks)]
+    [(paragraph style content)
+     (check-and-continue style block mode index-table r-content content)]
+    [(itemization style blockss)
+     (check-and-continue style block mode index-table r-blockss blockss)]
+    [(table style cells)
+     (check-and-continue style block mode index-table r-blockss+cont cells)]
+    [(delayed-block resolve) 
+     (r-block (delayed-block-blocks block (the-ri)) mode index-table)]))
+
+(define (check-and-continue style block mode index-table sub-f sub-p)
+  (cond
+    [(and (pair? mode) (equal? (style-name style) "RBackgroundLabelInner"))
+     (define background-label-port (car mode))
+     (parameterize ([current-output-port background-label-port])
+       (send (the-renderer) render-block block (the-part) (the-ri) #f))
+     (sub-f sub-p mode index-table)]
+    [(and (eq? mode 'block) (eq? (style-name style) 'boxed) (table? block))
+     (cond
+       [(for/and ([cells (in-list (table-blockss block))])
+          (and (not (null? cells))
+               (null? (cdr cells))
+               (let ([fst (car cells)])
+                 (and (table? fst)
+                      (equal? (style-name (table-style fst)) "together")))))
+        (for ([cells (in-list (table-blockss block))])
+          (handle-one-block style (car cells) mode index-table r-block (car cells)))]
+       [else 
+        (handle-one-block style block mode index-table sub-f sub-p)])]
+    [else
+     (sub-f sub-p mode index-table)]))
+
+(define (handle-one-block style block mode index-table sub-f sub-p)
+  ;(printf "-----\n") ((dynamic-require 'racket/pretty 'pretty-write) block)
+  (define block-port (open-output-string))
+  (define background-label-port (open-output-string))
+  (define ents (make-hash))
+  (define new-mode (cons background-label-port ents))
+  (port-count-lines! block-port)
+  (port-count-lines! background-label-port)
+  (parameterize ([current-output-port block-port])
+    (send (the-renderer) render-block block (the-part) (the-ri) #f))
+  (sub-f sub-p new-mode index-table)
+  
+  ;; we just take the first one here
+  (define background-label-p (open-input-string (get-output-string background-label-port)))
+  (define background-label-line (read-line background-label-p))
+  
+  (define text-p (the-text-p))
+  (define-values (before-line _1 _2) (port-next-location text-p))
+  (define before-position (file-position text-p))
+  (fprintf text-p "~a\n"
+           (if (eof-object? background-label-line)
+               ""
+               background-label-line))
+  
+  ;; dump content of block-port into text-p, but first trim 
+  ;; the spaces that appear at the ends of the lines
+  (let ([p (open-input-string (get-output-string block-port))])
+    (let loop ()
+      (define l (read-line p))
+      (unless (eof-object? l)
+        (display (regexp-replace #rx" *$" l "") text-p)
+        (newline text-p)
+        (loop))))
+  
+  (define-values (after-line _3 _4) (port-next-location text-p))
+  (define txt-loc (cons before-position (- after-line before-line)))
+  (for ([(k v) (in-hash ents)])
+    (hash-set! index-table k (cons txt-loc (hash-ref index-table k '())))))
+
+(define (r-blockss+cont blockss mode index-table)
+  (for ([blocks (in-list blockss)])
+    (for ([block (in-list blocks)])
+      (unless (eq? block 'cont)
+        (r-block block mode index-table)))))
+
+(define (r-blockss blockss mode index-table)
+  (for ([blocks (in-list blockss)])
+    (r-blocks blocks mode index-table)))
+
+(define (r-content content mode index-table)
+  (cond
+    [(element? content) (r-element content mode index-table)]
+    [(list? content)
+     (for ([content (in-list content)])
+       (r-content content mode index-table))]
+    [(string? content) (void)]
+    [(symbol? content) (void)]
+    [(pict? content) (void)]
+    [(convertible? content) (void)]
+    [(delayed-element? content)
+     (r-content (delayed-element-content content (the-ri)) mode index-table)]
+    [(traverse-element? content)
+     (r-content (traverse-element-content content (the-ri)) mode index-table)]
+    [(part-relative-element? content) 
+     (r-content (part-relative-element-content content (the-ri)) mode index-table)]
+    [(multiarg-element? content)
+     (r-content (multiarg-element-contents content) mode index-table)]
+    [else (error 'r-content "unknown content: ~s\n" content)]))
+
+(define (r-element element mode index-table)
+  (when (index-element? element)
+    (when (pair? mode)
+      (define ents (cdr mode))
+      (define key (index-element-tag element))
+      (hash-set! ents key #t)))
+  (r-content (element-content element) mode index-table))
+
+
+(define override-render-mixin-multi (override-render-mixin #t))
+(define override-render-mixin-single (override-render-mixin #f))

collects/scribble/text-render.rkt

@@ -1,5 +1,6 @@
 #lang racket/base
-(require "core.rkt" racket/class racket/port racket/list racket/string
+(require "core.rkt" "base-render.rkt"
+         racket/class racket/port racket/list racket/string
          scribble/text/wrap)
 (provide render-mixin)
 
@@ -15,8 +16,8 @@
   (newline)
   (indent))
 
-(define (render-mixin %)
+(define render-mixin
-  (class %
+  (mixin (render<%>) ()
 
     (define/override (current-render-mode)
       '(text))

collects/scribblings/scribble/core.scrbl

@@ -290,18 +290,18 @@ HTML display when the mouse hovers over the text.
 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 @racket[render%] object.
+represented as methods on a @racket[render<%>] object.
 
-The result of the @method[render% collect] method is a
+The result of the @method[render<%> collect] method is a
 @racket[collect-info] instance. This result is provided back as an
-argument to the @method[render% resolve] method, which produces a
+argument to the @method[render<%> resolve] method, which produces a
 @racket[resolve-info] value that encapsulates the results from both
 iterations. The @racket[resolve-info] value is provided back to the
-@method[render% resolve] method for final rendering.
+@method[render<%> resolve] method for final rendering.
 
-Optionally, before the @method[render% resolve] method is called,
+Optionally, before the @method[render<%> resolve] method is called,
 serialized information from other documents can be folded into the
-@racket[collect-info] instance via the @method[render%
+@racket[collect-info] instance via the @method[render<%>
 deserialize-info] method. Other methods provide serialized information
 out of the collected and resolved records.
 

collects/scribblings/scribble/renderer.scrbl

@@ -114,51 +114,7 @@ the methods of the renderer. Documents built with higher layers, such
 as @racketmodname[scribble/manual], generally do not call the render
 object's methods directly.
 
-@defclass[render% object% ()]{
+@definterface[render<%> ()]{
-
-Represents a renderer.
-
-@defconstructor[([dest-dir path-string?]
-                 [refer-to-existing-files any/c #f]
-                 [root-path (or/c path-string? #f) #f]
-                 [prefix-file (or/c path-string? #f) #f]
-                 [style-file (or/c path-string? #f) #f]
-                 [style-extra-files (listof path-string?) null]
-                 [extra-files (listof path-string?) null]
-                 [helper-file-prefix (or/c string? #f) #f])]{
-
-Creates a renderer whose output will go to @racket[dest-dir]. For
-example, @racket[dest-dir] could name the directory containing the
-output Latex file, the HTML file for a single-file output, or the
-output sub-directory for multi-file HTML output.
-
-If @racket[refer-to-existing-files] is true, then when a document
-refers to external files, such as an image or a style file, then the
-file is referenced from its source location instead of copied to the
-document destination.
-
-If @racket[root-path] is not @racket[#f], it is normally the same as
-@racket[dest-dir] or a parent of @racket[dest-dir]. It causes
-cross-reference information to record destination files relative to
-@racket[root-path]; when cross-reference information is serialized, it
-can be deserialized via @method[render% deserialize-info] with a
-different root path (indicating that the destination files have
-moved).
-
-The @racket[prefix-file], @racket[style-file], and
-@racket[style-extra-files] arguments set files that control output
-styles in a formal-specific way; see @secref["config-style"] for more
-information.
-
-The @racket[extra-files] argument names files to be copied to the
-output location, such as image files or extra configuration files.
-
-The @racket[helper-file-prefix] argument specifies a string that is
-added as a prefix to the name of each support file that is generated
-or copied to the destination---not including files specified in
-@racket[extra-files], but including @racket[prefix-file],
-@racket[style-file], and @racket[style-extra-files].}
-
 
 @defmethod[(traverse [srcs (listof part?)]
                      [dests (listof path-string?)])
@@ -166,7 +122,7 @@ or copied to the destination---not including files specified in
 
 Performs the @techlink{traverse pass}, producing a hash table that
 contains the replacements for and @racket[traverse-block]s and
-@racket[traverse-elements]s. See @method[render% render] for
+@racket[traverse-elements]s. See @method[render<%> render] for
 information on the @racket[dests] argument.}
 
 @defmethod[(collect [srcs (listof part?)]
@@ -174,18 +130,18 @@ information on the @racket[dests] argument.}
                     [fp (and/c hash? immutable?)])
            collect-info?]{
 
-Performs the @techlink{collect pass}. See @method[render% render] for
+Performs the @techlink{collect pass}. See @method[render<%> render] for
 information on the @racket[dests] argument. The @racket[fp] argument
-is a result from the @method[render% traverse] method.}
+is a result from the @method[render<%> traverse] method.}
 
 @defmethod[(resolve [srcs (listof part?)]
                     [dests (listof path-string?)]
                     [ci collect-info?])
            resolve-info?]{
 
-Performs the @techlink{resolve pass}. See @method[render% render] for
+Performs the @techlink{resolve pass}. See @method[render<%> render] for
 information on the @racket[dests] argument.  The @racket[ci] argument
-is a result from the @method[render% collect] method.}
+is a result from the @method[render<%> collect] method.}
 
 @defmethod[(render [srcs (listof part?)]
                    [dests (listof path-string?)]
@@ -193,7 +149,7 @@ is a result from the @method[render% collect] method.}
            void?]{
 
 Produces the final output.  The @racket[ri] argument is a result from
-the @method[render% render] method.
+the @method[render<%> render] method.
 
 The @racket[dests] provide names of files for Latex or single-file
 HTML output, or names of sub-directories for multi-file HTML output.
@@ -248,15 +204,54 @@ then no tag in the set is included in the list of undefined tags.}
 
 }
 
+@defclass[render% object% (render<%>)]{
+
+Represents a renderer.
+
+@defconstructor[([dest-dir path-string?]
+                 [refer-to-existing-files any/c #f]
+                 [root-path (or/c path-string? #f) #f]
+                 [prefix-file (or/c path-string? #f) #f]
+                 [style-file (or/c path-string? #f) #f]
+                 [style-extra-files (listof path-string?) null]
+                 [extra-files (listof path-string?) null])]{
+
+Creates a renderer whose output will go to @racket[dest-dir]. For
+example, @racket[dest-dir] could name the directory containing the
+output Latex file, the HTML file for a single-file output, or the
+output sub-directory for multi-file HTML output.
+
+If @racket[refer-to-existing-files] is true, then when a document
+refers to external files, such as an image or a style file, then the
+file is referenced from its source location instead of copied to the
+document destination.
+
+If @racket[root-path] is not @racket[#f], it is normally the same as
+@racket[dest-dir] or a parent of @racket[dest-dir]. It causes
+cross-reference information to record destination files relative to
+@racket[root-path]; when cross-reference information is serialized, it
+can be deserialized via @method[render<%> deserialize-info] with a
+different root path (indicating that the destination files have
+moved).
+
+The @racket[prefix-file], @racket[style-file], and
+@racket[style-extra-files] arguments set files that control output
+styles in a formal-specific way; see @secref["config-style"] for more
+information.
+
+The @racket[extra-files] argument names files to be copied to the
+output location, such as image files or extra configuration files.}
+}
+
 @; ----------------------------------------
 
 @section{Text Renderer}
 
 @defmodule/local[scribble/text-render]{
 
-@defmixin[render-mixin (render%) ()]{
+@defmixin[render-mixin (render<%>) ()]{
 
-Specializes a @racket[render%] class for generating plain text.}}
+Specializes a @racket[render<%>] class for generating plain text.}}
 
 @; ----------------------------------------
 
@@ -264,9 +259,9 @@ Specializes a @racket[render%] class for generating plain text.}}
 
 @defmodule/local[scribble/html-render]{
 
-@defmixin[render-mixin (render%) ()]{
+@defmixin[render-mixin (render<%>) ()]{
 
-Specializes a @racket[render%] class for generating HTML output.
+Specializes a @racket[render<%>] class for generating HTML output.
 
 @defmethod[(set-external-tag-path [url string?]) void?]{
 
@@ -284,7 +279,7 @@ directory.}
 
 }
 
-@defmixin[render-multi-mixin (render%) ()]{
+@defmixin[render-multi-mixin (render<%>) ()]{
 
 Further specializes a rendering class produced by
 @racket[render-mixin] for generating multiple HTML
@@ -298,9 +293,9 @@ files.}
 
 @defmodule/local[scribble/latex-render]{
 
-@defmixin[render-mixin (render%) ()]{
+@defmixin[render-mixin (render<%>) ()]{
 
-Specializes a @racket[render%] class for generating Latex input.}}
+Specializes a @racket[render<%>] class for generating Latex input.}}
 
 @; ----------------------------------------
 
@@ -308,7 +303,63 @@ Specializes a @racket[render%] class for generating Latex input.}}
 
 @defmodule/local[scribble/pdf-render]{
 
-@defmixin[render-mixin (render%) ()]{
+@defmixin[render-mixin (render<%>) ()]{
 
-Specializes a @racket[render%] class for generating PDF output via
+Specializes a @racket[render<%>] class for generating PDF output via
 Latex, building on @|latex:render-mixin| from @racketmodname[scribble/latex-render].}}
+
+@; ----------------------------------------
+
+@section{Contract (Blue boxes) Renderer}
+
+@defmodule/local[scribble/contract-render]{
+
+@defmixin[override-render-mixin-multi (render<%>) ()]{
+
+Overrides the @method[render<%> render] method of 
+given renderer to record the content of the 
+blue boxes (generated by @racket[defproc], @racket[defform], etc)
+that appear in the document. 
+   
+@defmethod[#:mode override
+                  (render [srcs (listof part?)]
+                          [dests (listof path?)]
+                          [ri render-info?])
+                  void?]{
+In addition to doing whatever the @racket[super] method
+does, also save the content of the blue boxes (rendered
+via a @racketmodname[scribble/text-render] renderer).
+   
+It saves this information in three pieces in a file
+inside the @racket[dests] directories called
+@filepath{contract-blueboxes.rktd}. The first piece is
+a single line containing a (decimal, ASCII) number. That number
+is the number of bytes that the second piece of information
+occupies in the file. The second piece of information
+is a @racket[hash] that maps @racket[tag?] values to
+a list of offsets and line numbers that follow the hash table.
+For example, if the @racket[hash] maps
+@racket['(def ((lib "x/main.rkt") abcdef))] to
+@racket['((10 . 3))], then that means that the documentation
+for the @racket[abcdef] export from the @racket[x] collection
+starts 10 bytes after the end of the hash table and continues for
+@racket[3] lines. Multiple elements in the list mean that that
+@racket[tag?] has multiple blue boxes and each shows where one
+of the boxes appears in the file.
+}}
+ 
+@defmixin[override-render-mixin-single (render<%>) ()]{
+
+Just like @racket[override-render-mixin-multi], except
+it saves the resulting files in a different place.
+
+@defmethod[#:mode override
+                  (render [srcs (listof part?)]
+                          [dests (listof path?)]
+                          [ri render-info?])
+                  void?]{
+  Just like @method[override-render-mixin-multi render], except
+  that it saves the file @filepath{contract-blueboxes.rktd} in
+  the same directory where each @racket[dests] element resides.
+}}
+}

collects/scribblings/scribble/struct-hierarchy.rkt

@@ -124,9 +124,9 @@
                                              image-element-scale)
                                        #f))
   
-  (define multi-arg-element-name (class-name "multi-arg-\nelement"))
+  (define multiarg-element-name (class-name "multiarg-\nelement"))
-  (define multi-arg-element-tag (field-spec #f "tag"))
+  (define multiarg-element-tag (field-spec #f "tag"))
-  (define multi-arg-element-box (class-box multi-arg-element-name (list multi-arg-element-tag) #f))
+  (define multiarg-element-box (class-box multiarg-element-name (list multiarg-element-tag) #f))
 
   (define target-element-name (class-name "target-\nelement"))
   (define target-tag (field-spec #f "tag"))
@@ -192,7 +192,7 @@
                 (blank 0 50)
                 (inset (ht-append 20 
                                   collect-element-box
-                                  multi-arg-element-box
+                                  multiarg-element-box
                                   (refocus target-element-hierarchy target-element-box)
                                   link-element-box
                                   image-element-box
@@ -203,7 +203,7 @@
            index-element-box
            image-element-box
            target-element-box
-           multi-arg-element-box
+           multiarg-element-box
            link-element-box
            )))
 

collects/scribblings/scribble/xref.scrbl

@@ -20,13 +20,13 @@ by @racket[load-xref], @racket[#f] otherwise.}
 
 
 @defproc[(load-xref [sources (listof (-> any/c))]
-                    [#:render% using-render% (subclass?/c render%)
+                    [#:render% using-render% (implementation?/c render<%>)
                                (render-mixin render%)]
                     [#:root root-path (or/c path-string? false/c) #f])
          xref?]{
 
 Creates a cross-reference record given a list of functions that each
-produce a serialized information obtained from @xmethod[render%
+produce a serialized information obtained from @xmethod[render<%>
 serialize-info]. If a @racket[sources] element produces @racket[#f],
 its result is ignored.
 
@@ -101,7 +101,7 @@ is found in @racket[xref], the result is @racket[#f].}
 @defproc[(xref-tag->path+anchor [xref xref?]
                                 [tag tag?]
                                 [#:external-root-url root-url (or/c string? #f) #f]
-                                [#:render% using-render% (subclass?/c render%)
+                                [#:render% using-render% (implementation?/c render<%>)
                                            (render-mixin render%)])
          (values (or/c false/c path?)
                  (or/c false/c string?))]{
@@ -133,7 +133,7 @@ the binding and its original name.}
 @defproc[(xref-render [xref xref?]
                       [doc part?]
                       [dest (or/c path-string? false/c)]
-                      [#:render% using-render% (subclass?/c render%)
+                      [#:render% using-render% (implemenation?/c render<%>)
                                  (render-mixin render%)]
                       [#:refer-to-existing-files? use-existing? any/c (not dest)])
          (or/c void? any/c)]{
@@ -156,7 +156,7 @@ rendering (such as image files) are referenced from their existing
 locations, instead of copying to the directory of @racket[dest].}
 
 
-@defproc[(xref-transfer-info [renderer (is-a?/c render%)]
+@defproc[(xref-transfer-info [renderer (is-a?/c render<%>)]
                              [ci collect-info?]
                              [xref xref?])
          void?]{