commit c456ffef40291e8600b560ee09d97d76ba99c53d
parent dcb258ac6cf45a263705f3381b2708310a64cfa2
Author: Robby Findler <robby@racket-lang.org>
Date: Sat, 11 Aug 2012 22:56:38 -0500
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
Diffstat:
7 files changed, 343 insertions(+), 81 deletions(-)
diff --git a/collects/scribble/base-render.rkt b/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]
diff --git a/collects/scribble/contract-render.rkt b/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))
diff --git a/collects/scribble/text-render.rkt b/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 %)
- (class %
+(define render-mixin
+ (mixin (render<%>) ()
(define/override (current-render-mode)
'(text))
diff --git a/collects/scribblings/scribble/core.scrbl b/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.
diff --git a/collects/scribblings/scribble/renderer.scrbl b/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% ()]{
-
-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].}
-
+@definterface[render<%> ()]{
@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.
+}}
+}
+\ No newline at end of file
diff --git a/collects/scribblings/scribble/struct-hierarchy.rkt b/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 multi-arg-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-name (class-name "multiarg-\nelement"))
+ (define multiarg-element-tag (field-spec #f "tag"))
+ (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
)))
diff --git a/collects/scribblings/scribble/xref.scrbl b/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?]{
