56 lines
2.4 KiB
Racket
56 lines
2.4 KiB
Racket
#lang scheme/base
|
|
(require "../core.rkt")
|
|
|
|
(provide part-style?
|
|
select-suffix
|
|
extract-table-cell-styles
|
|
empty-content?)
|
|
|
|
(define (part-style? p s)
|
|
(memq s (style-properties (part-style p))))
|
|
|
|
(define (select-suffix path suggested-suffixes accepted-suffixes)
|
|
(or (ormap (lambda (suggested)
|
|
(and (member suggested accepted-suffixes)
|
|
(let ([p (bytes->path
|
|
(bytes-append (path->bytes (if (string? path)
|
|
(string->path path)
|
|
path))
|
|
(string->bytes/utf-8 suggested)))])
|
|
(and (file-exists? p)
|
|
p))))
|
|
suggested-suffixes)
|
|
path))
|
|
|
|
(define (extract-table-cell-styles t)
|
|
(let ([vars (style-properties (table-style t))])
|
|
(or (let ([l (ormap (lambda (v)
|
|
(and (table-cells? v)
|
|
(table-cells-styless v)))
|
|
vars)])
|
|
(and l
|
|
(unless (= (length l) (length (table-blockss t)))
|
|
(error 'table
|
|
"table-cells property list's length does not match row count: ~e vs. ~e"
|
|
l (length (table-blockss t))))
|
|
(for-each (lambda (l row)
|
|
(unless (= (length l) (length row))
|
|
(error 'table
|
|
"table-cells property list contains a row whose length does not match the content: ~e vs. ~e"
|
|
l (length row))))
|
|
l (table-blockss t))
|
|
l))
|
|
(let ([cols (ormap (lambda (v) (and (table-columns? v) v)) vars)])
|
|
(and cols
|
|
(let ([cols (table-columns-styles cols)])
|
|
(map (lambda (row)
|
|
(unless (= (length cols) (length row))
|
|
(error 'table
|
|
"table-columns property list's length does not match a row length: ~e vs. ~e"
|
|
cols (length row)))
|
|
cols)
|
|
(table-blockss t)))))
|
|
(map (lambda (row) (map (lambda (c) plain) row)) (table-blockss t)))))
|
|
|
|
(define (empty-content? c) (null? c))
|