Compare commits
19 commits
6facd2a2cc
...
12e957fedd
Author | SHA1 | Date | |
---|---|---|---|
12e957fedd | |||
a294055929 | |||
f3dd074a69 | |||
45a7af9c27 | |||
2dc8d3c119 | |||
5185567842 | |||
fb6e0868de | |||
b34770269e | |||
fd05ecda88 | |||
0b23dd6666 | |||
24c829cbc8 | |||
1388f00415 | |||
165dd7328e | |||
efb3645f7e | |||
8ac6f8627c | |||
87b84a4064 | |||
cf7ca5be57 | |||
44ba97fc7b | |||
9aaf35307c |
16 changed files with 382 additions and 122 deletions
|
@ -46,6 +46,7 @@ Features
|
||||||
* computing member balance
|
* computing member balance
|
||||||
* generating static web output for member pages in dokuwiki
|
* generating static web output for member pages in dokuwiki
|
||||||
* exporting brmdoor cards lists
|
* exporting brmdoor cards lists
|
||||||
|
* synchronization of mailinglist subscriptions with member files
|
||||||
|
|
||||||
Requirements
|
Requirements
|
||||||
------------
|
------------
|
||||||
|
@ -59,6 +60,7 @@ Build requirements:
|
||||||
* make (tested with GNU make)
|
* make (tested with GNU make)
|
||||||
* Chicken eggs (chicken-install)
|
* Chicken eggs (chicken-install)
|
||||||
* sqlite3
|
* sqlite3
|
||||||
|
* srfi-1
|
||||||
|
|
||||||
Runtime requirements:
|
Runtime requirements:
|
||||||
|
|
||||||
|
@ -70,6 +72,10 @@ Runtime requirements:
|
||||||
Building
|
Building
|
||||||
--------
|
--------
|
||||||
|
|
||||||
|
All the eggs used are installed in the source tree using:
|
||||||
|
|
||||||
|
sh install-eggs.sh
|
||||||
|
|
||||||
Building static binary:
|
Building static binary:
|
||||||
|
|
||||||
make static
|
make static
|
||||||
|
|
|
@ -388,6 +388,16 @@ quoted-printable sequences.
|
||||||
Returns the ```str``` with all characters converted to upper case
|
Returns the ```str``` with all characters converted to upper case
|
||||||
using ```char-upcase```. Does not work with UTF-8.
|
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]
|
## util-mail [module]
|
||||||
|
|
||||||
(import util-mail)
|
(import util-mail)
|
||||||
|
|
15
src/Makefile
15
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 \
|
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-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 \
|
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 \
|
GENDOC-SOURCES=gendoc.scm duck-extract.import.scm \
|
||||||
util-time.import.scm util-csv.import.scm util-git.import.scm \
|
util-time.import.scm util-csv.import.scm util-git.import.scm \
|
||||||
|
@ -68,14 +68,15 @@ GENDOC-SOURCES=gendoc.scm duck-extract.import.scm \
|
||||||
util-format.import.scm util-tag.import.scm \
|
util-format.import.scm util-tag.import.scm \
|
||||||
util-string.import.scm util-bst.import.scm \
|
util-string.import.scm util-bst.import.scm \
|
||||||
util-bst-bdict.import.scm util-bst-ldict.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 \
|
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 \
|
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 \
|
util-stdout.o util-parser.o util-proc.o util-format.o \
|
||||||
racket-kwargs.o util-bst-ldict.o util-tag.o duck.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-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
|
.PHONY: imports
|
||||||
imports: $(HACKERBASE-DEPS)
|
imports: $(HACKERBASE-DEPS)
|
||||||
|
@ -205,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)
|
||||||
|
@ -543,3 +545,8 @@ 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 duck.import.scm
|
||||||
|
|
||||||
|
tiocgwinsz.o: tiocgwinsz.import.scm
|
||||||
|
tiocgwinsz.import.scm: $(TIOCGWINSZ-SOURCES)
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
;;
|
;;
|
||||||
;; configuraiton.scm
|
;; configuration.scm
|
||||||
;;
|
;;
|
||||||
;; Configuration parameters used by various modules.
|
;; Configuration parameters used by various modules.
|
||||||
;;
|
;;
|
||||||
|
|
|
@ -1,3 +1,27 @@
|
||||||
|
;;
|
||||||
|
;; gendoc.scm
|
||||||
|
;;
|
||||||
|
;; Generate documentation for all documented modules dynamically.
|
||||||
|
;;
|
||||||
|
;; ISC License
|
||||||
|
;;
|
||||||
|
;; Copyright 2023 Brmlab, z.s.
|
||||||
|
;; Dominik Pantůček <dominik.pantucek@trustica.cz>
|
||||||
|
;;
|
||||||
|
;; 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)
|
(import duck-extract)
|
||||||
|
|
||||||
|
|
|
@ -62,6 +62,7 @@
|
||||||
(define -web-dir- (make-parameter #f))
|
(define -web-dir- (make-parameter #f))
|
||||||
(define -normal-month- (make-parameter #t))
|
(define -normal-month- (make-parameter #t))
|
||||||
(define -show-destroyed- (make-parameter #f))
|
(define -show-destroyed- (make-parameter #f))
|
||||||
|
(define -show-only-active- (make-parameter #f))
|
||||||
(define -notify-months- (make-parameter 1))
|
(define -notify-months- (make-parameter 1))
|
||||||
(define -send-emails- (make-parameter #f))
|
(define -send-emails- (make-parameter #f))
|
||||||
|
|
||||||
|
@ -137,6 +138,8 @@
|
||||||
"Misc options:"
|
"Misc options:"
|
||||||
(-destroyed () "Show destroyed members in -fees"
|
(-destroyed () "Show destroyed members in -fees"
|
||||||
(-show-destroyed- #t))
|
(-show-destroyed- #t))
|
||||||
|
(-only-active () "Show only active members in -fees"
|
||||||
|
(-show-only-active- #t))
|
||||||
""
|
""
|
||||||
"Base Actions:"
|
"Base Actions:"
|
||||||
(-info () "Print information"
|
(-info () "Print information"
|
||||||
|
@ -372,7 +375,7 @@
|
||||||
(newline)
|
(newline)
|
||||||
(if mr
|
(if mr
|
||||||
(print-member-balances-table 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)
|
||||||
(repl))
|
(repl))
|
||||||
((genweb)
|
((genweb)
|
||||||
|
@ -406,7 +409,7 @@
|
||||||
(if (null? nmembers)
|
(if (null? nmembers)
|
||||||
(print "Everyone paid on time.")
|
(print "Everyone paid on time.")
|
||||||
(let ()
|
(let ()
|
||||||
(print "Notify" (-notify-months-))
|
(stdout-print "Notify" (-notify-months-))
|
||||||
(let loop ((lst nmembers))
|
(let loop ((lst nmembers))
|
||||||
(when (and (not (null? lst))
|
(when (and (not (null? lst))
|
||||||
(or (not mr)
|
(or (not mr)
|
||||||
|
|
|
@ -45,7 +45,11 @@
|
||||||
;; Returns (possibly cached) SQLite3 DB handle
|
;; Returns (possibly cached) SQLite3 DB handle
|
||||||
(define (mailman3-db)
|
(define (mailman3-db)
|
||||||
(when (not (*cached-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*))
|
(*cached-mailman3-db*))
|
||||||
|
|
||||||
;; Returns the list of mailman3 mailinglists by querying te
|
;; Returns the list of mailman3 mailinglists by querying te
|
||||||
|
|
|
@ -77,13 +77,25 @@
|
||||||
(string->number
|
(string->number
|
||||||
(bank-transaction-varsym transaction)))
|
(bank-transaction-varsym transaction)))
|
||||||
(varsym-id
|
(varsym-id
|
||||||
(or varsym-id0
|
(if (and varsym-id0
|
||||||
|
(> varsym-id0 1000))
|
||||||
|
varsym-id0
|
||||||
(let* ((msg (bank-transaction-message transaction))
|
(let* ((msg (bank-transaction-message transaction))
|
||||||
(ci (substring-index "," msg))
|
(ci1 (substring-index "," msg))
|
||||||
(vs (if ci
|
(vs1 (if ci1
|
||||||
(substring msg 0 ci)
|
(substring msg 0 ci1)
|
||||||
msg)))
|
msg))
|
||||||
(string->number vs)))))
|
(ci2 (substring-index " " msg))
|
||||||
|
(vs2 (if ci2
|
||||||
|
(substring msg 0 ci2)
|
||||||
|
msg))
|
||||||
|
(ci3 (substring-index "NULL" msg))
|
||||||
|
(vs3 (if ci3
|
||||||
|
(substring msg (+ ci3 4) (+ ci3 4 4))
|
||||||
|
msg)))
|
||||||
|
(or (string->number vs1)
|
||||||
|
(string->number vs2)
|
||||||
|
(string->number vs3))))))
|
||||||
varsym-id)))
|
varsym-id)))
|
||||||
|
|
||||||
;; Special comparator (originally with JendaSAP hack)
|
;; Special comparator (originally with JendaSAP hack)
|
||||||
|
|
|
@ -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))
|
||||||
|
|
||||||
|
@ -267,11 +268,9 @@
|
||||||
(define (members-table-row a:? label mrs fmt)
|
(define (members-table-row a:? label mrs fmt)
|
||||||
(list (string-append "\t" a:? label)
|
(list (string-append "\t" a:? label)
|
||||||
(length mrs)
|
(length mrs)
|
||||||
(ansi-paragraph-format
|
(member-records->string
|
||||||
(member-records->string
|
(sort mrs brmember<?)
|
||||||
(sort mrs brmember<?)
|
fmt)))
|
||||||
fmt)
|
|
||||||
60)))
|
|
||||||
|
|
||||||
;; Generic table of members attributes
|
;; Generic table of members attributes
|
||||||
(define (members-attrs-table mrs fmt hdr row)
|
(define (members-attrs-table mrs fmt hdr row)
|
||||||
|
@ -301,102 +300,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)
|
||||||
|
@ -471,10 +471,14 @@
|
||||||
")"))))
|
")"))))
|
||||||
|
|
||||||
;; Prints summary table of all fees and credits for all members
|
;; Prints summary table of all fees and credits for all members
|
||||||
(define (print-members-fees-table MB . ds)
|
(define (print-members-fees-table MB . dsa)
|
||||||
(let ((destroyed? (if (null? ds)
|
(let ((destroyed? (if (null? dsa)
|
||||||
#f
|
#f
|
||||||
(car ds))))
|
(car dsa)))
|
||||||
|
(only-active? (if (or (null? dsa)
|
||||||
|
(null? (cdr dsa)))
|
||||||
|
#f
|
||||||
|
(cadr dsa))))
|
||||||
(let* ((members ;; Pass 1
|
(let* ((members ;; Pass 1
|
||||||
(map
|
(map
|
||||||
(lambda (mr)
|
(lambda (mr)
|
||||||
|
@ -500,8 +504,11 @@
|
||||||
(sort
|
(sort
|
||||||
(if destroyed?
|
(if destroyed?
|
||||||
(find-members-by-predicate MB (lambda x #t))
|
(find-members-by-predicate MB (lambda x #t))
|
||||||
(find-members-by-predicate MB (lambda (mr)
|
(if only-active?
|
||||||
(not (brmember-destroyed? mr)))))
|
(find-members-by-predicate MB (lambda (mr)
|
||||||
|
(brmember-active? mr)))
|
||||||
|
(find-members-by-predicate MB (lambda (mr)
|
||||||
|
(not (brmember-destroyed? mr))))))
|
||||||
brmember<?)))
|
brmember<?)))
|
||||||
(balances (map (lambda (m)
|
(balances (map (lambda (m)
|
||||||
(list-ref m 6))
|
(list-ref m 6))
|
||||||
|
|
|
@ -227,11 +227,39 @@
|
||||||
#:border '(((#:bottom #:right light) ... (#:bottom light))
|
#:border '(((#:bottom #:right light) ... (#:bottom light))
|
||||||
((#:right light) ... none)
|
((#: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)
|
||||||
|
", ")))))
|
||||||
|
(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
|
(append income-lst
|
||||||
unpaired-lst
|
unpaired-lst
|
||||||
debtors-lst
|
debtors-lst
|
||||||
boring-lst
|
boring-lst
|
||||||
|
dw-lst
|
||||||
|
dw2-lst
|
||||||
(list ""
|
(list ""
|
||||||
"--"
|
"--"
|
||||||
"Brmlab Hackerspace Members Database"
|
"Brmlab Hackerspace Members Database"
|
||||||
|
|
|
@ -39,7 +39,7 @@
|
||||||
(chicken format))
|
(chicken format))
|
||||||
|
|
||||||
;; Short banner
|
;; Short banner
|
||||||
(define banner-line "HackerBase 1.12 (c) 2023 Brmlab, z.s.")
|
(define banner-line "HackerBase 1.14 (c) 2023 Brmlab, z.s.")
|
||||||
|
|
||||||
;; Banner source with numbers for ANSI CSI SGR
|
;; Banner source with numbers for ANSI CSI SGR
|
||||||
(define banner-source "
|
(define banner-source "
|
||||||
|
|
63
src/tiocgwinsz.scm
Normal file
63
src/tiocgwinsz.scm
Normal file
|
@ -0,0 +1,63 @@
|
||||||
|
;;
|
||||||
|
;; tiocgwinsz.scm
|
||||||
|
;;
|
||||||
|
;; Get size of current terminal.
|
||||||
|
;;
|
||||||
|
;; ISC License
|
||||||
|
;;
|
||||||
|
;; Copyright 2023 Brmlab, z.s.
|
||||||
|
;; Dominik Pantůček <dominik.pantucek@trustica.cz>
|
||||||
|
;;
|
||||||
|
;; 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))
|
||||||
|
|
||||||
|
(import duck)
|
||||||
|
|
||||||
|
(foreign-declare "#include <sys/ioctl.h>")
|
||||||
|
|
||||||
|
(module*
|
||||||
|
tiocgwinsz
|
||||||
|
#:doc ("TTY terminal size support.")
|
||||||
|
(
|
||||||
|
term-size
|
||||||
|
)
|
||||||
|
|
||||||
|
(import scheme
|
||||||
|
(chicken foreign)
|
||||||
|
(chicken bitwise))
|
||||||
|
|
||||||
|
(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/doc (term-size)
|
||||||
|
("Returns the number of terminal rows and columns.")
|
||||||
|
(let ((res (tiocgwinsz-ioctl)))
|
||||||
|
(values
|
||||||
|
(arithmetic-shift res -16)
|
||||||
|
(bitwise-and res #xffff))))
|
||||||
|
|
||||||
|
)
|
|
@ -1,3 +1,27 @@
|
||||||
|
;;
|
||||||
|
;; util-bst-bdict.scm
|
||||||
|
;;
|
||||||
|
;; BST-based number dictionary.
|
||||||
|
;;
|
||||||
|
;; ISC License
|
||||||
|
;;
|
||||||
|
;; Copyright 2023 Brmlab, z.s.
|
||||||
|
;; Dominik Pantůček <dominik.pantucek@trustica.cz>
|
||||||
|
;;
|
||||||
|
;; 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))
|
(declare (unit util-bst-bdict))
|
||||||
|
|
||||||
|
|
|
@ -1,3 +1,27 @@
|
||||||
|
;;
|
||||||
|
;; util-bst-ldict.scm
|
||||||
|
;;
|
||||||
|
;; BST-based symbol dictionary.
|
||||||
|
;;
|
||||||
|
;; ISC License
|
||||||
|
;;
|
||||||
|
;; Copyright 2023 Brmlab, z.s.
|
||||||
|
;; Dominik Pantůček <dominik.pantucek@trustica.cz>
|
||||||
|
;;
|
||||||
|
;; 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))
|
(declare (unit util-bst-ldict))
|
||||||
|
|
||||||
|
|
|
@ -1,3 +1,27 @@
|
||||||
|
;;
|
||||||
|
;; util-bst-lset.scm
|
||||||
|
;;
|
||||||
|
;; BST-based set implementation.
|
||||||
|
;;
|
||||||
|
;; ISC License
|
||||||
|
;;
|
||||||
|
;; Copyright 2023 Brmlab, z.s.
|
||||||
|
;; Dominik Pantůček <dominik.pantucek@trustica.cz>
|
||||||
|
;;
|
||||||
|
;; 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))
|
(declare (unit util-bst-lset))
|
||||||
|
|
||||||
|
|
|
@ -1,3 +1,27 @@
|
||||||
|
;;
|
||||||
|
;; util-bst.scm
|
||||||
|
;;
|
||||||
|
;; Underlying BST implementation for sets and dictionaries.
|
||||||
|
;;
|
||||||
|
;; ISC License
|
||||||
|
;;
|
||||||
|
;; Copyright 2023 Brmlab, z.s.
|
||||||
|
;; Dominik Pantůček <dominik.pantucek@trustica.cz>
|
||||||
|
;;
|
||||||
|
;; 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))
|
(declare (unit util-bst))
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue