brmlab/hackerbase
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Use tiocgwinsz for printing the info table.

Browse source
This commit is contained in:
Dominik Pantůček 2023-12-05 22:33:59 +01:00
parent fd05ecda88
commit b34770269e
3 changed files with 108 additions and 104 deletions
Download patch file Download diff file Expand all files Collapse all files

5
src/Makefile
View file

@ -206,7 +206,8 @@ MEMBERS-PRINT-SOURCES=members-print.scm util-bst-ldict.import.scm \
bank-account.import.scm members-fees.import.scm \ bank-account.import.scm members-fees.import.scm \
members-payments.import.scm brmember-format.import.scm \ members-payments.import.scm brmember-format.import.scm \
specification.import.scm cal-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.o: members-print.import.scm
members-print.import.scm: $(MEMBERS-PRINT-SOURCES) 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.o: mailman3-sql.import.scm
mailman3-sql.import.scm: $(MAILMAN3-SQL-SOURCES) mailman3-sql.import.scm: $(MAILMAN3-SQL-SOURCES)
TIOCGWINSZ-SOURCES=tiocgwinsz.scm TIOCGWINSZ-SOURCES=tiocgwinsz.scm duck.import.scm
tiocgwinsz.o: tiocgwinsz.import.scm tiocgwinsz.o: tiocgwinsz.import.scm
tiocgwinsz.import.scm: $(TIOCGWINSZ-SOURCES) tiocgwinsz.import.scm: $(TIOCGWINSZ-SOURCES)

194
src/members-print.scm
View file

@ -67,7 +67,8 @@
cal-format cal-format
util-git util-git
cal-day cal-day
racket-kwargs) racket-kwargs
tiocgwinsz)
(define *show-payments-count* (make-parameter 36)) (define *show-payments-count* (make-parameter 36))
@ -301,102 +302,103 @@
;; Prints nicely aligned members base info ;; Prints nicely aligned members base info
(define (print-members-base-table mb) (define (print-members-base-table mb)
(let* ((total-count (length (let-values (((rows columns) (term-size)))
(find-members-by-predicate mb brmember-usable?))) (let* ((total-count (length
(invalid-mrs (find-members-by-predicate (find-members-by-predicate mb brmember-usable?)))
mb (invalid-mrs (find-members-by-predicate
(compose not is-4digit-prime? brmember-id))) mb
(suspended-mrs (find-members-by-predicate mb brmember-suspended?)) (compose not is-4digit-prime? brmember-id)))
(debtor-mrs (sort (suspended-mrs (find-members-by-predicate mb brmember-suspended?))
(members-to-notify mb 3) (debtor-mrs (sort
brmember<?)) (members-to-notify mb 3)
(soon-expire-mrs (sort brmember<?))
(find-members-by-predicate (soon-expire-mrs (sort
mb (find-members-by-predicate
(brmember-suspended-for 21 24)) mb
brmember<?))) (brmember-suspended-for 21 24))
(print "Known members: " total-count) brmember<?)))
(newline) (print "Known members: " total-count)
(print (newline)
(table->string (print
(filter (table->string
identity (filter
(list (list "Type" "Count" "List") identity
(members-pred-table-row mb (list (list "Type" "Count" "List")
(ansi-string #:yellow "Chair:") (members-pred-table-row mb
brmember-chair? (ansi-string #:yellow "Chair:")
"~N") brmember-chair?
(members-pred-table-row mb "~N")
(ansi-string #:yellow "Council:") (members-pred-table-row mb
brmember-council? (ansi-string #:yellow "Council:")
"~N") brmember-council?
(members-pred-table-row mb "~N")
(ansi-string #:yellow "Revision:") (members-pred-table-row mb
brmember-revision? (ansi-string #:yellow "Revision:")
"~N") brmember-revision?
(members-pred-table-row mb "~N")
(ansi-string #:yellow "Grant:") (members-pred-table-row mb
brmember-grant? (ansi-string #:yellow "Grant:")
"~N") brmember-grant?
(members-pred-table-row mb "~N")
(string-append a:success "Active:") (members-pred-table-row mb
brmember-active? (string-append a:success "Active:")
"~N~E") brmember-active?
(members-pred-table-row mb "~N~E")
(string-append a:highlight "Students:") (members-pred-table-row mb
brmember-student? (string-append a:highlight "Students:")
"~N~E") brmember-student?
(members-table-row a:warning "Suspended:" suspended-mrs "~N~E (~S)") "~N~E")
(members-pred-table-row mb (members-table-row a:warning "Suspended:" suspended-mrs "~N~E (~S)")
(string-append a:warning "Destroyed:") (members-pred-table-row mb
brmember-destroyed? (string-append a:warning "Destroyed:")
"~N~E") brmember-destroyed?
(let ((suspended2 (filter "~N~E")
(lambda (mr) (let ((suspended2 (filter
(>= (brmember-suspended-months mr) (lambda (mr)
member-suspend-max-months)) (>= (brmember-suspended-months mr)
suspended-mrs))) member-suspend-max-months))
(if (null? suspended2) suspended-mrs)))
(if (null? suspended2)
#f
(members-table-row (ansi #:magenta) "Suspended (long):" suspended2 "~N (~S)")))
(if (null? soon-expire-mrs)
#f #f
(members-table-row (ansi #:magenta) "Suspended (long):" suspended2 "~N (~S)"))) (members-table-row (ansi #:magenta #:bold) "Expire Soon:"
(if (null? soon-expire-mrs) soon-expire-mrs "~N (~S)"))
#f (members-pred-table-row mb
(members-table-row (ansi #:magenta #:bold) "Expire Soon:" (ansi-string #:red #:bold "Prolems:")
soon-expire-mrs "~N (~S)")) brmember-has-problems?
(members-pred-table-row mb "~N~E ~A")
(ansi-string #:red #:bold "Prolems:") (if (null? debtor-mrs)
brmember-has-problems? #f
"~N~E ~A") (list (ansi-string "\t" #:magenta #:bold "Debtors:")
(if (null? debtor-mrs) (format "~A" (length debtor-mrs))
#f (table->string
(list (ansi-string "\t" #:magenta #:bold "Debtors:") (append
(format "~A" (length debtor-mrs)) (members-attrs-table debtor-mrs
(table->string brmember-format
(append (list "Name" "Balance" "Last Payment")
(members-attrs-table debtor-mrs (list "~N" "\t~B" "~L"))
brmember-format (list
(list "Name" "Balance" "Last Payment") (list
(list "~N" "\t~B" "~L")) "Total"
(list (format
(list "\t~A"
"Total" (foldr
(format (lambda (v a)
"\t~A" (+ (member-total-balance v) a))
(foldr 0
(lambda (v a) debtor-mrs)))))
(+ (member-total-balance v) a)) #:border '(((#:bottom #:right light) ... (#:bottom light))
0 ((#:right light) ... none) ...
debtor-mrs))))) ((#:top #:right light) ... (#:top light)))
#:border '(((#:bottom #:right light) ... (#:bottom light)) #:ansi-reset? #t)))
((#:right light) ... none) ... ))
((#:top #:right light) ... (#:top light))) #:border '(((#:bottom #:right light) ... (#:bottom light))
#:ansi-reset? #t))) ...
)) ((#:right light) ... none))
#:border '(((#:bottom #:right light) ... (#:bottom light)) #:width (- columns 10)
... #:ansi-reset? #t))))
((#:right light) ... none))
#:width 70
#:ansi-reset? #t)))
(let ((pmrs (find-members-by-predicate mb brmember-file-has-problems?))) (let ((pmrs (find-members-by-predicate mb brmember-file-has-problems?)))
(when (not (null? pmrs)) (when (not (null? pmrs))
(newline) (newline)

13
src/tiocgwinsz.scm
View file

@ -27,19 +27,19 @@
(import duck) (import duck)
(foreign-declare "#include <sys/ioctl.h>")
(module* (module*
tiocgwinsz tiocgwinsz
#:doc ("TTY terminal size support.") #:doc ("TTY terminal size support.")
( (
tiocgwinsz term-size
) )
(import scheme (import scheme
(chicken foreign) (chicken foreign)
(chicken bitwise)) (chicken bitwise))
(foreign-declare "#include <sys/ioctl.h>")
(define tiocgwinsz-ioctl (define tiocgwinsz-ioctl
(foreign-lambda* (foreign-lambda*
int () 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.") ("Returns the number of terminal rows and columns.")
(let ((res (tiocgwinsz-ioctl))) (let ((res (tiocgwinsz-ioctl)))
(values (bitwise-and res #xffff) (values
(arithmetic-shift res -16)))) (arithmetic-shift res -16)
(bitwise-and res #xffff))))
) )