scribble: 'border and '{left,right,top,bottom}-border properties for cells
original commit: 2134dbf95293189d6f11bf896a3ba43d9fb10aaf
This commit is contained in:
Matthew Flatt
parent
e5ebb45c06
commit
feed786915
|
|
@ -332,6 +332,7 @@ Examples:
|
|||
|
||||
@tabular[#:style 'boxed
|
||||
#:column-properties '(left right)
|
||||
#:row-properties '(bottom-border ())
|
||||
(list (list @bold{recipe} @bold{vegetable})
|
||||
(list "caldo verde" "kale")
|
||||
(list "kinpira gobō" "burdock")
|
||||
|
|
@ -344,6 +345,7 @@ Examples:
|
|||
|
||||
@tabular[#:style 'boxed
|
||||
#:column-properties '(left right)
|
||||
#:row-properties '(bottom-border ())
|
||||
(list (list @bold{recipe} @bold{vegetable})
|
||||
(list "caldo verde" "kale")
|
||||
(list "kinpira gobō" "burdock")
|
||||
|
|
|
|||
|
|
@ -1152,6 +1152,15 @@ The following are recognized as cell-@tech{style properties}:
|
|||
|
||||
@item{@racket['vcenter] --- Center the cell content vertically.}
|
||||
|
||||
@item{@racket['border] --- Draw a line around all sides of the
|
||||
cell. Borders along a shared edge of adjacent cells are
|
||||
collapsed into a single line.}
|
||||
|
||||
@item{@racket['left-border], @racket['right-border],
|
||||
@racket['top-border], or @racket['bottom-border] --- Draw a
|
||||
line along the corresponding side of the cell (with the same
|
||||
border collapsing as for @racket['border]).}
|
||||
|
||||
@item{@racket[color-property] structure --- For HTML, applies a color
|
||||
to the cell content.}
|
||||
|
||||
|
|
@ -1164,7 +1173,10 @@ The following are recognized as cell-@tech{style properties}:
|
|||
]
|
||||
|
||||
@history[#:changed "1.1" @elem{Added @racket[color-property] and
|
||||
@racket[background-color-property] support.}]}
|
||||
@racket[background-color-property] support.}
|
||||
#:changed "1.4" @elem{Added @racket['border], @racket['left-border],
|
||||
@racket['right-border], @racket['top-border],
|
||||
and @racket['bottom-border] support.}]}
|
||||
|
||||
|
||||
@defstruct[table-columns ([styles (listof style?)])]{
|
||||
|
|
|
|||
|
|
@ -21,4 +21,4 @@
|
|||
|
||||
(define pkg-authors '(mflatt eli))
|
||||
|
||||
(define version "1.3")
|
||||
(define version "1.4")
|
||||
|
|
|
|||
|
|
@ -1541,7 +1541,21 @@
|
|||
(or (attributes? a)
|
||||
(color-property? a)
|
||||
(background-color-property? a)))
|
||||
(style-properties column-style))))
|
||||
(style-properties column-style)))
|
||||
(let ([ps (style-properties column-style)])
|
||||
(cond
|
||||
[(memq 'border ps)
|
||||
`([style "border: 1px solid black;"])]
|
||||
[else
|
||||
(define (check sym sfx)
|
||||
(if (memq sym ps)
|
||||
`([style ,(format "border-~a: 1px solid black;" sfx)])
|
||||
null))
|
||||
(append
|
||||
(check 'top-border 'top)
|
||||
(check 'bottom-border 'bottom)
|
||||
(check 'left-border 'left)
|
||||
(check 'right-border 'right))])))
|
||||
null)
|
||||
,@(if (and (pair? (cdr ds))
|
||||
(eq? 'cont (cadr ds)))
|
||||
|
|
@ -1558,16 +1572,30 @@
|
|||
(render-content (paragraph-content d) part ri)
|
||||
(render-block d part ri #f)))
|
||||
(loop (cdr ds) (cdr column-styles) #f)))]))))
|
||||
(define cell-styless (extract-table-cell-styles t))
|
||||
`((table ([cellspacing "0"]
|
||||
,@(if starting-item?
|
||||
'([style "display: inline-table; vertical-align: text-top;"])
|
||||
null)
|
||||
[cellpadding "0"]
|
||||
,@(combine-class
|
||||
(case (style-name (table-style t))
|
||||
[(boxed) '([class "boxed"])]
|
||||
[(centered) '([align "center"])]
|
||||
[else '()])
|
||||
(style->attribs (table-style t))))
|
||||
(style->attribs (table-style t)
|
||||
(append
|
||||
(if starting-item?
|
||||
'([style "display: inline-table; vertical-align: text-top;"])
|
||||
null)
|
||||
(if (for/or ([cell-styles (in-list cell-styless)])
|
||||
(for/or ([cell-style (in-list cell-styles)])
|
||||
(and cell-style
|
||||
(let ([ps (style-properties cell-style)])
|
||||
(or (memq 'border ps)
|
||||
(memq 'left-border ps)
|
||||
(memq 'right-border ps)
|
||||
(memq 'bottom-border ps)
|
||||
(memq 'top-border ps))))))
|
||||
`([style "border-collapse: collapse;"])
|
||||
'())))))
|
||||
,@(let ([columns (ormap (lambda (p)
|
||||
(and (table-columns? p)
|
||||
(map (lambda (s)
|
||||
|
|
@ -1587,7 +1615,7 @@
|
|||
`((tr (td)))
|
||||
(map make-row
|
||||
(table-blockss t)
|
||||
(extract-table-cell-styles t))))))
|
||||
cell-styless)))))
|
||||
|
||||
(define/override (render-nested-flow t part ri starting-item?)
|
||||
`((,(or (style->tag (nested-flow-style t)) 'blockquote)
|
||||
|
|
|
|||
|
|
@ -566,6 +566,21 @@
|
|||
(when (string? s-name)
|
||||
(printf "\\end{~a}" s-name)))
|
||||
(unless (or (null? blockss) (null? (car blockss)))
|
||||
(define all-left-line?s
|
||||
(if (null? cell-styless)
|
||||
null
|
||||
(for/list ([i (in-range (length (car cell-styless)))])
|
||||
(for/and ([cell-styles (in-list cell-styless)])
|
||||
(let ([cell-style (list-ref cell-styles i)])
|
||||
(or (memq 'left-border (style-properties cell-style))
|
||||
(memq 'border (style-properties cell-style))))))))
|
||||
(define all-right-line?
|
||||
(and (pair? cell-styless)
|
||||
(let ([i (sub1 (length (car cell-styless)))])
|
||||
(for/and ([cell-styles (in-list cell-styless)])
|
||||
(let ([cell-style (list-ref cell-styles i)])
|
||||
(or (memq 'right-border (style-properties cell-style))
|
||||
(memq 'border (style-properties cell-style))))))))
|
||||
(parameterize ([current-table-mode
|
||||
(if inline? (current-table-mode) (list tableform t))]
|
||||
[show-link-page-numbers
|
||||
|
|
@ -589,40 +604,98 @@
|
|||
"")
|
||||
(string-append*
|
||||
(let ([l
|
||||
(map (lambda (i cell-style)
|
||||
(format "~a@{}"
|
||||
(map (lambda (i cell-style left-line?)
|
||||
(format "~a~a@{}"
|
||||
(if left-line? "|@{}" "")
|
||||
(cond
|
||||
[(memq 'center (style-properties cell-style)) "c"]
|
||||
[(memq 'right (style-properties cell-style)) "r"]
|
||||
[else "l"])))
|
||||
(car blockss)
|
||||
(car cell-styless))])
|
||||
(if boxed? (cons "@{\\SBoxedLeft}" l) l)))
|
||||
(car cell-styless)
|
||||
all-left-line?s)])
|
||||
(let ([l (if all-right-line? (append l '("|")) l)])
|
||||
(if boxed? (cons "@{\\SBoxedLeft}" l) l))))
|
||||
"")])
|
||||
;; Helper to add row-separating lines:
|
||||
(define (add-clines prev-styles next-styles)
|
||||
(let loop ([pos 1] [start #f] [prev-styles prev-styles] [next-styles next-styles])
|
||||
(cond
|
||||
[(or (and prev-styles (null? prev-styles))
|
||||
(and next-styles (null? next-styles)))
|
||||
(when start
|
||||
(if (= start 1)
|
||||
(printf "\\hline ")
|
||||
(printf "\\cline{~a-~a}" start (sub1 pos))))]
|
||||
[else
|
||||
(define prev-style (and prev-styles (car prev-styles)))
|
||||
(define next-style (and next-styles (car next-styles)))
|
||||
(define line? (or (and prev-style
|
||||
(or (memq 'bottom-border (style-properties prev-style))
|
||||
(memq 'border (style-properties prev-style))))
|
||||
(and next-style
|
||||
(or (memq 'top-border (style-properties next-style))
|
||||
(memq 'border (style-properties next-style))))))
|
||||
(when (and start (not line?))
|
||||
(printf "\\cline{~a-~a}" start (sub1 pos)))
|
||||
(loop (add1 pos) (and line? (or start pos))
|
||||
(and prev-styles (cdr prev-styles))
|
||||
(and next-styles (cdr next-styles)))])))
|
||||
;; Loop through rows:
|
||||
(let loop ([blockss blockss]
|
||||
[cell-styless cell-styless])
|
||||
[cell-styless cell-styless]
|
||||
[prev-styles #f]) ; for 'bottom-border styles
|
||||
(let ([flows (car blockss)]
|
||||
[cell-styles (car cell-styless)])
|
||||
(unless index? (add-clines prev-styles cell-styles))
|
||||
(let loop ([flows flows]
|
||||
[cell-styles cell-styles])
|
||||
[cell-styles cell-styles]
|
||||
[all-left-line?s all-left-line?s]
|
||||
[need-left? #f])
|
||||
(unless (null? flows)
|
||||
(when index? (printf "\n\\item "))
|
||||
(unless (eq? 'cont (car flows))
|
||||
(let ([cnt (let loop ([flows (cdr flows)][n 1])
|
||||
(cond [(null? flows) n]
|
||||
[(eq? (car flows) 'cont)
|
||||
(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) (not index?))
|
||||
(unless (= cnt 1) (printf "}"))
|
||||
(unless (null? (list-tail flows cnt)) (printf " &\n"))))
|
||||
(define right-line?
|
||||
(cond
|
||||
[index?
|
||||
(printf "\n\\item ")
|
||||
#f]
|
||||
[(eq? 'cont (car flows))
|
||||
#f]
|
||||
[else
|
||||
(let ([cnt (let loop ([flows (cdr flows)][n 1])
|
||||
(cond [(null? flows) n]
|
||||
[(eq? (car flows) 'cont)
|
||||
(loop (cdr flows) (add1 n))]
|
||||
[else n]))])
|
||||
(unless (= cnt 1) (printf "\\multicolumn{~a}{l}{" cnt))
|
||||
(when (and (not (car all-left-line?s))
|
||||
(or need-left?
|
||||
(memq 'left-border (style-properties (car cell-styles)))
|
||||
(memq 'border (style-properties (car cell-styles)))))
|
||||
(printf "\\vline "))
|
||||
(render-table-cell (car flows) part ri (/ twidth cnt) (car cell-styles) (not index?))
|
||||
(define right-line? (or (memq 'right-border (style-properties (list-ref cell-styles (sub1 cnt))))
|
||||
(memq 'border (style-properties (list-ref cell-styles (sub1 cnt))))))
|
||||
(when (and right-line? (null? (list-tail flows cnt)) (not all-right-line?))
|
||||
(printf "\\vline "))
|
||||
(unless (= cnt 1) (printf "}"))
|
||||
(unless (null? (list-tail flows cnt))
|
||||
(printf " &\n"))
|
||||
right-line?)]))
|
||||
(unless (null? (cdr flows)) (loop (cdr flows)
|
||||
(cdr cell-styles)))))
|
||||
(unless (or index? (null? (cdr blockss)))
|
||||
(cdr cell-styles)
|
||||
(cdr all-left-line?s)
|
||||
right-line?))))
|
||||
(unless (or index?
|
||||
(and (null? (cdr blockss))
|
||||
(not (for/or ([cell-style (in-list cell-styles)])
|
||||
(or (memq 'bottom-border (style-properties cell-style))
|
||||
(memq 'border (style-properties cell-style)))))))
|
||||
(printf " \\\\\n"))
|
||||
(unless (null? (cdr blockss))
|
||||
(loop (cdr blockss) (cdr cell-styless)))))
|
||||
(cond
|
||||
[(null? (cdr blockss))
|
||||
(unless index? (add-clines cell-styles #f))]
|
||||
[else
|
||||
(loop (cdr blockss) (cdr cell-styless) cell-styles)])))
|
||||
(unless inline?
|
||||
(printf "\\end{~a}~a"
|
||||
tableform
|
||||
|
|
|
|||
|
|
@ -88,66 +88,148 @@
|
|||
(regexp-replace #rx"\n$" (get-output-string o) "")))))
|
||||
flows))
|
||||
flowss)]
|
||||
[extract-align
|
||||
(lambda (s)
|
||||
(define p (style-properties s))
|
||||
(cond
|
||||
[(member 'right p) 'right]
|
||||
[(member 'center p) 'center]
|
||||
[else 'left]))]
|
||||
[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]))))]
|
||||
(extract-align s))))]
|
||||
[(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]))))]
|
||||
(extract-align s))))]
|
||||
[else
|
||||
(if (null? flowss)
|
||||
null
|
||||
(make-list (length flowss) (make-list (length (car flowss)) 'left)))])]
|
||||
[extract-border
|
||||
(lambda (s)
|
||||
(define p (style-properties s))
|
||||
(cond
|
||||
[(memq 'border p) '#(#t #t #t #t)]
|
||||
[else
|
||||
(vector (memq 'left-border p) (memq 'right-border p)
|
||||
(memq 'top-border p) (memq 'bottom-border p))]))]
|
||||
[borderss
|
||||
;; A border is (vector left? right? top? bottom?)
|
||||
(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)])
|
||||
(extract-border s))))]
|
||||
[(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))])
|
||||
(extract-border s))))]
|
||||
[else
|
||||
(if (null? flowss)
|
||||
null
|
||||
(make-list (length flowss) (make-list (length (car flowss)) '#(#f #f #f #f))))])]
|
||||
[border-left? (lambda (v) (vector-ref v 0))]
|
||||
[border-right? (lambda (v) (vector-ref v 1))]
|
||||
[border-top? (lambda (v) (vector-ref v 2))]
|
||||
[border-bottom? (lambda (v) (vector-ref v 3))]
|
||||
[col-borders ; has only left and right
|
||||
(for/list ([i (in-range (length (car borderss)))])
|
||||
(for/fold ([v '#(#f #f)]) ([borders (in-list borderss)])
|
||||
(define v2 (list-ref borders i))
|
||||
(vector (or (border-left? v) (border-left? v2))
|
||||
(or (border-right? v) (border-right? v2)))))]
|
||||
[widths (map (lambda (col)
|
||||
(for/fold ([d 0]) ([i (in-list col)])
|
||||
(if (eq? i 'cont)
|
||||
0
|
||||
d
|
||||
(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)]
|
||||
[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)])
|
||||
(if (i . < . (x-length col))
|
||||
(list-ref col i)
|
||||
"")))])
|
||||
(for/fold ([indent? indent?]) ([sub-row (in-list row*)])
|
||||
(when indent? (indent))
|
||||
(for/fold ([space? #f])
|
||||
([col (in-list sub-row)]
|
||||
[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)
|
||||
(case align
|
||||
[(left) (display (make-string gap #\space))]
|
||||
[(center) (display (make-string (- gap (quotient gap 2)) #\space))]))
|
||||
#t)
|
||||
(newline)
|
||||
#t)))
|
||||
#t)
|
||||
|
||||
(define (show-row-border prev-borders borders)
|
||||
(when (for/or ([prev-border (in-list prev-borders)]
|
||||
[border (in-list borders)])
|
||||
(or (border-bottom? prev-border)
|
||||
(border-top? border)))
|
||||
(define-values (end-h-border? end-v-border?)
|
||||
(for/fold ([left-border? #f]
|
||||
[prev-border? #f])
|
||||
([w (in-list widths)]
|
||||
[prev-border (in-list prev-borders)]
|
||||
[border (in-list borders)]
|
||||
[col-border (in-list col-borders)])
|
||||
(define border? (or (and prev-border (border-bottom? prev-border))
|
||||
(border-top? border)))
|
||||
(when (or left-border? (border-left? col-border))
|
||||
(display (if (or prev-border? border?) "-" " ")))
|
||||
(display (make-string w (if border? #\- #\space)))
|
||||
(values (border-right? col-border) border?)))
|
||||
(when end-h-border?
|
||||
(display (if end-v-border? "-" " ")))
|
||||
(newline)))
|
||||
|
||||
(define-values (last-indent? last-borders)
|
||||
(for/fold ([indent? #f] [prev-borders #f]) ([row (in-list strs)]
|
||||
[aligns (in-list alignss)]
|
||||
[borders (in-list borderss)])
|
||||
(values
|
||||
(let ([h (apply max 0 (map x-length row))])
|
||||
(let ([row* (for/list ([i (in-range h)])
|
||||
(for/list ([col (in-list row)])
|
||||
(if (i . < . (x-length col))
|
||||
(list-ref col i)
|
||||
(if (eq? col 'cont)
|
||||
'cont
|
||||
""))))])
|
||||
(for/fold ([indent? indent?]) ([sub-row (in-list row*)]
|
||||
[pos (in-naturals)])
|
||||
(when indent? (indent))
|
||||
|
||||
(when (zero? pos)
|
||||
(show-row-border (or prev-borders (map (lambda (b) '#(#f #f #f #f)) borders))
|
||||
borders))
|
||||
|
||||
(define-values (end-border? end-col-border?)
|
||||
(for/fold ([left-border? #f] [left-col-border? #f])
|
||||
([col (in-list sub-row)]
|
||||
[w (in-list widths)]
|
||||
[align (in-list aligns)]
|
||||
[border (in-list borders)]
|
||||
[col-border (in-list col-borders)])
|
||||
(when (or left-col-border? (border-left? col-border))
|
||||
(display (if (and (or left-border? (border-left? border))
|
||||
(not (eq? col 'cont)))
|
||||
"|"
|
||||
" ")))
|
||||
(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)
|
||||
(case align
|
||||
[(left) (display (make-string gap #\space))]
|
||||
[(center) (display (make-string (- gap (quotient gap 2)) #\space))]))
|
||||
(values (border-right? border)
|
||||
(border-right? col-border))))
|
||||
(when end-col-border?
|
||||
(display (if end-border? "|" " ")))
|
||||
(newline)
|
||||
#t)))
|
||||
borders)))
|
||||
|
||||
(show-row-border last-borders (map (lambda (b) '#(#f #f #f #f)) last-borders))
|
||||
|
||||
null)))
|
||||
|
||||
(define/override (render-itemization i part ht)
|
||||
|
|
|
|||
|
|
@ -0,0 +1,9 @@
|
|||
#lang scribble/base
|
||||
@(require scribble/decode)
|
||||
|
||||
@(define sub-table (tabular #:row-properties (list null '(border))
|
||||
'(("B" "B2") ("T" cont))))
|
||||
|
||||
@tabular[#:column-properties (list null '(border) '(bottom-border right-border))
|
||||
(list (list "Apple" sub-table "Cat") (list "C" "D" "Elephant"))
|
||||
]
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
--------
|
||||
Apple| B B2 |Cat |
|
||||
|------| |
|
||||
||T || |
|
||||
|------| |
|
||||
-----------------
|
||||
C |D |Elephant|
|
||||
-----------------
|
||||
Loading…
Reference in New Issue
Block a user