render-utils.rkt (2420B)
1 #lang scheme/base 2 (require "../core.rkt") 3 4 (provide part-style? 5 select-suffix 6 extract-table-cell-styles 7 empty-content?) 8 9 (define (part-style? p s) 10 (memq s (style-properties (part-style p)))) 11 12 (define (select-suffix path suggested-suffixes accepted-suffixes) 13 (or (ormap (lambda (suggested) 14 (and (member suggested accepted-suffixes) 15 (let ([p (bytes->path 16 (bytes-append (path->bytes (if (string? path) 17 (string->path path) 18 path)) 19 (string->bytes/utf-8 suggested)))]) 20 (and (file-exists? p) 21 p)))) 22 suggested-suffixes) 23 path)) 24 25 (define (extract-table-cell-styles t) 26 (let ([vars (style-properties (table-style t))]) 27 (or (let ([l (ormap (lambda (v) 28 (and (table-cells? v) 29 (table-cells-styless v))) 30 vars)]) 31 (and l 32 (unless (= (length l) (length (table-blockss t))) 33 (error 'table 34 "table-cells property list's length does not match row count: ~e vs. ~e" 35 l (length (table-blockss t)))) 36 (for-each (lambda (l row) 37 (unless (= (length l) (length row)) 38 (error 'table 39 "table-cells property list contains a row whose length does not match the content: ~e vs. ~e" 40 l (length row)))) 41 l (table-blockss t)) 42 l)) 43 (let ([cols (ormap (lambda (v) (and (table-columns? v) v)) vars)]) 44 (and cols 45 (let ([cols (table-columns-styles cols)]) 46 (map (lambda (row) 47 (unless (= (length cols) (length row)) 48 (error 'table 49 "table-columns property list's length does not match a row length: ~e vs. ~e" 50 cols (length row))) 51 cols) 52 (table-blockss t))))) 53 (map (lambda (row) (map (lambda (c) plain) row)) (table-blockss t))))) 54 55 (define (empty-content? c) (null? c))