suzanne.soy/scribble-enhanced
1
0
Fork 0
Code Issues 1 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

scribble/base: add #:{column,row,cell}-properties arguments to tabular

Browse Source 
The new arguments greatly simplify adding properties such as alignment
and (HTML) background colors to table cells. For example, to make a
table with 'right alignment for the left-hand column, 'center alignment
for the second column, and 'left alignment for all remaining columns:

 (tabular cells
          #:sep (hspace 1)
          #:column-properties '(right center left))

Also, make `color-property` and `background-color-property` recognized
as table-cell style properties.

Finally, implement horizontal alignment for text rendering.

original commit: 316fc0dbf5e26061245d815c992cc54d9738aa79
This commit is contained in:
Matthew Flatt 2014-03-24 18:06:29 -06:00
parent 87201fe4e0
commit 0fd78b8ca8
7 changed files with 325 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

89
pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/base.scrbl
View File

@ -241,23 +241,88 @@ Returns @racket[#t] if @racket[v] is an item produced by
@defproc[(tabular [cells (listof (listof (or/c block? content? 'cont)))]
[#:style style (or/c style? string? symbol? #f) #f]
[#:sep sep (or/c block? content? #f) #f])
[#:sep sep (or/c block? content? #f) #f]
[#:column-properties column-properties (listof any/c) '()]
[#:row-properties row-properties (listof any/c) '()]
[#:cell-properties cell-properties (listof (listof any/c)) '()])
table?]{
Creates a @tech{table} with the given content, which is supplies as a
list of rows, where each row has a list of cells. The length of all
rows must match.
Creates a @tech{table} with the given @racket[cells] content, which is
supplied as a list of rows, where each row has a list of cells. The
length of all rows must match.
If @racket[sep] is not @racket[#f], it is inserted between every
column in the table. Otherwise, the default style places no space
between table columns.
Use @racket['cont] as a cell to continue the content of the preceding
cell in a row in the space that would otherwise be used for a new
cell. A @racket['cont] must not appear as the first cell in a row.
Use @racket['cont] in @racket[cells] as a cell to continue the content
of the preceding cell in a row in the space that would otherwise be
used for a new cell. A @racket['cont] must not appear as the first
cell in a row.
The @racket[style] argument is handled the same as @racket[para].
If @racket[sep] is not @racket[#f], it is inserted as a new column
between every column in the table; note that any
@racket[table-columns] or @racket[table-cells] property in
@racket[style] must take the added columns into account. Otherwise,
the default style places no space between table columns.
The @racket[column-properties], @racket[row-properties], and
@racket[cell-properties] arguments specify @tech{style properties} for
the columns and cells of a table; see @racket[table-columns] and
@racket[table-cells] for a description of recognized properties. The
lists do not contain entries for columns potentially introduced for
@racket[sep], and when non-empty, they are extended as needed to match
the table size determined by @racket[cells]:
@itemlist[
@item{If the length of @racket[column-properties] is less than the
length of each row in @racket[cells], the last item of the list
is duplicated to make the list long enough.}
@item{If the length of @racket[row-properties] is less than the
length of @racket[cells], the last item of the list is
duplicated to make the list long enough.}
@item{If the length of @racket[cell-properties] is less than the
number of rows in @racket[cells], then the last element is
duplicated to make the list long enough. Each list within
@racket[cell-properties] is treated like a
@racket[column-properties] list---expanded as needed to match
the number of columns in each row.}
]
Each element of @racket[column-properties] or @racket[row-properties]
is either a list of @tech{style property} values or a non-list element
that is wrapped as a list. Similarly, for each list that is an element
of @racket[cell-properties], the list's non-list elements are wrapped
as nested lists.
If @racket[column-properties] is non-empty, then its list of property
lists is converted into a @racket[table-columns] @tech{style property}
that is added to the style specified by @racket[style]---or merged
with an existing @racket[table-columns] @tech{style property} that
matches the column shape of @racket[cells]. In addition, if either
@racket[row-properties] or @racket[cell-properties] is non-empty, the
property lists of @racket[column-properties] are merged
with the property lists of @racket[row-properties] and
@racket[cell-properties]. If @racket[row-properties] or
@racket[cell-properties] is non-empty, the merged lists are
converted into a @racket[table-cells] @tech{style property} that is
added to the style specified by @racket[style]---or merged with an
existing @racket[table-cells] @tech{style property} that matches the
shape of @racket[cells].
@margin-note{If the style lists for @racket[column-properties] are
both merged with @racket[cell-properties] and converted to
@racket[table-columns], then @racket[style] will contain some
redundant information. In that case, @racket[column-attributes]
properties will be used from @racket[table-columns], while other
properties will be used from the merger into @racket[table-cells].}
@history[#:changed "1.1" @elem{Added the @racket[#:column-properties],
@racket[#:row-properties],
and @racket[#:cell-properties] arguments.}]
Examples:
@codeblock[#:keep-lang-line? #f]|{
#lang scribble/manual
@ -266,6 +331,7 @@ Examples:
(list "soup" "tonjiru"))]
@tabular[#:style 'boxed
#:column-properties '(left right)
(list (list @bold{recipe} @bold{vegetable})
(list "caldo verde" "kale")
(list "kinpira gobō" "burdock")
@ -277,6 +343,7 @@ Examples:
(list "soup" "tonjiru"))]
@tabular[#:style 'boxed
#:column-properties '(left right)
(list (list @bold{recipe} @bold{vegetable})
(list "caldo verde" "kale")
(list "kinpira gobō" "burdock")

28
pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/core.scrbl
View File

@ -469,7 +469,7 @@ The recognized @tech{style properties} are as follows:
to the part title.}
@item{@racket[background-color-property] structure --- For HTML,
Applies a color to the background of the part title.}
applies a color to the background of the part title.}
@item{@racket[hover-property] structure --- For HTML, adds a text
label to the title to be shown when the mouse hovers over
@ -588,10 +588,12 @@ The following @tech{style properties} are currently recognized:
@item{@racket[table-columns] structure --- Provides column-specific
styles, but only @racket[column-attributes] properties (if any)
are used if a @racket[table-cells] structure is included as a
@tech{style property}.}
@tech{style property}. See @racket[table-cells] for information
about how a column style is used for each cell.}
@item{@racket[table-cells] structure --- Provides cell-specific
styles.}
styles. See @racket[table-cells] for information about how the
styles are used.}
@item{@racket[attributes] structure --- Provides additional HTML
attributes for the @tt{<table>} tag.}
@ -1109,8 +1111,8 @@ renderer, but at the recognized set includes at least
are used as RGB levels.
When rendering to HTML, a @racket[color-property] is also recognized
for a @tech{block} or @racket[part] (and used for the title in the
latter case).}
for a @tech{block}, @racket[part] (and used for the title in the
latter case)or cell in a @racket[table].}
@defstruct[background-color-property ([color (or/c string? (list/c byte? byte? byte?))])]{
@ -1126,7 +1128,7 @@ styles.
If a cell style has a string name, it is used as an HTML class for the
@tt{<td>} tag or as a Latex command name.
The following symbols are recognized as cell-@tech{style properties}:
The following are recognized as cell-@tech{style properties}:
@itemize[
@ -1144,11 +1146,19 @@ The following symbols are recognized as cell-@tech{style properties}:
@item{@racket['vcenter] --- Center the cell content vertically.}
@item{@racket[color-property] structure --- For HTML, applies a color
to the cell content.}
@item{@racket[background-color-property] structure --- For HTML,
applies a color to the background of the cell.}
@item{@racket[attributes] --- Provides additional HTML attributes
for the cell's @tt{<td>} tag.}
]
In addition, for HTML output, @racket[attributes] structures as
@tech{style properties} can add arbitrary attributes to a cell's
@tt{<td>} tag.}
@history[#:changed "1.1" @elem{Added @racket[color-property] and
@racket[background-color-property] support.}]}
@defstruct[table-columns ([styles (listof style?)])]{

162
pkgs/scribble-pkgs/scribble-lib/scribble/base.rkt
View File

@ -324,6 +324,13 @@
;; ----------------------------------------
(define (cell-spec/c c)
(define rc
(recursive-contract (or/c c
empty
(cons/c rc rc))))
rc)
(provide/contract
[para (->* ()
(#:style (or/c style? string? symbol? #f ))
@ -339,7 +346,10 @@
compound-paragraph?)]
[tabular (->* ((listof (listof (or/c 'cont block? content?))))
(#:style (or/c style? string? symbol? #f)
#:sep (or/c content? block? #f))
#:sep (or/c content? block? #f)
#:column-properties (listof any/c)
#:row-properties (listof any/c)
#:cell-properties (listof (listof any/c)))
table?)])
(define (convert-block-style style)
@ -360,7 +370,12 @@
(make-compound-paragraph (convert-block-style style)
(decode-flow c)))
(define (tabular #:style [style #f] #:sep [sep #f] cells)
(define (tabular #:style [style #f]
#:sep [sep #f]
#:column-properties [column-properties null]
#:row-properties [row-properties null]
#:cell-properties [cell-properties null]
cells)
(define (nth-str pos)
(case (modulo pos 10)
[(1) "st"]
@ -387,7 +402,148 @@
'tabular
(format "~a~a row starts with 'cont: " pos (nth-str pos))
row)))
(make-table (convert-block-style style)
(make-table (let ([s (convert-block-style style)])
(define n-orig-cols (if (null? cells)
0
(length (car cells))))
(define n-cols (if sep
(max 0 (sub1 (* n-orig-cols 2)))
n-orig-cols))
(define n-rows (length cells))
(unless (null? cells)
(when ((length column-properties) . > . n-orig-cols)
(raise-mismatch-error
'tabular
"column properties list is too long: "
column-properties)))
(when ((length row-properties) . > . n-rows)
(raise-mismatch-error
'tabular
"row properties list is too long: "
row-properties))
(when ((length cell-properties) . > . n-rows)
(raise-mismatch-error
'tabular
"cell properties list is too long: "
cell-properties))
(unless (null? cells)
(for ([row (in-list cell-properties)])
(when ((length row) . > . n-orig-cols)
(raise-mismatch-error
'tabular
"row list within cell properties list is too long: "
row))))
;; Expand given column and cell properties lists to match
;; the dimensions of the given `cells` by duplicating
;; the last element of a list as needed (and ignoring
;; extra elements):
(define (make-full-column-properties column-properties)
(let loop ([column-properties column-properties]
[n 0]
[prev null])
(cond
[(= n n-cols) null]
[(null? column-properties)
(if (or (zero? n) (not sep))
(cons prev (loop null (add1 n) prev))
(list* prev prev (loop null (+ n 2) prev)))]
[else
(define (to-list v) (if (list? v) v (list v)))
(define props (to-list (car column-properties)))
(define rest (loop (cdr column-properties)
(if (or (zero? n) (not sep))
(add1 n)
(+ n 2))
props))
(if (or (zero? n) (not sep))
(cons props rest)
(list* null props rest))])))
(define full-column-properties
(make-full-column-properties column-properties))
(define (make-full-cell-properties cell-properties)
(let loop ([cell-properties cell-properties]
[n 0]
[prev (make-list n-cols null)])
(cond
[(= n n-rows) null]
[(null? cell-properties)
(cons prev (loop null (add1 n) prev))]
[else
(define props (make-full-column-properties (car cell-properties)))
(cons props
(loop (cdr cell-properties)
(add1 n)
props))])))
(define full-cell-properties
(for/list ([c-row (in-list (make-full-cell-properties cell-properties))]
[r-row (in-list (make-full-cell-properties (map list row-properties)))])
(for/list ([c (in-list c-row)]
[r (in-list r-row)])
(append c r))))
(define all-cell-properties
(and (or (pair? row-properties)
(pair? cell-properties))
(if (null? column-properties)
full-cell-properties
(for/list ([row (in-list full-cell-properties)])
(for/list ([cell (in-list row)]
[col (in-list full-column-properties)])
(append cell col))))))
(define all-column-properties
(and (pair? column-properties)
full-column-properties))
;; Will werge `cell-properties` and `column-properties` into
;; `s`. Start by finding any existing `table-columns`
;; and `table-cells` properties with the right number of
;; styles:
(define props (style-properties s))
(define tc (and all-column-properties
(let ([tc (ormap (lambda (v) (and (table-columns? v) v))
props)])
(if (and tc
(= (length (table-columns-styles tc))
n-cols))
tc
#f))))
(define tl (and all-cell-properties
(let ([tl (ormap (lambda (v) (and (table-cells? v) v))
props)])
(if (and tl
(= (length (table-cells-styless tl))
n-rows)
(andmap (lambda (cl)
(= (length cl) n-cols))
(table-cells-styless tl)))
tl
#f))))
;; Merge:
(define (cons-maybe v l) (if v (cons v l) l))
(make-style (style-name s)
(cons-maybe
(and all-column-properties
(table-columns
(if tc
(for/list ([ps (in-list all-column-properties)]
[cs (in-list (table-columns-styles tc))])
(make-style (style-name cs)
(append ps (style-properties cs))))
(for/list ([ps (in-list all-column-properties)])
(make-style #f ps)))))
(cons-maybe
(and all-cell-properties
(table-cells
(if tl
(for/list ([pss (in-list all-cell-properties)]
[css (in-list (table-cells-styless tl))])
(for/list ([ps (in-list pss)]
[cs (in-list css)])
(make-style (style-name cs)
(append ps (style-properties cs)))))
(for/list ([pss (in-list all-cell-properties)])
(for/list ([ps (in-list pss)])
(make-style #f ps))))))
(remq tc (remq tl props))))))
;; Process cells:
(map (lambda (row)
(define (cvt cell)
(cond

5
pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt
View File

@ -1490,7 +1490,10 @@
(pair? (style-properties column-style)))
(style->attribs (make-style
#f
(filter attributes?
(filter (lambda (a)
(or (attributes? a)
(color-property? a)
(background-color-property? a)))
(style-properties column-style))))
null)
,@(if (and (pair? (cdr ds))

39
pkgs/scribble-pkgs/scribble-lib/scribble/text-render.rkt
View File

@ -88,6 +88,31 @@
(regexp-replace #rx"\n$" (get-output-string o) "")))))
flows))
flowss)]
[alignss
(cond
[(ormap (lambda (v) (and (table-cells? v) v)) (style-properties (table-style i)))
=> (lambda (tc)
(for/list ([l (in-list (table-cells-styless tc))])
(for/list ([s (in-list l)])
(define p (style-properties s))
(cond
[(member 'right p) 'right]
[(member 'center p) 'center]
[else 'left]))))]
[(ormap (lambda (v) (and (table-columns? v) v)) (style-properties (table-style i)))
=> (lambda (tc)
(make-list
(length flowss)
(for/list ([s (in-list (table-columns-styles tc))])
(define p (style-properties s))
(cond
[(member 'right p) 'right]
[(member 'center p) 'center]
[else 'left]))))]
[else
(if (null? flowss)
null
(make-list (length flowss) (make-list (length (car flowss)) 'left)))])]
[widths (map (lambda (col)
(for/fold ([d 0]) ([i (in-list col)])
(if (eq? i 'cont)
@ -95,7 +120,8 @@
(apply max d (map string-length i)))))
(apply map list strs))]
[x-length (lambda (col) (if (eq? col 'cont) 0 (length col)))])
(for/fold ([indent? #f]) ([row (in-list strs)])
(for/fold ([indent? #f]) ([row (in-list strs)]
[aligns (in-list alignss)])
(let ([h (apply max 0 (map x-length row))])
(let ([row* (for/list ([i (in-range h)])
(for/list ([col (in-list row)])
@ -106,11 +132,18 @@
(when indent? (indent))
(for/fold ([space? #f])
([col (in-list sub-row)]
[w (in-list widths)])
[w (in-list widths)]
[align (in-list aligns)])
;; (when space? (display " "))
(let ([col (if (eq? col 'cont) "" col)])
(define gap (max 0 (- w (string-length col))))
(case align
[(right) (display (make-string gap #\space))]
[(center) (display (make-string (quotient gap 2) #\space))])
(display col)
(display (make-string (max 0 (- w (string-length col))) #\space)))
(case align
[(left) (display (make-string gap #\space))]
[(center) (display (make-string (- gap (quotient gap 2)) #\space))]))
#t)
(newline)
#t)))

20
pkgs/scribble-pkgs/scribble-test/tests/scribble/docs/table.scrbl Normal file
View File

@ -0,0 +1,20 @@
#lang scribble/manual
@(tabular #:column-properties (list 'left 'center 'right)
#:sep "-"
(list (list "A" "B" "C" "D")
(list "apple" "banana" "coconut" "donut")))
@(tabular #:cell-properties (list (list 'right 'center 'left)
(list))
#:sep "-"
(list (list "A" "B" "C" "D")
(list "apple" "banana" "coconut" "donut")
(list "a" "b" "c" "d")))
@(tabular #:column-properties (list '() '() 'left)
#:cell-properties (list (list 'right 'center '()))
#:sep "-"
(list (list "A" "B" "C" "D")
(list "apple" "banana" "coconut" "donut")))

9
pkgs/scribble-pkgs/scribble-test/tests/scribble/docs/table.txt Normal file
View File

@ -0,0 +1,9 @@
A - B - C- D
apple-banana-coconut-donut
A- B -C -D
apple-banana-coconut-donut
a -b -c -d
A- B -C -D
apple-banana-coconut-donut