From 9aaf35307c98580b806b305217e6e9aace192a13 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Sun, 19 Nov 2023 21:01:04 +0100 Subject: [PATCH 01/19] Update README. --- README.md | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/README.md b/README.md index 699ae82..9fcb37f 100644 --- a/README.md +++ b/README.md @@ -46,6 +46,7 @@ Features * computing member balance * generating static web output for member pages in dokuwiki * exporting brmdoor cards lists +* synchronization of mailinglist subscriptions with member files Requirements ------------ @@ -59,6 +60,7 @@ Build requirements: * make (tested with GNU make) * Chicken eggs (chicken-install) * sqlite3 + * srfi-1 Runtime requirements: @@ -70,6 +72,10 @@ Runtime requirements: Building -------- +All the eggs used are installed in the source tree using: + + sh install-eggs.sh + Building static binary: make static From 44ba97fc7ba5f31d49d7b789d7bff0c164f56fb9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Sun, 19 Nov 2023 21:07:51 +0100 Subject: [PATCH 02/19] Add dokuwiki problems to summary email. --- src/notifications.scm | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/src/notifications.scm b/src/notifications.scm index b0b6b30..d60ed00 100644 --- a/src/notifications.scm +++ b/src/notifications.scm @@ -227,11 +227,27 @@ #:border '(((#:bottom #:right light) ... (#:bottom light)) ((#:right light) ... none) ...) - ))))) + )))) + (dwpu (filter (lambda (dwu) + (or (member "member" (list-ref dwu 3)) + (member "council" (list-ref dwu 3)) + (member "admin" (list-ref dwu 3)))) + (ldict-ref mb 'dokuwiki))) + (dw-lst + (if (null? dwpu) + '() + (list "" + "DokuWiki users (non-members) in wrong group(s):" + (string-append + " " + (string-intersperse + (map car dwpu) + ", ")))))) (append income-lst unpaired-lst debtors-lst boring-lst + dw-lst (list "" "--" "Brmlab Hackerspace Members Database" From cf7ca5be572bcb90e13cc1fbe20c841fb34c53c0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Sun, 19 Nov 2023 21:32:31 +0100 Subject: [PATCH 03/19] Add dokuwiki problems 2 to summary email. --- src/notifications.scm | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/src/notifications.scm b/src/notifications.scm index d60ed00..afe2835 100644 --- a/src/notifications.scm +++ b/src/notifications.scm @@ -242,12 +242,24 @@ " " (string-intersperse (map car dwpu) + ", "))))) + (dwmu (find-members-by-predicate mb (compose not brmember-dokuwiki-groups-ok?))) + (dw2-lst + (if (null? dwmu) + '() + (list "" + "Members in wrong dokuwiki group(s):" + (string-append + " " + (string-intersperse + (map brmember-nick dwmu) ", ")))))) (append income-lst unpaired-lst debtors-lst boring-lst dw-lst + dw2-lst (list "" "--" "Brmlab Hackerspace Members Database" From 87b84a406471d3ac9f0e364ad7a499cb7cb465bc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 5 Dec 2023 19:11:10 +0100 Subject: [PATCH 04/19] SEPA payment identification --- src/members-payments.scm | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/src/members-payments.scm b/src/members-payments.scm index 6f8731d..eee3b7e 100644 --- a/src/members-payments.scm +++ b/src/members-payments.scm @@ -79,11 +79,16 @@ (varsym-id (or varsym-id0 (let* ((msg (bank-transaction-message transaction)) - (ci (substring-index "," msg)) - (vs (if ci - (substring msg 0 ci) - msg))) - (string->number vs))))) + (ci1 (substring-index "," msg)) + (vs1 (if ci1 + (substring msg 0 ci1) + msg)) + (ci2 (substring-index " " msg)) + (vs2 (if ci2 + (substring msg 0 ci2) + msg))) + (or (string->number vs1) + (string->number vs2)))))) varsym-id))) ;; Special comparator (originally with JendaSAP hack) From 8ac6f8627c981f192d2e86d7b91f1f54b2c4fd94 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 5 Dec 2023 19:29:47 +0100 Subject: [PATCH 05/19] Revolut payments --- src/members-payments.scm | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/members-payments.scm b/src/members-payments.scm index eee3b7e..e6e7e2f 100644 --- a/src/members-payments.scm +++ b/src/members-payments.scm @@ -86,9 +86,14 @@ (ci2 (substring-index " " msg)) (vs2 (if ci2 (substring msg 0 ci2) + msg)) + (ci3 (substring-index "NULL" msg)) + (vs3 (if ci3 + (substring msg (+ ci3 4) 4) msg))) (or (string->number vs1) - (string->number vs2)))))) + (string->number vs2) + (string->number vs3)))))) varsym-id))) ;; Special comparator (originally with JendaSAP hack) From efb3645f7ef3d16f659b05493bdce4e501401325 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 5 Dec 2023 19:33:59 +0100 Subject: [PATCH 06/19] Fix substring semantics. --- src/members-payments.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/members-payments.scm b/src/members-payments.scm index e6e7e2f..c803da8 100644 --- a/src/members-payments.scm +++ b/src/members-payments.scm @@ -89,7 +89,7 @@ msg)) (ci3 (substring-index "NULL" msg)) (vs3 (if ci3 - (substring msg (+ ci3 4) 4) + (substring msg (+ ci3 4) (+ ci3 4 4)) msg))) (or (string->number vs1) (string->number vs2) From 165dd7328e4dd1d261f6de3a666f38c7af81e937 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 5 Dec 2023 19:38:41 +0100 Subject: [PATCH 07/19] Handle zero varsym. --- src/members-payments.scm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/members-payments.scm b/src/members-payments.scm index c803da8..bf2c416 100644 --- a/src/members-payments.scm +++ b/src/members-payments.scm @@ -77,7 +77,9 @@ (string->number (bank-transaction-varsym transaction))) (varsym-id - (or varsym-id0 + (if (and varsym-id0 + (> varsym-id0 1000)) + varsym-id0 (let* ((msg (bank-transaction-message transaction)) (ci1 (substring-index "," msg)) (vs1 (if ci1 From 1388f004156a94ab04123b5715b3789033d3b1de Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 5 Dec 2023 19:42:40 +0100 Subject: [PATCH 08/19] Bump version to 1.13 --- src/texts.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/texts.scm b/src/texts.scm index 203d078..dc7ff17 100644 --- a/src/texts.scm +++ b/src/texts.scm @@ -39,7 +39,7 @@ (chicken format)) ;; Short banner - (define banner-line "HackerBase 1.12 (c) 2023 Brmlab, z.s.") + (define banner-line "HackerBase 1.13 (c) 2023 Brmlab, z.s.") ;; Banner source with numbers for ANSI CSI SGR (define banner-source " From 24c829cbc858a6302cf4ec190598e966dd5ffdb6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 5 Dec 2023 22:04:14 +0100 Subject: [PATCH 09/19] Fix depdendencies for gendoc. --- doc/d-utils.md | 10 ++++++++++ src/Makefile | 5 +++-- 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/doc/d-utils.md b/doc/d-utils.md index fdf2ad2..08b8a43 100644 --- a/doc/d-utils.md +++ b/doc/d-utils.md @@ -388,6 +388,16 @@ quoted-printable sequences. Returns the ```str``` with all characters converted to upper case using ```char-upcase```. Does not work with UTF-8. +### string-capitalize [procedure] + + (string-capitalize str) + +* ```str``` - arbitrary string + +Returns the ```str``` with the first character converted to upper case +using ```char-upcase``` and the remainder converted to lower case +using ```char-downcase```. Does not work with UTF-8. + ## util-mail [module] (import util-mail) diff --git a/src/Makefile b/src/Makefile index 0615ce5..5af8425 100644 --- a/src/Makefile +++ b/src/Makefile @@ -68,14 +68,15 @@ GENDOC-SOURCES=gendoc.scm duck-extract.import.scm \ util-format.import.scm util-tag.import.scm \ util-string.import.scm util-bst.import.scm \ util-bst-bdict.import.scm util-bst-ldict.import.scm \ - util-dir.import.scm util-utf8.import.scm + util-dir.import.scm util-utf8.import.scm util-mail.import.scm \ + util-bst-lset.import.scm GENDOC-OBJS=gendoc.o duck-extract.o util-time.o util-csv.o util-io.o \ progress.o testing.o util-proc.o util-git.o util-io.o \ util-stdout.o util-parser.o util-proc.o util-format.o \ racket-kwargs.o util-bst-ldict.o util-tag.o duck.o \ util-string.o util-bst.o util-bst-bdict.o util-bst-ldict.o \ - util-dir.o util-utf8.o + util-dir.o util-utf8.o util-bst-lset.o util-mail.o .PHONY: imports imports: $(HACKERBASE-DEPS) From 0b23dd6666132389f24569b211a47acdd88b2bcf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 5 Dec 2023 22:16:08 +0100 Subject: [PATCH 10/19] Start work on tiocgwinsz. --- src/Makefile | 7 +++++- src/tiocgwinsz.scm | 58 ++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 64 insertions(+), 1 deletion(-) create mode 100644 src/tiocgwinsz.scm diff --git a/src/Makefile b/src/Makefile index 5af8425..d8f6d50 100644 --- a/src/Makefile +++ b/src/Makefile @@ -59,7 +59,7 @@ HACKERBASE-OBJS=hackerbase.o testing.o listing.o cal-month.o \ template-list-expander.o box-drawing.o export-web-static.o \ util-dir.o dokuwiki.o racket-kwargs.o duck.o util-bst.o \ util-bst-bdict.o util-bst-ldict.o util-bst-lset.o mailman2.o \ - mailman-common.o mailman3.o mailman3-sql.o + mailman-common.o mailman3.o mailman3-sql.o tiocgwinsz.o GENDOC-SOURCES=gendoc.scm duck-extract.import.scm \ util-time.import.scm util-csv.import.scm util-git.import.scm \ @@ -544,3 +544,8 @@ 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.o: tiocgwinsz.import.scm +tiocgwinsz.import.scm: $(TIOCGWINSZ-SOURCES) diff --git a/src/tiocgwinsz.scm b/src/tiocgwinsz.scm new file mode 100644 index 0000000..fb77d66 --- /dev/null +++ b/src/tiocgwinsz.scm @@ -0,0 +1,58 @@ +;; +;; tiocgwinsz.scm +;; +;; Get size of current terminal. +;; +;; ISC License +;; +;; Copyright 2023 Brmlab, z.s. +;; Dominik Pantůček +;; +;; Permission to use, copy, modify, and/or distribute this software +;; for any purpose with or without fee is hereby granted, provided +;; that the above copyright notice and this permission notice appear +;; in all copies. +;; +;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL +;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED +;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE +;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR +;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS +;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, +;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN +;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. +;; + +(declare (unit tiocgwinsz)) + +(module + tiocgwinsz + ( + tiocgwinsz + ) + + (import scheme + (chicken foreign) + (chicken bitwise)) + + (foreign-declare "#include ") + + (define tiocgwinsz-ioctl + (foreign-lambda* + int () + " +struct winsize wss; +if (ioctl(0, TIOCGWINSZ, &wss) == 0) { + C_return(wss.ws_row*65536+wss.ws_col); +} else { + C_return(0); +} +" + )) + + (define (tiocgwinsz) + (let ((res (tiocgwinsz-ioctl))) + (values (bitwise-and res #xffff) + (arithmetic-shift res -16)))) + + ) From fd05ecda88aaf5ddfcb2ab16f7469328d19b491f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 5 Dec 2023 22:22:27 +0100 Subject: [PATCH 11/19] Duck tiocgwinsz. --- src/tiocgwinsz.scm | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/tiocgwinsz.scm b/src/tiocgwinsz.scm index fb77d66..8d00ff8 100644 --- a/src/tiocgwinsz.scm +++ b/src/tiocgwinsz.scm @@ -25,8 +25,11 @@ (declare (unit tiocgwinsz)) -(module +(import duck) + +(module* tiocgwinsz + #:doc ("TTY terminal size support.") ( tiocgwinsz ) @@ -50,7 +53,8 @@ if (ioctl(0, TIOCGWINSZ, &wss) == 0) { " )) - (define (tiocgwinsz) + (define/doc (tiocgwinsz) + ("Returns the number of terminal rows and columns.") (let ((res (tiocgwinsz-ioctl))) (values (bitwise-and res #xffff) (arithmetic-shift res -16)))) 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 12/19] 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)))) ) From fb6e0868ded4406cf521e15aa34543db8b51a023 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 5 Dec 2023 22:36:02 +0100 Subject: [PATCH 13/19] Do not format paragraph for table. --- src/members-print.scm | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/src/members-print.scm b/src/members-print.scm index 2784851..ee02be2 100644 --- a/src/members-print.scm +++ b/src/members-print.scm @@ -268,11 +268,9 @@ (define (members-table-row a:? label mrs fmt) (list (string-append "\t" a:? label) (length mrs) - (ansi-paragraph-format - (member-records->string - (sort mrs brmemberstring + (sort mrs brmember Date: Wed, 6 Dec 2023 20:56:17 +0100 Subject: [PATCH 14/19] Handle sqlite busy locking. --- src/mailman3-sql.scm | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/mailman3-sql.scm b/src/mailman3-sql.scm index a9a0fc8..741ec23 100644 --- a/src/mailman3-sql.scm +++ b/src/mailman3-sql.scm @@ -45,7 +45,11 @@ ;; Returns (possibly cached) SQLite3 DB handle (define (mailman3-db) (when (not (*cached-mailman3-db*)) - (*cached-mailman3-db* (open-database (*mailman3-sql-path*)))) + (*cached-mailman3-db* + (let ((handler (make-busy-timeout 2000))) + (let ((db (open-database (*mailman3-sql-path*)))) + (set-busy-handler! db handler) + db)))) (*cached-mailman3-db*)) ;; Returns the list of mailman3 mailinglists by querying te From 2dc8d3c119365a9cde6d70c9f40a842d431f9fea Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Wed, 6 Dec 2023 21:00:35 +0100 Subject: [PATCH 15/19] Fix -notify and -notify3 output with -quiet. --- src/hackerbase.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/hackerbase.scm b/src/hackerbase.scm index f458a18..3844dd9 100644 --- a/src/hackerbase.scm +++ b/src/hackerbase.scm @@ -406,7 +406,7 @@ (if (null? nmembers) (print "Everyone paid on time.") (let () - (print "Notify" (-notify-months-)) + (stdout-print "Notify" (-notify-months-)) (let loop ((lst nmembers)) (when (and (not (null? lst)) (or (not mr) From 45a7af9c27d31f182e56158b716c551cfbe17ad6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Wed, 6 Dec 2023 21:33:47 +0100 Subject: [PATCH 16/19] Add -only-active to -fees. --- src/hackerbase.scm | 5 ++++- src/members-print.scm | 17 ++++++++++++----- 2 files changed, 16 insertions(+), 6 deletions(-) diff --git a/src/hackerbase.scm b/src/hackerbase.scm index 3844dd9..9494c10 100644 --- a/src/hackerbase.scm +++ b/src/hackerbase.scm @@ -62,6 +62,7 @@ (define -web-dir- (make-parameter #f)) (define -normal-month- (make-parameter #t)) (define -show-destroyed- (make-parameter #f)) +(define -show-only-active- (make-parameter #f)) (define -notify-months- (make-parameter 1)) (define -send-emails- (make-parameter #f)) @@ -137,6 +138,8 @@ "Misc options:" (-destroyed () "Show destroyed members in -fees" (-show-destroyed- #t)) + (-only-active () "Show only active members in -fees" + (-show-only-active- #t)) "" "Base Actions:" (-info () "Print information" @@ -372,7 +375,7 @@ (newline) (if mr (print-member-balances-table mr) - (print-members-fees-table MB (-show-destroyed-)))) + (print-members-fees-table MB (-show-destroyed-) (-show-only-active-))) ((repl) (repl)) ((genweb) diff --git a/src/members-print.scm b/src/members-print.scm index ee02be2..86e14c1 100644 --- a/src/members-print.scm +++ b/src/members-print.scm @@ -471,10 +471,14 @@ ")")))) ;; Prints summary table of all fees and credits for all members - (define (print-members-fees-table MB . ds) - (let ((destroyed? (if (null? ds) + (define (print-members-fees-table MB . dsa) + (let ((destroyed? (if (null? dsa) #f - (car ds)))) + (car dsa))) + (only-active? (if (or (null? dsa) + (null? (cdr dsa))) + #f + (cadr dsa)))) (let* ((members ;; Pass 1 (map (lambda (mr) @@ -500,8 +504,11 @@ (sort (if destroyed? (find-members-by-predicate MB (lambda x #t)) - (find-members-by-predicate MB (lambda (mr) - (not (brmember-destroyed? mr))))) + (if only-active? + (find-members-by-predicate MB (lambda (mr) + (brmember-active? mr))) + (find-members-by-predicate MB (lambda (mr) + (not (brmember-destroyed? mr)))))) brmember Date: Wed, 6 Dec 2023 21:34:29 +0100 Subject: [PATCH 17/19] Add missing parenthesis. --- src/hackerbase.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/hackerbase.scm b/src/hackerbase.scm index 9494c10..24552d1 100644 --- a/src/hackerbase.scm +++ b/src/hackerbase.scm @@ -375,7 +375,7 @@ (newline) (if mr (print-member-balances-table mr) - (print-members-fees-table MB (-show-destroyed-) (-show-only-active-))) + (print-members-fees-table MB (-show-destroyed-) (-show-only-active-)))) ((repl) (repl)) ((genweb) From a294055929cc21b2b3a648f3bd3449eada00977d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Wed, 6 Dec 2023 21:37:03 +0100 Subject: [PATCH 18/19] Bump version to 1.14 --- src/texts.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/texts.scm b/src/texts.scm index dc7ff17..2ee52b7 100644 --- a/src/texts.scm +++ b/src/texts.scm @@ -39,7 +39,7 @@ (chicken format)) ;; Short banner - (define banner-line "HackerBase 1.13 (c) 2023 Brmlab, z.s.") + (define banner-line "HackerBase 1.14 (c) 2023 Brmlab, z.s.") ;; Banner source with numbers for ANSI CSI SGR (define banner-source " From 12e957fedda5e17fb7c00878a8124bcf35991c43 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Wed, 6 Dec 2023 21:41:19 +0100 Subject: [PATCH 19/19] Fix missing licences and typos. --- src/configuration.scm | 2 +- src/gendoc.scm | 24 ++++++++++++++++++++++++ src/util-bst-bdict.scm | 24 ++++++++++++++++++++++++ src/util-bst-ldict.scm | 24 ++++++++++++++++++++++++ src/util-bst-lset.scm | 24 ++++++++++++++++++++++++ src/util-bst.scm | 24 ++++++++++++++++++++++++ 6 files changed, 121 insertions(+), 1 deletion(-) diff --git a/src/configuration.scm b/src/configuration.scm index 7b9b7af..3518efc 100644 --- a/src/configuration.scm +++ b/src/configuration.scm @@ -1,5 +1,5 @@ ;; -;; configuraiton.scm +;; configuration.scm ;; ;; Configuration parameters used by various modules. ;; diff --git a/src/gendoc.scm b/src/gendoc.scm index e5afddc..2ffd3ac 100644 --- a/src/gendoc.scm +++ b/src/gendoc.scm @@ -1,3 +1,27 @@ +;; +;; gendoc.scm +;; +;; Generate documentation for all documented modules dynamically. +;; +;; ISC License +;; +;; Copyright 2023 Brmlab, z.s. +;; Dominik Pantůček +;; +;; Permission to use, copy, modify, and/or distribute this software +;; for any purpose with or without fee is hereby granted, provided +;; that the above copyright notice and this permission notice appear +;; in all copies. +;; +;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL +;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED +;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE +;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR +;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS +;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, +;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN +;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. +;; (import duck-extract) diff --git a/src/util-bst-bdict.scm b/src/util-bst-bdict.scm index 1a2c6a7..bf198de 100644 --- a/src/util-bst-bdict.scm +++ b/src/util-bst-bdict.scm @@ -1,3 +1,27 @@ +;; +;; util-bst-bdict.scm +;; +;; BST-based number dictionary. +;; +;; ISC License +;; +;; Copyright 2023 Brmlab, z.s. +;; Dominik Pantůček +;; +;; Permission to use, copy, modify, and/or distribute this software +;; for any purpose with or without fee is hereby granted, provided +;; that the above copyright notice and this permission notice appear +;; in all copies. +;; +;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL +;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED +;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE +;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR +;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS +;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, +;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN +;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. +;; (declare (unit util-bst-bdict)) diff --git a/src/util-bst-ldict.scm b/src/util-bst-ldict.scm index 1810793..99d0393 100644 --- a/src/util-bst-ldict.scm +++ b/src/util-bst-ldict.scm @@ -1,3 +1,27 @@ +;; +;; util-bst-ldict.scm +;; +;; BST-based symbol dictionary. +;; +;; ISC License +;; +;; Copyright 2023 Brmlab, z.s. +;; Dominik Pantůček +;; +;; Permission to use, copy, modify, and/or distribute this software +;; for any purpose with or without fee is hereby granted, provided +;; that the above copyright notice and this permission notice appear +;; in all copies. +;; +;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL +;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED +;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE +;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR +;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS +;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, +;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN +;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. +;; (declare (unit util-bst-ldict)) diff --git a/src/util-bst-lset.scm b/src/util-bst-lset.scm index 48bf226..b8a035f 100644 --- a/src/util-bst-lset.scm +++ b/src/util-bst-lset.scm @@ -1,3 +1,27 @@ +;; +;; util-bst-lset.scm +;; +;; BST-based set implementation. +;; +;; ISC License +;; +;; Copyright 2023 Brmlab, z.s. +;; Dominik Pantůček +;; +;; Permission to use, copy, modify, and/or distribute this software +;; for any purpose with or without fee is hereby granted, provided +;; that the above copyright notice and this permission notice appear +;; in all copies. +;; +;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL +;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED +;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE +;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR +;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS +;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, +;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN +;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. +;; (declare (unit util-bst-lset)) diff --git a/src/util-bst.scm b/src/util-bst.scm index 93f97a7..c27d518 100644 --- a/src/util-bst.scm +++ b/src/util-bst.scm @@ -1,3 +1,27 @@ +;; +;; util-bst.scm +;; +;; Underlying BST implementation for sets and dictionaries. +;; +;; ISC License +;; +;; Copyright 2023 Brmlab, z.s. +;; Dominik Pantůček +;; +;; Permission to use, copy, modify, and/or distribute this software +;; for any purpose with or without fee is hereby granted, provided +;; that the above copyright notice and this permission notice appear +;; in all copies. +;; +;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL +;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED +;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE +;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR +;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS +;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, +;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN +;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. +;; (declare (unit util-bst))