Scribble: style adjustments to deter code wrapping
For HTML, the style used in the output of `racketblock' now disables line wrapping, and the Rkt text styles inherit line-wrap behavior. This doesn't solve the general problem of code overflowing the horizontal space, but it makes the failure mode usefully better. A new 'vertical-inset nested-flow style is used by `defproc', `defform', etc. It has no effect for HTML, but it introduces suitable vertical space for Latex output (in case you want to use `defproc' in a SIGPLAN-format paper, for example). original commit: 4ac85de974ec2e6326df129745228b3ffcbb778f
This commit is contained in:
Matthew Flatt
parent
825e3fcea8
commit
2e8e709b7f
|
|
@ -1271,12 +1271,15 @@
|
|||
|
||||
(define/override (render-nested-flow t part ri)
|
||||
`((blockquote [,@(style->attribs (nested-flow-style t))
|
||||
,@(if (eq? 'code-inset (style-name (nested-flow-style t)))
|
||||
`([class "SCodeFlow"])
|
||||
(if (and (not (string? (style-name (nested-flow-style t))))
|
||||
(not (eq? 'inset (style-name (nested-flow-style t)))))
|
||||
`([class "SubFlow"])
|
||||
null))]
|
||||
,@(cond
|
||||
[(eq? 'code-inset (style-name (nested-flow-style t)))
|
||||
`([class "SCodeFlow"])]
|
||||
[(eq? 'vertical-inset (style-name (nested-flow-style t)))
|
||||
`([class "SVInsetFlow"])]
|
||||
[(and (not (string? (style-name (nested-flow-style t))))
|
||||
(not (eq? 'inset (style-name (nested-flow-style t)))))
|
||||
`([class "SubFlow"])]
|
||||
[else null])]
|
||||
,@(append-map (lambda (i) (render-block i part ri #f))
|
||||
(nested-flow-blocks t)))))
|
||||
|
||||
|
|
|
|||
|
|
@ -574,7 +574,8 @@
|
|||
(let* ([kind (or (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 'code-inset) "SCodeFlow")
|
||||
(and (eq? s 'vertical-inset) "SVInsetFlow")))
|
||||
"Subflow")]
|
||||
[props (style-properties (nested-flow-style t))]
|
||||
[command? (memq 'command props)]
|
||||
|
|
|
|||
|
|
@ -346,33 +346,36 @@
|
|||
(parameterize ([current-meta-list '(... ...+)])
|
||||
(make-box-splice
|
||||
(cons
|
||||
(make-table
|
||||
'boxed
|
||||
(append
|
||||
(map
|
||||
(lambda (form form-proc)
|
||||
(list
|
||||
(make-flow
|
||||
(make-blockquote
|
||||
'vertical-inset
|
||||
(list
|
||||
(make-table
|
||||
'boxed
|
||||
(append
|
||||
(map
|
||||
(lambda (form form-proc)
|
||||
(list
|
||||
((or form-proc
|
||||
(lambda (x)
|
||||
(make-omitable-paragraph
|
||||
(list (to-element `(,x . ,(cdr form)))))))
|
||||
(and kw-id
|
||||
(eq? form (car forms))
|
||||
(defform-site kw-id)))))))
|
||||
forms form-procs)
|
||||
(if (null? sub-procs)
|
||||
null
|
||||
(list (list flow-empty-line)
|
||||
(list (make-flow
|
||||
(list (let ([l (map (lambda (sub)
|
||||
(map (lambda (f) (f)) sub))
|
||||
sub-procs)])
|
||||
(*racketrawgrammars "specgrammar"
|
||||
(map car l)
|
||||
(map cdr l))))))))
|
||||
(make-contracts-table contract-procs)))
|
||||
(make-flow
|
||||
(list
|
||||
((or form-proc
|
||||
(lambda (x)
|
||||
(make-omitable-paragraph
|
||||
(list (to-element `(,x . ,(cdr form)))))))
|
||||
(and kw-id
|
||||
(eq? form (car forms))
|
||||
(defform-site kw-id)))))))
|
||||
forms form-procs)
|
||||
(if (null? sub-procs)
|
||||
null
|
||||
(list (list flow-empty-line)
|
||||
(list (make-flow
|
||||
(list (let ([l (map (lambda (sub)
|
||||
(map (lambda (f) (f)) sub))
|
||||
sub-procs)])
|
||||
(*racketrawgrammars "specgrammar"
|
||||
(map car l)
|
||||
(map cdr l))))))))
|
||||
(make-contracts-table contract-procs)))))
|
||||
(content-thunk)))))
|
||||
|
||||
(define (*specsubform form lits form-thunk subs sub-procs contract-procs content-thunk)
|
||||
|
|
@ -380,27 +383,30 @@
|
|||
(make-blockquote
|
||||
"leftindent"
|
||||
(cons
|
||||
(make-table
|
||||
'boxed
|
||||
(cons
|
||||
(list
|
||||
(make-flow
|
||||
(make-blockquote
|
||||
'vertical-inset
|
||||
(list
|
||||
(make-table
|
||||
'boxed
|
||||
(cons
|
||||
(list
|
||||
(if form-thunk
|
||||
(form-thunk)
|
||||
(make-omitable-paragraph (list (to-element form)))))))
|
||||
(append
|
||||
(if (null? sub-procs)
|
||||
null
|
||||
(list (list flow-empty-line)
|
||||
(list (make-flow
|
||||
(list (let ([l (map (lambda (sub)
|
||||
(map (lambda (f) (f)) sub))
|
||||
sub-procs)])
|
||||
(*racketrawgrammars "specgrammar"
|
||||
(map car l)
|
||||
(map cdr l))))))))
|
||||
(make-contracts-table contract-procs))))
|
||||
(make-flow
|
||||
(list
|
||||
(if form-thunk
|
||||
(form-thunk)
|
||||
(make-omitable-paragraph (list (to-element form)))))))
|
||||
(append
|
||||
(if (null? sub-procs)
|
||||
null
|
||||
(list (list flow-empty-line)
|
||||
(list (make-flow
|
||||
(list (let ([l (map (lambda (sub)
|
||||
(map (lambda (f) (f)) sub))
|
||||
sub-procs)])
|
||||
(*racketrawgrammars "specgrammar"
|
||||
(map car l)
|
||||
(map cdr l))))))))
|
||||
(make-contracts-table contract-procs))))))
|
||||
(flow-paragraphs (decode-flow (content-thunk)))))))
|
||||
|
||||
(define (*racketrawgrammars style nonterms clauseses)
|
||||
|
|
|
|||
|
|
@ -464,17 +464,20 @@
|
|||
(append* all-args)))
|
||||
(make-box-splice
|
||||
(cons
|
||||
(make-table
|
||||
'boxed
|
||||
(append-map
|
||||
do-one
|
||||
stx-ids prototypes all-args arg-contractss arg-valss result-contracts
|
||||
(let loop ([ps prototypes] [accum null])
|
||||
(cond [(null? ps) null]
|
||||
[(ormap (lambda (a) (eq? (extract-id (car ps)) a)) accum)
|
||||
(cons #f (loop (cdr ps) accum))]
|
||||
[else (cons #t (loop (cdr ps)
|
||||
(cons (extract-id (car ps)) accum)))]))))
|
||||
(make-blockquote
|
||||
'vertical-inset
|
||||
(list
|
||||
(make-table
|
||||
'boxed
|
||||
(append-map
|
||||
do-one
|
||||
stx-ids prototypes all-args arg-contractss arg-valss result-contracts
|
||||
(let loop ([ps prototypes] [accum null])
|
||||
(cond [(null? ps) null]
|
||||
[(ormap (lambda (a) (eq? (extract-id (car ps)) a)) accum)
|
||||
(cons #f (loop (cdr ps) accum))]
|
||||
[else (cons #t (loop (cdr ps)
|
||||
(cons (extract-id (car ps)) accum)))]))))))
|
||||
(content-thunk))))
|
||||
|
||||
(define-syntax-rule (defparam id arg contract desc ...)
|
||||
|
|
@ -757,7 +760,9 @@
|
|||
fields field-contracts))))
|
||||
(make-box-splice
|
||||
(cons
|
||||
main-table
|
||||
(make-blockquote
|
||||
'vertical-inset
|
||||
(list main-table))
|
||||
(content-thunk))))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
|
@ -782,83 +787,86 @@
|
|||
[result-values (map (lambda (x) #f) result-contracts)])
|
||||
(make-box-splice
|
||||
(cons
|
||||
(make-table
|
||||
'boxed
|
||||
(map
|
||||
(lambda (stx-id name result-contract result-value)
|
||||
(list
|
||||
(make-flow
|
||||
(make-table-if-necessary
|
||||
"argcontract"
|
||||
(let* ([result-block
|
||||
(and result-value
|
||||
(if (block? result-value)
|
||||
result-value
|
||||
(make-omitable-paragraph (list result-value))))]
|
||||
[contract-block
|
||||
(if (block? result-contract)
|
||||
result-contract
|
||||
(make-omitable-paragraph (list result-contract)))]
|
||||
[total-width (+ (string-length (format "~a" name))
|
||||
3
|
||||
(block-width contract-block)
|
||||
(if result-block
|
||||
(+ (block-width result-block) 3)
|
||||
0))])
|
||||
(append
|
||||
(list
|
||||
(append
|
||||
(list
|
||||
(make-flow
|
||||
(make-blockquote
|
||||
'vertical-inset
|
||||
(list
|
||||
(make-table
|
||||
'boxed
|
||||
(map
|
||||
(lambda (stx-id name result-contract result-value)
|
||||
(list
|
||||
(make-flow
|
||||
(make-table-if-necessary
|
||||
"argcontract"
|
||||
(let* ([result-block
|
||||
(and result-value
|
||||
(if (block? result-value)
|
||||
result-value
|
||||
(make-omitable-paragraph (list result-value))))]
|
||||
[contract-block
|
||||
(if (block? result-contract)
|
||||
result-contract
|
||||
(make-omitable-paragraph (list result-contract)))]
|
||||
[total-width (+ (string-length (format "~a" name))
|
||||
3
|
||||
(block-width contract-block)
|
||||
(if result-block
|
||||
(+ (block-width result-block) 3)
|
||||
0))])
|
||||
(append
|
||||
(list
|
||||
(make-omitable-paragraph
|
||||
(append
|
||||
(list
|
||||
(let ([target-maker
|
||||
((if form? id-to-form-target-maker id-to-target-maker)
|
||||
stx-id #t)]
|
||||
[content (list (definition-site name stx-id form?))])
|
||||
(if target-maker
|
||||
(target-maker
|
||||
content
|
||||
(lambda (tag)
|
||||
(make-toc-target-element
|
||||
#f
|
||||
(list
|
||||
(make-index-element
|
||||
#f
|
||||
content
|
||||
tag
|
||||
(list (symbol->string name))
|
||||
content
|
||||
(with-exporting-libraries
|
||||
(lambda (libs) (make-thing-index-desc name libs)))))
|
||||
tag)))
|
||||
(car content)))))))
|
||||
(make-flow
|
||||
(list
|
||||
(make-omitable-paragraph
|
||||
(list
|
||||
spacer ":" spacer))))
|
||||
(make-flow (list contract-block)))
|
||||
(if (and result-value
|
||||
(total-width . < . 60))
|
||||
(list
|
||||
(to-flow (make-element #f (list spacer "=" spacer)))
|
||||
(make-flow (list result-block)))
|
||||
null)))
|
||||
(if (and result-value
|
||||
(total-width . >= . 60))
|
||||
(list
|
||||
(list
|
||||
(make-table-if-necessary
|
||||
"argcontract"
|
||||
(list
|
||||
(list flow-spacer
|
||||
(to-flow (make-element #f (list spacer "=" spacer)))
|
||||
(make-flow (list result-block)))))
|
||||
'cont))
|
||||
null)))))))
|
||||
stx-ids names result-contracts result-values))
|
||||
(make-flow
|
||||
(list
|
||||
(make-omitable-paragraph
|
||||
(list
|
||||
(let ([target-maker
|
||||
((if form? id-to-form-target-maker id-to-target-maker)
|
||||
stx-id #t)]
|
||||
[content (list (definition-site name stx-id form?))])
|
||||
(if target-maker
|
||||
(target-maker
|
||||
content
|
||||
(lambda (tag)
|
||||
(make-toc-target-element
|
||||
#f
|
||||
(list
|
||||
(make-index-element
|
||||
#f
|
||||
content
|
||||
tag
|
||||
(list (symbol->string name))
|
||||
content
|
||||
(with-exporting-libraries
|
||||
(lambda (libs) (make-thing-index-desc name libs)))))
|
||||
tag)))
|
||||
(car content)))))))
|
||||
(make-flow
|
||||
(list
|
||||
(make-omitable-paragraph
|
||||
(list
|
||||
spacer ":" spacer))))
|
||||
(make-flow (list contract-block)))
|
||||
(if (and result-value
|
||||
(total-width . < . 60))
|
||||
(list
|
||||
(to-flow (make-element #f (list spacer "=" spacer)))
|
||||
(make-flow (list result-block)))
|
||||
null)))
|
||||
(if (and result-value
|
||||
(total-width . >= . 60))
|
||||
(list
|
||||
(list
|
||||
(make-table-if-necessary
|
||||
"argcontract"
|
||||
(list
|
||||
(list flow-spacer
|
||||
(to-flow (make-element #f (list spacer "=" spacer)))
|
||||
(make-flow (list result-block)))))
|
||||
'cont))
|
||||
null)))))))
|
||||
stx-ids names result-contracts result-values))))
|
||||
(content-thunk))))
|
||||
|
||||
(define (defthing/proc id contract descs)
|
||||
|
|
|
|||
|
|
@ -2,7 +2,8 @@
|
|||
(require "../decode.rkt"
|
||||
"../scheme.rkt"
|
||||
"../struct.rkt"
|
||||
(only-in "../core.rkt" style-name)
|
||||
(only-in "../core.rkt" style-name
|
||||
nested-flow? nested-flow-blocks nested-flow-style)
|
||||
scheme/contract
|
||||
(for-syntax scheme/base
|
||||
syntax/kerncase
|
||||
|
|
@ -104,21 +105,28 @@
|
|||
(define (*deftogether boxes body-thunk)
|
||||
(make-box-splice
|
||||
(cons
|
||||
(make-table
|
||||
'boxed
|
||||
(map
|
||||
(lambda (box)
|
||||
(unless (and (box-splice? box)
|
||||
(= 1 (length (splice-run box)))
|
||||
(table? (car (splice-run box)))
|
||||
(eq? 'boxed (style-name (table-style (car (splice-run box))))))
|
||||
(error 'deftogether
|
||||
"element is not a boxing splice containing a single table: ~e"
|
||||
box))
|
||||
(list (make-flow (list (make-table
|
||||
"together"
|
||||
(table-flowss (car (splice-run box))))))))
|
||||
boxes))
|
||||
(make-blockquote
|
||||
'vertical-inset
|
||||
(list
|
||||
(make-table
|
||||
'boxed
|
||||
(map
|
||||
(lambda (box)
|
||||
(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)))))
|
||||
(let ([l (nested-flow-blocks (car (splice-run box)))])
|
||||
(= 1 (length l))
|
||||
(table? (car l))
|
||||
(eq? 'boxed (style-name (table-style (car l))))))
|
||||
(error 'deftogether
|
||||
"element is not a boxing splice containing a single nested-flow with a single table: ~e"
|
||||
box))
|
||||
(list (make-flow (list (make-table
|
||||
"together"
|
||||
(table-flowss (car (nested-flow-blocks (car (splice-run box))))))))))
|
||||
boxes))))
|
||||
(body-thunk))))
|
||||
|
||||
(define-syntax (deftogether stx)
|
||||
|
|
|
|||
|
|
@ -6,6 +6,7 @@
|
|||
.RktMod, .RktKw, .RktVar, .RktSym,
|
||||
.RktRes, .RktOut, .RktCmt, .RktVal {
|
||||
font-family: monospace;
|
||||
white-space: inherit;
|
||||
}
|
||||
|
||||
/* Serif: */
|
||||
|
|
@ -130,8 +131,17 @@
|
|||
vertical-align: bottom;
|
||||
}
|
||||
|
||||
.RktBlk {
|
||||
white-space: inherit;
|
||||
}
|
||||
|
||||
.RktBlk tr {
|
||||
white-space: inherit;
|
||||
}
|
||||
|
||||
.RktBlk td {
|
||||
vertical-align: baseline;
|
||||
white-space: inherit;
|
||||
}
|
||||
|
||||
.argcontract td {
|
||||
|
|
|
|||
|
|
@ -365,6 +365,15 @@ i {
|
|||
margin-bottom: 0em;
|
||||
margin-right: 0em;
|
||||
margin-top: 0em;
|
||||
white-space: nowrap;
|
||||
}
|
||||
|
||||
.SVInsetFlow {
|
||||
display: block;
|
||||
margin-left: 0em;
|
||||
margin-bottom: 0em;
|
||||
margin-right: 0em;
|
||||
margin-top: 0em;
|
||||
}
|
||||
|
||||
.SubFlow {
|
||||
|
|
|
|||
|
|
@ -105,6 +105,13 @@
|
|||
\listparindent=0pt\itemindent=0pt\labelwidth=0pt\leftmargin=2ex\rightmargin=0pt%
|
||||
\itemsep=0pt\parsep=0pt}\item}{\end{list}\SCodePostSkip}
|
||||
|
||||
% Inset a 'vertical-inset nested flow:
|
||||
\newcommand{\SVInsetPreSkip}{\vskip\abovedisplayskip}
|
||||
\newcommand{\SVInsetPostSkip}{\vskip\belowdisplayskip}
|
||||
\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}
|
||||
|
||||
% The 'compact itemization style:
|
||||
\newenvironment{compact}{\begin{itemize}}{\end{itemize}}
|
||||
\newcommand{\compactItem}[1]{\item #1}
|
||||
|
|
|
|||
|
|
@ -558,6 +558,9 @@ names are recognized:
|
|||
@item{@racket['code-inset] --- Insets the nested flow relative to
|
||||
surrounding text in a way suitable for code.}
|
||||
|
||||
@item{@racket['vertical-inset] --- Insets the nested flow vertically
|
||||
relative to surrounding text, but not horizontally.}
|
||||
|
||||
]
|
||||
|
||||
The following @tech{style properties} are currently recognized:
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user