Use tiocgwinsz for printing the info table.
This commit is contained in:
parent
fd05ecda88
commit
b34770269e
3 changed files with 108 additions and 104 deletions
|
|
@ -206,7 +206,8 @@ MEMBERS-PRINT-SOURCES=members-print.scm util-bst-ldict.import.scm \
|
|||
bank-account.import.scm members-fees.import.scm \
|
||||
members-payments.import.scm brmember-format.import.scm \
|
||||
specification.import.scm cal-format.import.scm \
|
||||
util-git.import.scm racket-kwargs.import.scm
|
||||
util-git.import.scm racket-kwargs.import.scm \
|
||||
tiocgwinsz.import.scm
|
||||
|
||||
members-print.o: members-print.import.scm
|
||||
members-print.import.scm: $(MEMBERS-PRINT-SOURCES)
|
||||
|
|
@ -545,7 +546,7 @@ MAILMAN3-SQL-SOURCES=mailman3-sql.scm configuration.import.scm
|
|||
mailman3-sql.o: mailman3-sql.import.scm
|
||||
mailman3-sql.import.scm: $(MAILMAN3-SQL-SOURCES)
|
||||
|
||||
TIOCGWINSZ-SOURCES=tiocgwinsz.scm
|
||||
TIOCGWINSZ-SOURCES=tiocgwinsz.scm duck.import.scm
|
||||
|
||||
tiocgwinsz.o: tiocgwinsz.import.scm
|
||||
tiocgwinsz.import.scm: $(TIOCGWINSZ-SOURCES)
|
||||
|
|
|
|||
|
|
@ -67,7 +67,8 @@
|
|||
cal-format
|
||||
util-git
|
||||
cal-day
|
||||
racket-kwargs)
|
||||
racket-kwargs
|
||||
tiocgwinsz)
|
||||
|
||||
(define *show-payments-count* (make-parameter 36))
|
||||
|
||||
|
|
@ -301,102 +302,103 @@
|
|||
|
||||
;; Prints nicely aligned members base info
|
||||
(define (print-members-base-table mb)
|
||||
(let* ((total-count (length
|
||||
(find-members-by-predicate mb brmember-usable?)))
|
||||
(invalid-mrs (find-members-by-predicate
|
||||
mb
|
||||
(compose not is-4digit-prime? brmember-id)))
|
||||
(suspended-mrs (find-members-by-predicate mb brmember-suspended?))
|
||||
(debtor-mrs (sort
|
||||
(members-to-notify mb 3)
|
||||
brmember<?))
|
||||
(soon-expire-mrs (sort
|
||||
(find-members-by-predicate
|
||||
mb
|
||||
(brmember-suspended-for 21 24))
|
||||
brmember<?)))
|
||||
(print "Known members: " total-count)
|
||||
(newline)
|
||||
(print
|
||||
(table->string
|
||||
(filter
|
||||
identity
|
||||
(list (list "Type" "Count" "List")
|
||||
(members-pred-table-row mb
|
||||
(ansi-string #:yellow "Chair:")
|
||||
brmember-chair?
|
||||
"~N")
|
||||
(members-pred-table-row mb
|
||||
(ansi-string #:yellow "Council:")
|
||||
brmember-council?
|
||||
"~N")
|
||||
(members-pred-table-row mb
|
||||
(ansi-string #:yellow "Revision:")
|
||||
brmember-revision?
|
||||
"~N")
|
||||
(members-pred-table-row mb
|
||||
(ansi-string #:yellow "Grant:")
|
||||
brmember-grant?
|
||||
"~N")
|
||||
(members-pred-table-row mb
|
||||
(string-append a:success "Active:")
|
||||
brmember-active?
|
||||
"~N~E")
|
||||
(members-pred-table-row mb
|
||||
(string-append a:highlight "Students:")
|
||||
brmember-student?
|
||||
"~N~E")
|
||||
(members-table-row a:warning "Suspended:" suspended-mrs "~N~E (~S)")
|
||||
(members-pred-table-row mb
|
||||
(string-append a:warning "Destroyed:")
|
||||
brmember-destroyed?
|
||||
"~N~E")
|
||||
(let ((suspended2 (filter
|
||||
(lambda (mr)
|
||||
(>= (brmember-suspended-months mr)
|
||||
member-suspend-max-months))
|
||||
suspended-mrs)))
|
||||
(if (null? suspended2)
|
||||
(let-values (((rows columns) (term-size)))
|
||||
(let* ((total-count (length
|
||||
(find-members-by-predicate mb brmember-usable?)))
|
||||
(invalid-mrs (find-members-by-predicate
|
||||
mb
|
||||
(compose not is-4digit-prime? brmember-id)))
|
||||
(suspended-mrs (find-members-by-predicate mb brmember-suspended?))
|
||||
(debtor-mrs (sort
|
||||
(members-to-notify mb 3)
|
||||
brmember<?))
|
||||
(soon-expire-mrs (sort
|
||||
(find-members-by-predicate
|
||||
mb
|
||||
(brmember-suspended-for 21 24))
|
||||
brmember<?)))
|
||||
(print "Known members: " total-count)
|
||||
(newline)
|
||||
(print
|
||||
(table->string
|
||||
(filter
|
||||
identity
|
||||
(list (list "Type" "Count" "List")
|
||||
(members-pred-table-row mb
|
||||
(ansi-string #:yellow "Chair:")
|
||||
brmember-chair?
|
||||
"~N")
|
||||
(members-pred-table-row mb
|
||||
(ansi-string #:yellow "Council:")
|
||||
brmember-council?
|
||||
"~N")
|
||||
(members-pred-table-row mb
|
||||
(ansi-string #:yellow "Revision:")
|
||||
brmember-revision?
|
||||
"~N")
|
||||
(members-pred-table-row mb
|
||||
(ansi-string #:yellow "Grant:")
|
||||
brmember-grant?
|
||||
"~N")
|
||||
(members-pred-table-row mb
|
||||
(string-append a:success "Active:")
|
||||
brmember-active?
|
||||
"~N~E")
|
||||
(members-pred-table-row mb
|
||||
(string-append a:highlight "Students:")
|
||||
brmember-student?
|
||||
"~N~E")
|
||||
(members-table-row a:warning "Suspended:" suspended-mrs "~N~E (~S)")
|
||||
(members-pred-table-row mb
|
||||
(string-append a:warning "Destroyed:")
|
||||
brmember-destroyed?
|
||||
"~N~E")
|
||||
(let ((suspended2 (filter
|
||||
(lambda (mr)
|
||||
(>= (brmember-suspended-months mr)
|
||||
member-suspend-max-months))
|
||||
suspended-mrs)))
|
||||
(if (null? suspended2)
|
||||
#f
|
||||
(members-table-row (ansi #:magenta) "Suspended (long):" suspended2 "~N (~S)")))
|
||||
(if (null? soon-expire-mrs)
|
||||
#f
|
||||
(members-table-row (ansi #:magenta) "Suspended (long):" suspended2 "~N (~S)")))
|
||||
(if (null? soon-expire-mrs)
|
||||
#f
|
||||
(members-table-row (ansi #:magenta #:bold) "Expire Soon:"
|
||||
soon-expire-mrs "~N (~S)"))
|
||||
(members-pred-table-row mb
|
||||
(ansi-string #:red #:bold "Prolems:")
|
||||
brmember-has-problems?
|
||||
"~N~E ~A")
|
||||
(if (null? debtor-mrs)
|
||||
#f
|
||||
(list (ansi-string "\t" #:magenta #:bold "Debtors:")
|
||||
(format "~A" (length debtor-mrs))
|
||||
(table->string
|
||||
(append
|
||||
(members-attrs-table debtor-mrs
|
||||
brmember-format
|
||||
(list "Name" "Balance" "Last Payment")
|
||||
(list "~N" "\t~B" "~L"))
|
||||
(list
|
||||
(list
|
||||
"Total"
|
||||
(format
|
||||
"\t~A"
|
||||
(foldr
|
||||
(lambda (v a)
|
||||
(+ (member-total-balance v) a))
|
||||
0
|
||||
debtor-mrs)))))
|
||||
#:border '(((#:bottom #:right light) ... (#:bottom light))
|
||||
((#:right light) ... none) ...
|
||||
((#:top #:right light) ... (#:top light)))
|
||||
#:ansi-reset? #t)))
|
||||
))
|
||||
#:border '(((#:bottom #:right light) ... (#:bottom light))
|
||||
...
|
||||
((#:right light) ... none))
|
||||
#:width 70
|
||||
#:ansi-reset? #t)))
|
||||
(members-table-row (ansi #:magenta #:bold) "Expire Soon:"
|
||||
soon-expire-mrs "~N (~S)"))
|
||||
(members-pred-table-row mb
|
||||
(ansi-string #:red #:bold "Prolems:")
|
||||
brmember-has-problems?
|
||||
"~N~E ~A")
|
||||
(if (null? debtor-mrs)
|
||||
#f
|
||||
(list (ansi-string "\t" #:magenta #:bold "Debtors:")
|
||||
(format "~A" (length debtor-mrs))
|
||||
(table->string
|
||||
(append
|
||||
(members-attrs-table debtor-mrs
|
||||
brmember-format
|
||||
(list "Name" "Balance" "Last Payment")
|
||||
(list "~N" "\t~B" "~L"))
|
||||
(list
|
||||
(list
|
||||
"Total"
|
||||
(format
|
||||
"\t~A"
|
||||
(foldr
|
||||
(lambda (v a)
|
||||
(+ (member-total-balance v) a))
|
||||
0
|
||||
debtor-mrs)))))
|
||||
#:border '(((#:bottom #:right light) ... (#:bottom light))
|
||||
((#:right light) ... none) ...
|
||||
((#:top #:right light) ... (#:top light)))
|
||||
#:ansi-reset? #t)))
|
||||
))
|
||||
#:border '(((#:bottom #:right light) ... (#:bottom light))
|
||||
...
|
||||
((#:right light) ... none))
|
||||
#:width (- columns 10)
|
||||
#:ansi-reset? #t))))
|
||||
(let ((pmrs (find-members-by-predicate mb brmember-file-has-problems?)))
|
||||
(when (not (null? pmrs))
|
||||
(newline)
|
||||
|
|
|
|||
|
|
@ -27,19 +27,19 @@
|
|||
|
||||
(import duck)
|
||||
|
||||
(foreign-declare "#include <sys/ioctl.h>")
|
||||
|
||||
(module*
|
||||
tiocgwinsz
|
||||
#:doc ("TTY terminal size support.")
|
||||
(
|
||||
tiocgwinsz
|
||||
term-size
|
||||
)
|
||||
|
||||
(import scheme
|
||||
(chicken foreign)
|
||||
(chicken bitwise))
|
||||
|
||||
(foreign-declare "#include <sys/ioctl.h>")
|
||||
|
||||
(define tiocgwinsz-ioctl
|
||||
(foreign-lambda*
|
||||
int ()
|
||||
|
|
@ -53,10 +53,11 @@ if (ioctl(0, TIOCGWINSZ, &wss) == 0) {
|
|||
"
|
||||
))
|
||||
|
||||
(define/doc (tiocgwinsz)
|
||||
(define/doc (term-size)
|
||||
("Returns the number of terminal rows and columns.")
|
||||
(let ((res (tiocgwinsz-ioctl)))
|
||||
(values (bitwise-and res #xffff)
|
||||
(arithmetic-shift res -16))))
|
||||
(values
|
||||
(arithmetic-shift res -16)
|
||||
(bitwise-and res #xffff))))
|
||||
|
||||
)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue