Switch table to kwargs proc define, add more day/month support procedures.
This commit is contained in:
parent
c9ba551132
commit
fac674f886
4 changed files with 25 additions and 13 deletions
|
@ -161,7 +161,8 @@ progress.o: progress.import.scm
|
|||
progress.import.scm: $(PROGRESS-SOURCES)
|
||||
|
||||
TABLE-SOURCES=table.scm ansi.import.scm testing.import.scm \
|
||||
util-string.import.scm util-list.import.scm
|
||||
util-string.import.scm util-list.import.scm \
|
||||
util-kwargs.import.scm
|
||||
|
||||
table.o: table.import.scm
|
||||
table.import.scm: $(TABLE-SOURCES)
|
||||
|
|
|
@ -50,6 +50,8 @@
|
|||
|
||||
cal-day/month<?
|
||||
|
||||
cal-day/month->string
|
||||
|
||||
cal-day-tests!
|
||||
)
|
||||
|
||||
|
@ -205,6 +207,14 @@
|
|||
"Requires two arguments of the same type"
|
||||
(list a b)))))
|
||||
|
||||
;; Semi-universal string conversion
|
||||
(define (cal-day/month->string v)
|
||||
(if (cal-day? v)
|
||||
(cal-day->string v)
|
||||
(if (cal-month? v)
|
||||
(cal-month->string v)
|
||||
"")))
|
||||
|
||||
;; Module self-tests
|
||||
(define (cal-day-tests!)
|
||||
(run-tests
|
||||
|
|
|
@ -207,8 +207,8 @@
|
|||
;; Returns string representing a month period with possibly open end.
|
||||
(define (cal-period->string p)
|
||||
(sprintf "~A..~A"
|
||||
(cal-month->string (cal-period-since p))
|
||||
(cal-month->string (cal-period-before p))))
|
||||
(cal-day/month->string (cal-period-since p))
|
||||
(cal-day/month->string (cal-period-before p))))
|
||||
|
||||
;; Returns a string representing a list of periods.
|
||||
(define (cal-periods->string ps)
|
||||
|
|
|
@ -43,7 +43,8 @@
|
|||
ansi
|
||||
testing
|
||||
util-list
|
||||
util-string)
|
||||
util-string
|
||||
util-kwargs)
|
||||
|
||||
;; Default table border style to use if not explicitly specified.
|
||||
(define *table-border-style* (make-parameter 'unicode))
|
||||
|
@ -272,19 +273,19 @@
|
|||
(if tb (sref 3) "")))
|
||||
|
||||
;; Converts given table to a list of strings suitable for printing.
|
||||
(define (table->list tbl . args)
|
||||
(define-kwproc (table->list tbl
|
||||
(#:table-border table-border)
|
||||
(#:row-border row-border)
|
||||
(#:col-border column-border)
|
||||
(#:row0-border row0-border)
|
||||
(#:col0-border col0-border)
|
||||
(#:border-style border-style (*table-border-style*))
|
||||
(#:ansi ansi?))
|
||||
(let ((table (table-prepare tbl)))
|
||||
(if (or (null? tbl)
|
||||
(null? (car tbl)))
|
||||
""
|
||||
(let* ((table-border (get-keyword #:table-border args (lambda () #f)))
|
||||
(row-border (get-keyword #:row-border args (lambda () #f)))
|
||||
(column-border (get-keyword #:col-border args (lambda () #f)))
|
||||
(row0-border (get-keyword #:row0-border args (lambda () #f)))
|
||||
(col0-border (get-keyword #:col0-border args (lambda () #f)))
|
||||
(border-style (get-keyword #:border-style args (lambda () (*table-border-style*))))
|
||||
(ansi? (get-keyword #:ansi args (lambda () #f)))
|
||||
(stylepair (assq border-style table-borders-lookup))
|
||||
(let* ((stylepair (assq border-style table-borders-lookup))
|
||||
(stylevec
|
||||
(if stylepair
|
||||
(cdr stylepair)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue