From b34770269ee084bd8b505dd5f4b3f6b3cf3f2fae Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 5 Dec 2023 22:33:59 +0100 Subject: [PATCH] Use tiocgwinsz for printing the info table. --- src/Makefile | 5 +- src/members-print.scm | 194 +++++++++++++++++++++--------------------- src/tiocgwinsz.scm | 13 +-- 3 files changed, 108 insertions(+), 104 deletions(-) diff --git a/src/Makefile b/src/Makefile index d8f6d50..c71d1ff 100644 --- a/src/Makefile +++ b/src/Makefile @@ -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) diff --git a/src/members-print.scm b/src/members-print.scm index 3fdf736..2784851 100644 --- a/src/members-print.scm +++ b/src/members-print.scm @@ -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) - brmemberstring - (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) + brmemberstring + (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) diff --git a/src/tiocgwinsz.scm b/src/tiocgwinsz.scm index 8d00ff8..78eda74 100644 --- a/src/tiocgwinsz.scm +++ b/src/tiocgwinsz.scm @@ -27,19 +27,19 @@ (import duck) +(foreign-declare "#include ") + (module* tiocgwinsz #:doc ("TTY terminal size support.") ( - tiocgwinsz + term-size ) (import scheme (chicken foreign) (chicken bitwise)) - (foreign-declare "#include ") - (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)))) )