Scribble: support for "boxable" blocks in Latex output

For example, if you make a multi-column table with a
`racketblock' in each column, then the columns size
to fit the code --- instead of forcing the table width
to match the page width and forcing each column to take
an equal share width.
This commit is contained in:
Matthew Flatt 2011-08-05 07:51:29 -06:00
parent 4ac85de974
commit b7afb3cf8f
15 changed files with 234 additions and 72 deletions

View File

@ -184,6 +184,10 @@
[table-columns ([styles (listof style?)])]
[table-cells ([styless (listof (listof style?))])]
[box-mode ([top-name string?]
[center-name string?]
[bottom-name string?])]
[collected-info ([number (listof (or/c false/c integer?))]
[parent (or/c false/c part?)]
[info any/c])])
@ -191,6 +195,11 @@
(provide plain)
(define plain (make-style #f null))
(define (box-mode* name)
(box-mode name name name))
(provide/contract
[box-mode* (string? . -> . box-mode?)])
;; ----------------------------------------
;; Traverse block has special serialization support:

View File

@ -429,9 +429,6 @@
(syntax/loc stx
(titled-interaction who #f #f racketinput* e ...))]))
(define (code-inset p)
(make-blockquote 'code-inset (list p)))
(define-syntax (interaction stx)
(syntax-case stx ()
[(H e ...) (syntax/loc stx (code-inset (-interaction H e ...)))]))

View File

@ -930,6 +930,7 @@
,@(case (style-name style)
[(author) '([class "author"])]
[(pretitle) '([class "SPretitle"])]
[(wraps) null]
[else null])]
,@contents))))))

View File

@ -20,6 +20,7 @@
(define done-link-page-numbers (make-parameter #f))
(define disable-images (make-parameter #f))
(define escape-brackets (make-parameter #f))
(define suppress-newline-content (make-parameter #f))
(define-struct (toc-paragraph paragraph) ())
@ -111,7 +112,7 @@
[auths (extract-authors d)])
(for ([pre (in-list pres)])
(printf "\n\n")
(do-render-paragraph pre d ri #t))
(do-render-paragraph pre d ri #t #f))
(when date (printf "\\date{~a}\n" date))
(printf "\\titleAnd~aVersionAnd~aAuthors{"
(if (equal? vers "") "Empty" "")
@ -120,7 +121,7 @@
(printf "}{~a}{" vers)
(for/fold ([first? #t]) ([auth (in-list auths)])
(unless first? (printf "\\SAuthorSep{}"))
(do-render-paragraph auth d ri #t)
(do-render-paragraph auth d ri #t #f)
#f)
(printf "}\n"))))
(render-part d ri)
@ -138,7 +139,7 @@
(let ([pres (extract-pretitle d)])
(for ([pre (in-list pres)])
(printf "\n\n")
(do-render-paragraph pre d ri #t)))
(do-render-paragraph pre d ri #t #f)))
(let ([no-number? (and (pair? number)
(or (not (car number))
((length number) . > . 3)))])
@ -169,13 +170,23 @@
null))
(define/override (render-paragraph p part ri)
(do-render-paragraph p part ri #f))
(do-render-paragraph p part ri #f #f))
(define/private (do-render-paragraph p part ri show-pre?)
(define/private (do-render-paragraph p part ri show-pre? as-box-mode)
(let* ([sn (style-name (paragraph-style p))]
[style (if (eq? sn 'author)
"SAuthor"
sn)])
[style (cond
[as-box-mode
(or
(ormap (lambda (a)
(and (box-mode? a)
((box-mode-selector as-box-mode) a)))
(style-properties
(paragraph-style p)))
"hbox")]
[(eq? sn 'author) "SAuthor"]
[(eq? sn 'pretitle) #f]
[(eq? sn 'wraps) #f]
[else sn])])
(unless (and (not show-pre?)
(or (eq? sn 'author)
(eq? sn 'pretitle)))
@ -184,7 +195,10 @@
(printf "\\~a{" style))
(if (toc-paragraph? p)
(printf "\\newpage \\tableofcontents \\newpage")
(super render-paragraph p part ri))
(if as-box-mode
(parameterize ([suppress-newline-content #t])
(super render-paragraph p part ri))
(super render-paragraph p part ri)))
(when use-style? (printf "}")))))
null)
@ -321,7 +335,8 @@
[else
(printf "\\mbox{\\hphantom{\\Scribtexttt{~a}}}"
(regexp-replace* #rx"." s "x"))]))]
[(newline) (printf "\\\\")]
[(newline) (unless (suppress-newline-content)
(printf "\\\\"))]
[else (error 'latex-render
"unrecognzied style symbol: ~s" style)])]
[(string? style-name)
@ -453,7 +468,8 @@
(make-nested-flow (make-style "SingleColumn" null) (map car (table-blockss t)))
part
ri
#t)
#t
#f)
(when (string? s-name)
(printf "\\end{~a}" s-name)))
(unless (or (null? blockss) (null? (car blockss)))
@ -505,7 +521,7 @@
(loop (cdr flows) (add1 n))]
[else n]))])
(unless (= cnt 1) (printf "\\multicolumn{~a}{l}{" cnt))
(render-table-cell (car flows) part ri (/ twidth cnt) (car cell-styles))
(render-table-cell (car flows) part ri (/ twidth cnt) (car cell-styles) (not index?))
(unless (= cnt 1) (printf "}"))
(unless (null? (list-tail flows cnt)) (printf " &\n"))))
(unless (null? (cdr flows)) (loop (cdr flows)
@ -522,33 +538,74 @@
"")))))))
null)
(define/private (render-table-cell p part ri twidth vstyle)
(let ([top? (memq 'top (style-properties vstyle))]
[center? (memq 'vcenter (style-properties vstyle))])
(define/private (render-table-cell p part ri twidth vstyle can-box?)
(let* ([top? (or (memq 'top (style-properties vstyle))
(memq 'baseline (style-properties vstyle)))]
[bottom? (and (not top?)
(memq 'bottom (style-properties vstyle)))]
[center? (and (not bottom?)
(not top?))]
[as-box? (and can-box? (boxable? p))])
(when (style-name vstyle)
(printf "\\~a{" (style-name vstyle)))
(let ([minipage? (and (not (table? p))
(or (not (paragraph? p))
top?
center?))])
(when minipage?
(printf "\\begin{minipage}~a{~a\\linewidth}\n"
(cond
[top? "[t]"]
[center? "[c]"]
[else ""])
(/ 1.0 twidth)))
(if (table? p)
(render-table* p part ri #f (cond
[center? "[c]"]
[else "[t]"]))
(render-block p part ri #f))
(when minipage?
(printf " \\end{minipage}\n")))
(let ([minipage? (and can-box? (not as-box?))])
(when minipage?
(printf "\\begin{minipage}~a{~a\\linewidth}\n"
(cond
[top? "[t]"]
[center? "[c]"]
[else ""])
(/ 1.0 twidth)))
(cond
[(table? p)
(render-table* p part ri #f (cond
[top? "[t]"]
[center? "[c]"]
[else "[b]"]))]
[as-box?
(render-boxable-block p part ri (cond
[top? 't]
[center? 'c]
[else 'b]))]
[else
(render-block p part ri #f)])
(when minipage?
(printf " \\end{minipage}\n")))
(when (style-name vstyle)
(printf "}"))
null))
(define/private (boxable? p)
(or (and (table? p)
(for* ([l (in-list (table-blockss p))]
[p (in-list l)])
(boxable? p)))
(and (nested-flow? p)
(or (and (= 1 (length (nested-flow-blocks p)))
(memq (style-name (nested-flow-style p))
'(code-inset vertical-inset)))
(and
(ormap box-mode? (style-properties (nested-flow-style p)))
(andmap (lambda (p) (boxable? p)) (nested-flow-blocks p)))))
(and (paragraph? p)
(or (not (style-name (paragraph-style p)))
(ormap box-mode? (style-properties (paragraph-style p)))))))
(define/private (render-boxable-block p part ri mode)
(cond
[(table? p)
(render-table* p part ri #f (format "[~a]" mode))]
[(nested-flow? p)
(do-render-nested-flow p part ri #f mode)]
[(paragraph? p)
(do-render-paragraph p part ri #f mode)]))
(define/private (box-mode-selector as-box-mode)
(case as-box-mode
[(t) box-mode-top-name]
[(c) box-mode-center-name]
[(b) box-mode-bottom-name]))
(define/override (render-itemization t part ri)
(let* ([style-str (let ([s (style-name (itemization-style t))])
(if (eq? s 'compact)
@ -570,16 +627,27 @@
(printf "\\end{~a}" mode)
null))
(define/private (do-render-nested-flow t part ri single-column?)
(let* ([kind (or (let ([s (style-name (nested-flow-style t))])
(define/private (do-render-nested-flow t part ri single-column? as-box-mode)
(let* ([props (style-properties (nested-flow-style t))]
[kind (or (and as-box-mode
(or
(ormap (lambda (a)
(and (box-mode? a)
((box-mode-selector as-box-mode) a)))
props)
(case (style-name (nested-flow-style t))
[(code-inset) "SCodeInsetBox"]
[(vertical-inset) "SVInsetBox"]
[else (error "unexpected style for box mode")])))
(let ([s (style-name (nested-flow-style t))])
(or (and (string? s) s)
(and (eq? s 'inset) "quote")
(and (eq? s 'code-inset) "SCodeFlow")
(and (eq? s 'vertical-inset) "SVInsetFlow")))
"Subflow")]
[props (style-properties (nested-flow-style t))]
[command? (memq 'command props)]
[multicommand? (memq 'multicommand props)])
[multicommand? (memq 'multicommand props)]
[command? (or (and as-box-mode (not multicommand?))
(memq 'command props))])
(cond
[command? (printf "\\~a{" kind)]
[multicommand? (printf "\\~a" kind)]
@ -588,7 +656,13 @@
(not (current-table-mode)))
(current-table-mode)
(list "nested-flow" t))])
(render-flow (nested-flow-blocks t) part ri #f multicommand?))
(if as-box-mode
(for-each (lambda (p)
(when multicommand? (printf "{"))
(render-boxable-block p part ri as-box-mode)
(when multicommand? (printf "}")))
(nested-flow-blocks t))
(render-flow (nested-flow-blocks t) part ri #f multicommand?)))
(cond
[command? (printf "}")]
[multicommand? (void)]
@ -596,7 +670,7 @@
null))
(define/override (render-nested-flow t part ri)
(do-render-nested-flow t part ri #f))
(do-render-nested-flow t part ri #f #f))
(define/override (render-compound-paragraph t part ri starting-item?)
(let ([kind (style-name (compound-paragraph-style t))]

View File

@ -5,6 +5,7 @@
"../core.rkt"
"../base.rkt"
"manual-scheme.rkt"
"manual-style.rkt"
scribble/core
(for-syntax racket/base
syntax/parse))
@ -44,9 +45,6 @@
#'#f))
#:line-numbers line-numbers)]))
(define (code-inset p)
(make-nested-flow (make-style 'code-inset '()) (list p)))
(define-syntax (codeblock stx) #`(code-inset #,(do-codeblock stx)))
(define-syntax (codeblock0 stx) (do-codeblock stx))

View File

@ -347,7 +347,7 @@
(make-box-splice
(cons
(make-blockquote
'vertical-inset
vertical-inset-style
(list
(make-table
'boxed
@ -384,7 +384,7 @@
"leftindent"
(cons
(make-blockquote
'vertical-inset
vertical-inset-style
(list
(make-table
'boxed

View File

@ -465,7 +465,7 @@
(make-box-splice
(cons
(make-blockquote
'vertical-inset
vertical-inset-style
(list
(make-table
'boxed
@ -761,7 +761,7 @@
(make-box-splice
(cons
(make-blockquote
'vertical-inset
vertical-inset-style
(list main-table))
(content-thunk))))
@ -788,7 +788,7 @@
(make-box-splice
(cons
(make-blockquote
'vertical-inset
vertical-inset-style
(list
(make-table
'boxed

View File

@ -4,6 +4,7 @@
"../scheme.rkt"
"../search.rkt"
"../basic.rkt"
(only-in "../core.rkt" make-style box-mode)
racket/list
"manual-utils.rkt"
"manual-style.rkt"
@ -48,9 +49,6 @@
(define-code RACKETBLOCK to-block-paragraph UNSYNTAX)
(define-code RACKETBLOCK0 to-paragraph UNSYNTAX)
(define (code-inset b)
(make-blockquote 'code-inset (list b)))
(define (to-block-paragraph v)
(code-inset (to-paragraph v)))

View File

@ -5,7 +5,7 @@
(only-in "../basic.rkt" aux-elem itemize)
"../scheme.rkt"
(only-in "../core.rkt" make-style plain
make-nested-flow
make-nested-flow box-mode box-mode*
[element? core:element?])
"manual-utils.rkt"
"on-demand.rkt"
@ -20,7 +20,8 @@
image
(rename-out [image image/plain])
itemize
aux-elem)
aux-elem
code-inset)
(provide/contract [filebox ((or/c core:element? string?) pre-flow? . -> . block?)])
(define styling-f/c
@ -153,6 +154,11 @@
(define (inset-flow . c)
(make-blockquote "insetpara" (flow-paragraphs (decode-flow c))))
(define code-inset-style
(make-style 'code-inset null))
(define (code-inset b)
(make-blockquote code-inset-style (list b)))
(define (commandline . s)
(make-paragraph (cons (hspace 2) (map (lambda (s)
(if (string? s)
@ -225,7 +231,9 @@
(define (filebox filename . inside)
(make-nested-flow
(make-style "Rfilebox" scheme-properties)
(make-style "Rfilebox" (list* 'multicommand
(box-mode "RfileboxBoxT" "RfileboxBoxC" "RfileboxBoxB")
scheme-properties))
(list
(make-styled-paragraph
(list (make-element
@ -233,9 +241,9 @@
(if (string? filename)
(filepath filename)
filename)))
(make-style "Rfiletitle" scheme-properties))
(make-style "Rfiletitle" (cons (box-mode* "RfiletitleBox") scheme-properties)))
(make-nested-flow
(make-style "Rfilecontent" scheme-properties)
(make-style "Rfilecontent" (cons (box-mode* "RfilecontentBox") scheme-properties))
(decode-flow inside)))))

View File

@ -2,7 +2,8 @@
(require "../decode.rkt"
"../scheme.rkt"
"../struct.rkt"
(only-in "../core.rkt" style-name
(only-in "../core.rkt"
make-style style-name
nested-flow? nested-flow-blocks nested-flow-style)
scheme/contract
(for-syntax scheme/base
@ -13,11 +14,15 @@
(define-struct (box-splice splice) ())
(define vertical-inset-style
(make-style 'vertical-inset null))
(provide/contract
[struct (box-splice splice) ([run list?])]) ; XXX ugly copying
(provide deftogether *deftogether
with-racket-variables
with-togetherable-racket-variables)
with-togetherable-racket-variables
vertical-inset-style)
(begin-for-syntax (define-struct deftogether-tag () #:omit-define-syntaxes))
@ -106,7 +111,7 @@
(make-box-splice
(cons
(make-blockquote
'vertical-inset
vertical-inset-style
(list
(make-table
'boxed
@ -115,7 +120,7 @@
(unless (and (box-splice? box)
(= 1 (length (splice-run box)))
(nested-flow? (car (splice-run box)))
(eq? 'vertical-inset (style-name (nested-flow-style (car (splice-run box)))))
(eq? vertical-inset-style (nested-flow-style (car (splice-run box))))
(let ([l (nested-flow-blocks (car (splice-run box)))])
(= 1 (length l))
(table? (car l))

View File

@ -176,8 +176,6 @@
}
.Rfilebox {
margin-left: 1em;
margin-right: 1em;
}
.Rfiletitle {

View File

@ -50,9 +50,17 @@
\newenvironment{leftindent}{\begin{quote}}{\end{quote}}
\newenvironment{insetpara}{\begin{quote}}{\end{quote}}
\newcommand{\Rfilebox}[2]{\begin{list}{}{\topsep=0pt\partopsep=0pt%
\listparindent=0pt\itemindent=0pt\labelwidth=0pt\leftmargin=0ex\rightmargin=0ex%
\itemsep=0pt\parsep=0pt}\item #1
#2\end{list}}
\newcommand{\RfileboxBox}[3]{#3{\halign{\hfil##\cr #1 \cr #2 \cr}}}
\newcommand{\RfileboxBoxT}[2]{\RfileboxBox{#1}{#2}{\vtop}}
\newcommand{\RfileboxBoxC}[2]{\RfileboxBox{#1}{#2}{\Svcenter}}
\newcommand{\RfileboxBoxB}[2]{\RfileboxBox{#1}{#2}{\vbox}}
\newcommand{\Rfiletitle}[1]{\hfill \fbox{#1}}
\newcommand{\RfiletitleBox}[1]{\fbox{#1}}
\newcommand{\Rfilename}[1]{#1}
\newenvironment{Rfilebox}{\begin{list}{}{\topsep=0pt\partopsep=0pt%
\listparindent=0pt\itemindent=0pt\labelwidth=0pt\leftmargin=2ex\rightmargin=2ex%
\itemsep=0pt\parsep=0pt}\item}{\end{list}}
\newenvironment{Rfilecontent}{}{}
\newcommand{\RfilecontentBox}[1]{#1}

View File

@ -363,7 +363,7 @@ i {
display: block;
margin-left: 1em;
margin-bottom: 0em;
margin-right: 0em;
margin-right: 1em;
margin-top: 0em;
white-space: nowrap;
}

View File

@ -102,8 +102,9 @@
\newcommand{\SCodePreSkip}{\vskip\abovedisplayskip}
\newcommand{\SCodePostSkip}{\vskip\belowdisplayskip}
\newenvironment{SCodeFlow}{\SCodePreSkip\begin{list}{}{\topsep=0pt\partopsep=0pt%
\listparindent=0pt\itemindent=0pt\labelwidth=0pt\leftmargin=2ex\rightmargin=0pt%
\listparindent=0pt\itemindent=0pt\labelwidth=0pt\leftmargin=2ex\rightmargin=2ex%
\itemsep=0pt\parsep=0pt}\item}{\end{list}\SCodePostSkip}
\newcommand{\SCodeInsetBox}[1]{\setbox1=\hbox{\hbox{\hspace{2ex}#1\hspace{2ex}}}\vbox{\SCodePreSkip\vtop{\box1\SCodePostSkip}}}
% Inset a 'vertical-inset nested flow:
\newcommand{\SVInsetPreSkip}{\vskip\abovedisplayskip}
@ -111,6 +112,7 @@
\newenvironment{SVInsetFlow}{\SVInsetPreSkip\begin{list}{}{\topsep=0pt\partopsep=0pt%
\listparindent=0pt\itemindent=0pt\labelwidth=0pt\leftmargin=0pt\rightmargin=0pt%
\itemsep=0pt\parsep=0pt}\item}{\end{list}\SVInsetPostSkip}
\newcommand{\SVInsetBox}[1]{\setbox1=\hbox{\hbox{#1}}\vbox{\SCodePreSkip\vtop{\box1\SCodePostSkip}}}
% The 'compact itemization style:
\newenvironment{compact}{\begin{itemize}}{\end{itemize}}
@ -148,6 +150,9 @@
\newcommand{\SOpenSq}{[}
\newcommand{\SCloseSq}{]}
% Helper for box-mode macros:
\newcommand{\Svcenter}[1]{$\vcenter{#1}$}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Scribble then generates the following:

View File

@ -417,8 +417,14 @@ recognized:
@item{@racket['pretitle] --- Typeset before the title of the
enclosing part.}
@item{@racket['wraps] --- Like a @racket[#f] style name, but not
@tech{boxable} in the sense of @racket[box-mode] for Latex output.}
]
When a paragraph's style is @racket[#f], then it is @tech{boxable} in the
sense of @racket[box-mode] for Latex output.
The currently recognized @tech{style properties} are as follows:
@itemize[
@ -444,6 +450,10 @@ The currently recognized @tech{style properties} are as follows:
@item{@racket['never-indents] --- For Latex and @tech{compound
paragraphs}; see @racket[compound-paragraph].}
@item{@racket[box-mode] --- For Latex output, uses an alternate
rendering form for @tech{boxing contexts} (such as a table cell); see
@racket[box-mode].}
]}
@ -556,10 +566,14 @@ names are recognized:
surrounding text.}
@item{@racket['code-inset] --- Insets the nested flow relative to
surrounding text in a way suitable for code.}
surrounding text in a way suitable for code. If the nested flow
has a single block, then it is @tech{boxable} in the sense of
@racket[box-mode] for Latex output.}
@item{@racket['vertical-inset] --- Insets the nested flow vertically
relative to surrounding text, but not horizontally.}
relative to surrounding text, but not horizontally. If the
nested flow has a single block, then it is @tech{boxable} in the sense
of @racket[box-mode] for Latex output.}
]
@ -584,6 +598,10 @@ The following @tech{style properties} are currently recognized:
@item{@racket['never-indents] --- For Latex and @tech{compound
paragraphs}; see @racket[compound-paragraph].}
@item{@racket[box-mode] --- For Latex output, uses an alternate
rendering form for @tech{boxing contexts} (such as a table cell); see
@racket[box-mode].}
]}
@ -955,6 +973,7 @@ are used as RGB levels.}
Like @racket[color-property], but sets the background color.}
@defstruct[table-cells ([styless (listof (listof style?))])]{
Used as a @tech{style property} for a @racket[table] to set its cells'
@ -987,12 +1006,54 @@ In addition, for HTML output, @racket[attributes] structures as
@tech{style properties} can add arbitrary attributes to a cell's
@tt{<td>} tag.}
@defstruct[table-columns ([styles (listof style?)])]{
Like @racket[table-cells], but the @racket[styles] list is duplicated
for each row in the table. This @tech{style property} is used only when a
@racket[table-cells] is not present in a style's list of properties.}
@deftogether[(
@defstruct[box-mode ([top-name string?]
[center-name string?]
[bottom-name string?])]
@defproc[(box-mode* [name string?]) box-mode?]
)]{
As a @tech{style property}, indicates that a @tech{nested flow} or
@tech{paragraph} is @deftech{boxable} when it is used in a
@deftech{boxing context} for Latex output, but a @tech{nested flow} is
@tech{boxable} only if its content is also @tech{boxable}.
A @tech{boxing context} starts with a table cell in a multi-column
table, and the content of a @tech{block} in a @tech{boxing context} is
also in a @tech{boxing context}. If the cell's content is
@tech{boxable}, then the content determines the width of the cell,
otherwise a width is imposed. A @tech{paragraph} with a @racket[#f]
@tech{style name} is @tech{boxable} as a single line; the
@racket['wraps] @tech{style name} makes the paragraph
non-@tech{boxable} so that its width is imposed and its content can
use multiple lines. A @tech{table} is @tech{boxable} when that all of
its cell content is boxable.
To generate output in box mode, the @racket[box-mode] property
supplies Latex macro names to apply to the @tech{nested flow} or
@tech{paragraph} content. The @racket[top-name] macro is used if the
box's top line is to be aligned with other boxes, @racket[center-name]
if the box's center is to be aligned, and @racket[bottom-name] if the
box's bottom line is to be aligned. The @racket[box-mode*] function
creates a @racket[box-mode] structure with the same name for all three
fields.
A @racket[box-mode] @tech{style property} overrides any automatic
boxed rendering (e.g., for a @tech{paragraph} with @tech{style name}
@racket[#f]). If a @tech{block} has both a @racket[box-mode]
@tech{style property} and a @racket['multicommand] @tech{style
property}, then the Latex macro @racket[top-name],
@racket[center-name], or @racket[bottom-name] is applied with a
separate argument for each of its content.}
@defproc[(block? [v any/c]) boolean?]{
Returns @racket[#t] if @racket[v] is a @racket[paragraph],