CHANGELOG.md

@@ -1,14 +1,6 @@
 ChangeLog
 =========
 
-1.18 - released 2025-01-06
---------------------------
-
-* fix typo in members-print
-* create LaTeX source of general meeting attendance sheet
-* add expected income, cash flow and average age to stats
-* add QR code payment in CZK on members' payments pages'
-
 1.17 - released 2024-10-01
 --------------------------
 

doc/hackerbase.1

@@ -273,6 +273,10 @@ Specify member by nickname.
 .B \-destroyed
 Show destroyed members in \fB-fees\fR action as well.
 
+.TP
+.B \-ml-all
+Load all mailman list memberships to show them in members info.
+
 .SH "FILES"
 
 All the information about members is stored in in members file in the

src/Makefile

@@ -42,9 +42,7 @@ HACKERBASE-DEPS=hackerbase.scm cal-month.import.scm			\
 	tests.import.scm notifications.import.scm logging.import.scm	\
 	progress.import.scm cal-period.import.scm			\
 	util-stdout.import.scm export-web-static.import.scm		\
-	dokuwiki.import.scm mailinglist.import.scm			\
+	dokuwiki.import.scm mailinglist.import.scm
-	export-sheet.import.scm mbase-query.import.scm			\
-	qr-payment.import.scm
 
 HACKERBASE-OBJS=hackerbase.o testing.o listing.o cal-month.o		\
 	 cal-period.o ansi.o util-bst-ldict.o command-line.o mbase.o	\
@@ -60,9 +58,9 @@ HACKERBASE-OBJS=hackerbase.o testing.o listing.o cal-month.o		\
 	 table-style.o sgr-state.o util-utf8.o sgr-cell.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		\
+	 util-bst-bdict.o util-bst-ldict.o util-bst-lset.o mailman2.o	\
 	 mailman-common.o mailman3.o mailman3-sql.o tiocgwinsz.o	\
-	 mailinglist.o export-sheet.o mbase-query.o qr-payment.o
+	 mailinglist.o
 
 GENDOC-SOURCES=gendoc.scm duck-extract.import.scm			\
 	util-time.import.scm util-csv.import.scm util-git.import.scm	\
@@ -260,6 +258,13 @@ ENVIRONMENT-SOURCES=environment.scm ansi.import.scm
 environment.o: environment.import.scm
 environment.import.scm: $(ENVIRONMENT-SOURCES)
 
+MAILMAN2-SOURCES=mailman2.scm util-bst-lset.import.scm	\
+	util-io.import.scm mailman-common.import.scm	\
+	configuration.import.scm
+
+mailman2.o: mailman2.import.scm
+mailman2.import.scm: $(MAILMAN2-SOURCES)
+
 UTIL-TIME-SOURCES=util-time.scm duck.import.scm
 
 util-time.o: util-time.import.scm
@@ -468,8 +473,7 @@ box-drawing.import.scm: $(BOX-DRAWING-SOURCES)
 EXPORT-WEB-STATIC-SOURCES=export-web-static.scm brmember.import.scm	\
 	util-dir.import.scm mbase.import.scm				\
 	members-payments.import.scm cal-day.import.scm			\
-	util-git.import.scm configuration.import.scm texts.import.scm	\
+	util-git.import.scm configuration.import.scm texts.import.scm
-	members-fees.import.scm qr-payment.import.scm
 
 export-web-static.o: export-web-static.import.scm
 export-web-static.import.scm: $(EXPORT-WEB-STATIC-SOURCES)
@@ -520,9 +524,10 @@ UTIL-BST-LSET-SOURCES=util-bst-lset.scm util-bst.import.scm	\
 util-bst-lset.o: util-bst-lset.import.scm
 util-bst-lset.import.scm: $(UTIL-BST-LSET-SOURCES)
 
-MAILMAN-SOURCES=mailman.scm mailman-common.import.scm		\
+MAILMAN-SOURCES=mailman.scm mailman2.import.scm			\
-	util-bst-lset.import.scm configuration.import.scm	\
+	mailman-common.import.scm util-bst-lset.import.scm	\
-	mailman3.import.scm progress.import.scm
+	configuration.import.scm mailman3.import.scm		\
+	progress.import.scm
 
 mailman.o: mailman.import.scm
 mailman.import.scm: $(MAILMAN-SOURCES)
@@ -554,25 +559,3 @@ MAILINGLIST-SOURCES=mailinglist.scm racket-kwargs.import.scm		\
 
 mailinglist.o: mailinglist.import.scm
 mailinglist.import.scm: $(MAILINGLIST-SOURCES)
-
-EXPORT-SHEET-SOURCES=export-sheet.scm mbase.import.scm		\
-	brmember.import.scm brmember-format.import.scm		\
-	util-bst-ldict.import.scm members-payments.import.scm	\
-	util-format.import.scm members-fees.import.scm		\
-	cal-period.import.scm
-
-export-sheet.o: export-sheet.import.scm
-export-sheet.import.scm: $(EXPORT-SHEET-SOURCES)
-
-MBASE-QUERY-SOURCES=mbase-query.scm mbase.import.scm			\
-	brmember.import.scm util-bst-ldict.scm primes.import.scm	\
-	cal-period.import.scm cal-month.import.scm			\
-	members-fees.import.scm members-payments.import.scm
-
-mbase-query.o: mbase-query.import.scm
-mbase-query.import.scm: $(MBASE-QUERY-SOURCES)
-
-QR-PAYMENT-SOURCES=qr-payment.scm util-io.import.scm
-
-qr-payment.o: qr-payment.import.scm
-qr-payment.import.scm: $(QR-PAYMENT-SOURCES)

src/brmember.scm

@@ -87,8 +87,6 @@
 
   brmember-spec-fee
 
-  brmember-age
-
   brmember-tests!
   )
 
@@ -494,18 +492,6 @@
 	       #f))
 	 #f)))
 
- (define (brmember-age mr)
-   (let ((born (brmember-info mr 'born #f)))
-     (if born
-	 (let ((lst (string-split born "-")))
-	   (if (null? lst)
-	       #f
-	       (let ((y (string->number (car lst))))
-		 (if y		     
-		     (- (current-year) y)
-		     #f))))
-	 #f)))
-
  ;; Self-tests
  (define (brmember-tests!)
    (run-tests

src/cal-period.scm

@@ -28,7 +28,6 @@
 (module
  cal-period
  (
-     current-year
   *current-month*
   *current-day*
 
@@ -86,9 +85,6 @@
  ;; Type tag
  (define TAG-CAL-PERIOD (make-tag CAL-PERIOD))
 
-  (define (current-year)
-    (cal-month-year (*current-month*)))
-
  ;; Current month - if changed, we get the actual state for given month.
  (define *current-month*
    (make-parameter

src/export-sheet.scm

@@ -1,226 +0,0 @@
-;;
-;; export-sheet.scm
-;;
-;; Export attendance sheet as MarkDown document.
-;;
-;; ISC License
-;;
-;; Copyright 2024 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 export-sheet))
-
-(module
- export-sheet
- (
-  print-attendance-sheet
-  )
-
- (import scheme
-	 (chicken base)
-	 (chicken string)
-	 (chicken format)
-	 (chicken sort)
-	 srfi-1
-	 mbase
-	 brmember
-	 brmember-format
-	 util-bst-ldict
-	 members-payments
-	 util-format
-	 members-fees
-	 cal-period
-	 cal-day)
-
- (define (print-attendance-sheet MB number)
-   (print "\\documentclass{article}")
-   (print "\\usepackage{fancyhdr}")
-   (print "\\usepackage{longtable}")
-   (print "\\usepackage{lastpage}")
-   (print "\\usepackage[top=3cm,left=1cm,right=2cm,bottom=3cm]{geometry}")
-   (print "\\lhead{}")
-   (print
-    (format
-     "\\chead{Prezenční listina ~A. Valné Hromady brmlab z.s. konané ~A. ~A. ~A v sídle spolku}"
-     number  
-     (cal-day-day (*current-day*))
-     (cal-day-month (*current-day*))
-     (cal-day-year (*current-day*))
-     ))
-   (print "\\rhead{}")
-   (print "\\renewcommand{\\headrulewidth}{0pt}")
-   (print "\\lfoot{}")
-   (print "\\cfoot{Strana \\thepage{} ze \\pageref*{LastPage}}")
-   (print "\\rfoot{}")   
-   (print "\\pagestyle{fancy}")
-   (print "\\begin{document}")
-   (print "\\begin{center}")
-   (newline)
-   (print "\\vskip1em")
-   (newline)
-   (define colnames
-     '((id) Nick "Jméno" "Příjmení" (Fee) (Bilance)
-       ("\\raisebox{2pt}{\\begin{minipage}{15mm}\\begin{center}Aktivní\\\\Měsíce\\end{center}\\end{minipage}}")
-       ((Hlas?)) Podpis))
-   (print "\\renewcommand\\arraystretch{2.1}")
-   (print
-    (format
-     "\\begin{longtable}{|~A|}"
-     (string-intersperse
-      (map
-       (lambda (x)
-	 (if (list? x)
-	     (if (list? (car x))
-		 "c"
-		 "r")
-	     "l"))
-       colnames)
-      "|")))
-   (print "\\hline")
-   (print
-    (string-intersperse
-     (map
-      (lambda (x)
-	(format
-	 "\\textbf{~A}"
-	 (if (symbol? x)
-	     (symbol->string x)
-	     (if (string? x)
-		 x
-		 (if (string? (car x))
-		     (car x)
-		     (if (list? (car x))
-			 (symbol->string (caar x))
-			 (symbol->string (car x))))))))
-      colnames)
-     "&")
-    "\\\\")
-   (print "\\hline")
-   (print "\\endhead")
-   (define valid-voters 0)
-   (define ok-balances 0)
-   (define ok-actives 0)
-   (let loop ((mrs (sort
-		    (find-members-by-predicate
-		     MB (lambda (mr)
-			  (brmember-active? mr)))
-		    (lambda (a b)
-		      (string<? (brmember-nick a)
-				(brmember-nick b))))))
-     (when (not (null? mrs))
-       (let* ((mr (car mrs))
-	      (info (ldict-ref mr 'info))
-	      (name (ldict-ref info 'name "ERROR"))
-	      (name* (string-translate*
-		      name
-		      '(("_" . " "))))
-	      (namel (string-split name*))
-	      (sname (car (reverse namel)))
-	      (fname
-	       (string-intersperse
-		(reverse
-		 (cdr
-		  (reverse namel)))
-		" "))
-	      (cal (member-calendar mr))
-	      (rcal (reverse cal))
-	      (rcal12
-	       (if (> (length rcal) 12)
-		   (take rcal 12)
-		   rcal))
-	      (acal12 (map cadr rcal12))
-	      (acal12* (map (lambda (f) (if (memq 'active f) 1 0)) acal12))
-	      (numactive (foldl + 0 acal12*))
-	      (spec-fee (brmember-spec-fee mr))
-	      (current-fee (if spec-fee
-			       spec-fee
-			       (member-calendar-entry->fee
-				(list (*current-month*)
-				      (brmember-flags mr)
-				      spec-fee))))
-	      (balance-ok? (>= (member-total-balance mr)
-			      (- current-fee)))
-	      (active-ok? (>= numactive 9))
-	      (vote-ok? (and balance-ok? active-ok?))
-	      )
-	 (when balance-ok?
-	   (set! ok-balances (+ ok-balances 1)))
-	 (when active-ok?
-	   (set! ok-actives (+ ok-actives 1)))
-	 (when vote-ok?
-	   (set! valid-voters (+ valid-voters 1)))
-	 (print
-	  (brmember-id mr)
-	  " & "
-	  (string-translate*
-	   (brmember-nick mr)
-	   '(("_" . "\\_")))
-	  " & \\small "
-	  fname
-	  " & \\small "
-	  sname
-	  " & "
-	  current-fee
-	  " & "
-	  "\\raisebox{2pt}{\\begin{minipage}{15mm}\\begin{flushright}"
-	  (format-amount-tex
-	   (member-total-balance mr))
-	  "\\\\"
-	  (if balance-ok?
-	      "Bez~dluhu"
-	      "---~~~~~~")
-	  "\\end{flushright}\\end{minipage}}"
-	  " & "
-	  ;(if balance-ok?
-	  ;    "Y"
-	  ;    "--")
-	  ;" & "
-	  "\\raisebox{2pt}{\\begin{minipage}{12mm}\\begin{center}"
-	  numactive "/" 12
-	  "\\\\"
-	  (if active-ok?
-	      "Splněno"
-	      "\\phantom{Sp}---\\phantom{Sp}")
-	  "\\end{center}\\end{minipage}}"
-	  " & "
-	  ;(if active-ok?
-	  ;    "Y"
-	  ;    "--")
-	  ;" & "
-	  (if vote-ok?
-	      "Ano"
-	      "--")
-	  " & "
-	  "~\\hskip28mm~"
-	  " \\\\")
-	 (print "\\hline")
-	 (loop (cdr mrs)))))
-   (print "\\end{longtable}")
-   (print "\\end{center}")
-   (print "\\end{document}")
-   (print "% valid-voters = " valid-voters)
-   (print "% valid-balances = " ok-balances)
-   (print "% valid-actives = " ok-actives)
-   )
-
- (define (format-amount-tex amt)
-   (string-translate*
-    (format-amount amt)
-    '(("--" . "--{}--"))))
-
- )

src/export-web-static.scm

@@ -45,9 +45,7 @@
 	 util-git
 	 configuration
 	 texts
-	 logging
+	 logging)
-	 qr-payment
-	 members-fees)
 
  ;; HTML entities
  (define (sanitize-html str)
@@ -90,8 +88,6 @@
      (print "dd+dt,dd+dt+dd{border-top:1px solid #8cacbb}")
      (print "dd{grid-column:2/3;font-weight:bold;margin:0px;padding-left:16px}")
      (print "footer{background:#dee7ec;border-top:1px solid #8cacbb;padding:16px}")
-     (print ".qr svg{width:100%;height:auto;max-width:10cm}")
-     (print ".qr{text-align: center}")
      (print "</style>")
      (print "</head>")
      (print "<body>")
@@ -113,13 +109,6 @@
      (print "<dt>Account for Payments<br>(Účet pro platbu příspěvků)</dt><dd>CZK: 2500079551/2010<br>EUR:  CZ93 2010 0000 0021 0007 9552</dd>")
      (print "</dl>")
      (print "</div>")
-     (print "<div class=\"bi qr\">")
-     (let ((fee (member-calendar-entry->fee
-		 (make-member-calendar-entry mr))))
-       (print "<h2>Payment of membership fee " fee " CZK<br/>(Platba členského příspěvku)</h2>")
-       (print (make-brmlab-qrp-svg-string
-	       fee "CZK" (brmember-id mr))))
-     (print "</div>")
      (print "<div class=\"bi\">")
      (print "<h2>Payments History</h2>")
      (print "<table>")

src/hackerbase.scm

@@ -51,9 +51,7 @@
 	dokuwiki
 	racket-kwargs
 	util-string
-	mailinglist
+	mailinglist)
-	export-sheet
-	mbase-query)
 
 ;; Command-line options and configurable parameters
 (define -needs-bank- (make-parameter #f))
@@ -68,7 +66,6 @@
 (define -show-only-active- (make-parameter #f))
 (define -notify-months- (make-parameter 1))
 (define -send-emails- (make-parameter #f))
-(define -number- (make-parameter #f))
 
 ;; Arguments parsing
 (command-line
@@ -184,14 +181,7 @@
 	  (-action- 'genweb))
  (-stats (file:gnuplot-data) "Get stats for all months"
 	 (-action- 'print-stats)
-	 (-needs-bank- #t)
 	 (-fname- file:gnuplot-data))
- (-sheet (filename gmnum) "Generate attendance sheet for given GM number"
-	 (-needs-bank- #t)
-	 (-fname- filename)
-	 (-number- gmnum)
-	 (-action- 'gen-sheet))
-	 
  ""
  "Mailman Actions:"
  (-mlsync () "Synchronize internal ML"
@@ -364,10 +354,6 @@
   ((genweb)
    (log-info "Generating static web files")
    (gen-html-members MB (-web-dir-)))
-  ((gen-sheet)
-   (log-info "Generating attendance sheet")
-   (parameterize ((current-output-port (open-output-file (-fname-))))
-     (print-attendance-sheet MB (-number-))))
   ((edit)
    (if mr
        (let ()

src/mailman.scm

@@ -49,6 +49,7 @@
  (import scheme
 	 (chicken base)
 	 (chicken module)
+	 mailman2
 	 mailman-common
 	 util-bst-lset
 	 configuration
@@ -58,17 +59,24 @@
  ;; Syntax for simplifying export of case-version procedures
  (define-syntax define-mailman-proc
    (syntax-rules ()
-     ((_ name proc3)
+     ((_ name proc2)
       (begin
 	(export name)
 	(define (name . args)
 	  (case (*mailman-version*)
+	    ((2) (apply proc2 args))))))
+     ((_ name proc2 proc3)
+      (begin
+	(export name)
+	(define (name . args)
+	  (case (*mailman-version*)
+	    ((2) (apply proc2 args))
 	    ((3) (apply proc3 args))))))))
 
  (define-mailman-proc list-mailman-lists
-   list-mailman3-lists)
+   list-mailman2-lists list-mailman3-lists)
  (define-mailman-proc list-mailman-list-members
-   list-mailman3-list-members)
+   list-mailman2-list-members list-mailman3-list-members)
 
   ;; Loads a single mailman list as mailman structure, if
  ;; unsuccessfull, returns only a list with ML name and no member
@@ -104,9 +112,9 @@
    (assoc name lsts))
 
  (define-mailman-proc add-email-to-mailman-list
-   add-email-to-mailman3-list)
+   add-email-to-mailman2-list add-email-to-mailman3-list)
  (define-mailman-proc remove-email-from-mailman-list
-   remove-email-from-mailman3-list)
+   remove-email-from-mailman2-list remove-email-from-mailman3-list)
 
  ;; Ensures given email is in given ML
  (define (mailman-ensure-member ml email)

src/mailman2.scm

@@ -0,0 +1,104 @@
+;;
+;; mailman2.scm
+;;
+;; Mailman management interface - Mailman version 2.x support
+;;
+;; 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 mailman2))
+
+(module
+ mailman2
+ (
+  list-mailman2-lists
+  list-mailman2-list-members
+  
+  add-email-to-mailman2-list
+  remove-email-from-mailman2-list
+  )
+
+ (import scheme
+	 (chicken base)
+	 (chicken pathname)
+	 (chicken string)
+	 (chicken sort)
+	 (chicken format)
+	 srfi-1
+	 util-bst-lset
+	 util-io
+	 mailman-common
+	 configuration)
+
+ ;; Returns full path to given mailman binary
+ (define (mailman-bin bin)
+   (make-pathname (*mailman2-bin*) bin))
+
+ ;; Mailman-specific process output lines capture
+ (define (get-mailman-output-lines bin . args)
+   (apply
+    get-process-output-lines
+    (mailman-bin bin)
+    args))
+
+ ;; Sends all lines to the process
+ (define (mailman-send/recv bin args . lines)
+   (apply
+    process-send/recv
+    (mailman-bin bin)
+    args
+    lines))
+    
+ ;; Returns the list of available lists
+ (define (list-mailman2-lists)
+   (get-mailman-output-lines "list_lists" "-b"))
+
+ ;; Returns the list of members of given list
+ (define (list-mailman2-list-members lst)
+   (sort
+    (get-mailman-output-lines "list_members" lst)
+    string-ci<?))
+
+ ;; Adds given email to given listname
+ (define (add-email-to-mailman2-list listname email)
+   (print "Add " email " to " listname ".")
+   (let ((result
+	  (mailman-send/recv
+	   "add_members"
+	   (list "-r" "-" listname)
+	   email)))
+     (let loop ((lines result))
+       (when (not (null? lines))
+	 (print " | " (car lines))
+	 (loop (cdr lines))))))
+
+ ;; Removes given email from given listname
+ (define (remove-email-from-mailman2-list listname email)
+   (print "Remove " email " from " listname ".")
+   (let ((result
+	  (get-mailman-output-lines
+	   "remove_members" listname
+	   (sprintf "~A" email))))
+     (let loop ((lines result))
+       (when (not (null? lines))
+	 (print " | " (car lines))
+	 (loop (cdr lines))))))
+
+ )

src/mbase-query.scm

@@ -1,123 +0,0 @@
-;;
-;; mbase-query.scm
-;;
-;; Queries of various mbase derived attributes.
-;;
-;; ISC License
-;;
-;; Copyright 2023-2025 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 mbase-query))
-
-(module
-    mbase-query
-    (
-     mbase-info
-     mbase-stats
-     )
-
-  (import scheme
-	  (chicken base)
-	  srfi-1
-	  mbase
-	  brmember
-	  util-bst-ldict
-	  primes
-	  cal-period
-	  cal-month
-	  members-fees
-	  members-payments)
-
-  (define (members-base-oldest-month mb)
-    (make-cal-month 2015 1))
-
-  (define (members-average-age mrs)
-    (let* ((ages (map brmember-age mrs))
-	   (valid (filter (lambda (x) x) ages))
-	   (num (length valid))
-	   (sum (foldl + 0 valid)))
-      (exact->inexact (/ sum num))))
-
-  ;; Returns dictionary with statistics about the members base.
-  (define (mbase-info mb-arg)
-    (let* ((members (find-members-by-predicate mb-arg brmember-usable?))
-	   (di0 (make-ldict))
-	   (di1 (ldict-set di0 'invalid
-			   (filter (compose not is-4digit-prime? brmember-id) members)))
-	   (active-members (filter brmember-active? members))
-	   (di2 (ldict-set di1 'active
-			   active-members))
-	   (di3 (ldict-set di2 'suspended
-			   (filter brmember-suspended? members)))
-	   (di4 (ldict-set di3 'students
-			   (filter brmember-student? members)))
-	   (di5 (ldict-set di4 'destroyed
-			   (filter brmember-destroyed? members)))
-	   (di6 (ldict-set di5 'month (*current-month*)))
-	   (di7 (ldict-set di6 'total members))
-	   (di8 (ldict-set di7 'problems
-			   (find-members-by-predicate mb-arg brmember-has-problems?)))
-	   (di9 (ldict-set di8 'expected
-			   (get-expected-income mb-arg)))
-	   (mbals (map member-total-balance active-members))
-	   (di10 (ldict-set di9 'balance
-			    (foldl + 0 mbals)))
-	   (di11 (ldict-set di10 'advance
-			    (foldl + 0
-				   (map (lambda (v)
-					  (max 0 v))
-					mbals))))
-	   (di12 (ldict-set di11 'debt
-			    (foldl + 0
-				   (map (lambda (v)
-					  (min 0 v))
-					mbals))))
-	   (di13 (ldict-set di12 'age
-			    (members-average-age active-members)))
-	   )
-      di13))
-
-  ;; Returns a list two lists: keys, data.
-  ;; Each data record contains values for all keys.
-  (define (mbase-stats mb)
-    (let ((keys
-	   '(month
-	     total active suspended students destroyed invalid
-	     expected balance advance debt
-	     age
-	     )))
-      (let mloop ((data '())
-		  (month (members-base-oldest-month mb)))
-	(if (cal-month<=? month (*current-month*))
-	    (let ((bi (with-current-month month
-					  (mbase-info mb))))
-	      (let kloop ((row (list (ldict-ref bi 'month)))
-			  (keys (cdr keys)))
-		(if (null? keys)
-		    (mloop (cons (reverse row) data)
-			   (cal-month-add month 1))
-		    (kloop (cons (let ((val (ldict-ref bi (car keys))))
-				   (if (list? val)
-				       (length val)
-				       val))
-				 row)
-			   (cdr keys)))))
-	    (list keys (reverse data))))))
-
-  )

src/mbase.scm

@@ -50,6 +50,8 @@
   mbase-update-by-id
   mbase-update
 
+  mbase-stats
+
   mbase-add-unpaired
   mbase-unpaired
 
@@ -205,6 +207,47 @@
 				    (proc mr)
 				    mr)))))
 
+ ;; Returns dictionary with statistics about the members base.
+ (define (mbase-info mb-arg)
+   (let* ((members (find-members-by-predicate mb-arg brmember-usable?))
+	  (di0 (make-ldict))
+	  (di1 (ldict-set di0 'invalid
+			  (filter (compose not is-4digit-prime? brmember-id) members)))
+	  (di2 (ldict-set di1 'active
+			  (filter brmember-active? members)))
+	  (di3 (ldict-set di2 'suspended
+			  (filter brmember-suspended? members)))
+	  (di4 (ldict-set di3 'students
+			  (filter brmember-student? members)))
+	  (di5 (ldict-set di4 'destroyed
+			  (filter brmember-destroyed? members)))
+	  (di6 (ldict-set di5 'month (*current-month*)))
+	  (di7 (ldict-set di6 'total members))
+	  (di8 (ldict-set di7 'problems
+			  (find-members-by-predicate mb-arg brmember-has-problems?))))
+     di8))
+
+ (define (members-base-oldest-month mb)
+   (make-cal-month 2015 1))
+
+ ;; Returns a list two lists: keys, data.
+ ;; Each data record contains values for all keys.
+ (define (mbase-stats mb)
+   (let ((keys '(month total active suspended students destroyed invalid)))
+     (let mloop ((data '())
+		 (month (members-base-oldest-month mb)))
+       (if (cal-month<=? month (*current-month*))
+	   (let ((bi (with-current-month month
+					 (mbase-info mb))))
+	     (let kloop ((row (list (ldict-ref bi 'month)))
+			 (keys (cdr keys)))
+	       (if (null? keys)
+		   (mloop (cons (reverse row) data)
+			  (cal-month-add month 1))
+		   (kloop (cons (length (ldict-ref bi (car keys))) row)
+			  (cdr keys)))))
+	   (list keys (reverse data))))))
+
  ;; Adds unpaired transaction to given members-base
  (define (mbase-add-unpaired mb tr)
    (ldict-set mb 'unpaired

src/members-fees.scm

@@ -41,7 +41,6 @@
   member-calendar->table
   members-summary
   member-calendar-entry->fee
-  get-expected-income
   get-expected-income-string
   )
 
@@ -209,19 +208,6 @@
 	    (cons 0 0)
 	    members)))
 
- (define (get-expected-income mb)
-   (let* ((flst
-	   (map (compose member-calendar-entry->fee make-member-calendar-entry)
-		(find-members-by-predicate mb brmember-active?)))
-	  (amts (sort (delete-duplicates flst) <))
-	  (sums
-	   (map
-	    (lambda (amt)
-	      (cons amt
-		    (length (filter (lambda (v) (= v amt)) flst))))
-	    amts)))
-     (foldl + 0 (map (lambda (p) (* (car p) (cdr p))) sums))))
-
  (define (get-expected-income-string mb)
    (let* ((flst
 	   (map (compose member-calendar-entry->fee make-member-calendar-entry)

src/members-print.scm

@@ -380,7 +380,7 @@
 		    (members-table-row (ansi #:magenta #:bold) "Expire Soon:"
 				       soon-expire-mrs "~N (~S)"))
 		(members-pred-table-row mb
-					(ansi-string #:red #:bold "Problems:")
+					(ansi-string #:red #:bold "Prolems:")
 					brmember-has-problems?
 					"~N~E ~A")
 		(if (null? debtor-mrs)

src/qr-payment.scm

@@ -1,104 +0,0 @@
-;;
-;; qr-payment.scm
-;;
-;; QR payment generator.
-;;
-;; ISC License
-;;
-;; Copyright 2023-2025 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 qr-payment))
-
-(module
-    qr-payment
-    (
-     make-qrp
-     make-brmlab-qrp
-     make-brmlab-qrp-svg-string
-     )
-
-  (import scheme
-	  (chicken format)
-	  (chicken string)
-	  (chicken base)
-	  util-io)
-
-  (define (make-empty-qrp . vs)
-    (let ((v (if (null? vs) "1.0" (car vs))))
-      (list v "SPD")))
-
-  (define (add-field-to-qrp qrp key value)
-    (cons (format "~A:~A" key value)
-	  qrp))
-
-  (define (serialize-qrp qrp)
-    (string-intersperse (reverse qrp) "*"))
-
-  (define (ensure-amount-format amt)
-    (let* ((n (if (string? amt)
-		  (string->number amt)
-		  amt))
-	   (s (number->string n))
-	   (f (string-split s "."))
-	   (i? (null? (cdr f))))
-      (format "~A.~A"
-	      (car f)
-	      (if i?
-		  "00"
-		  (substring
-		   (string-append (cadr f) "0")
-		   0 2)))))
-
-  (define (make-qrp iban amt cc vs msg)
-    (let loop ((keys '(ACC AM CC MSG X-VS))
-	       (vals (list iban (ensure-amount-format amt) cc msg vs))
-	       (qrp (make-empty-qrp)))
-      (if (null? keys)
-	  (serialize-qrp qrp)
-	  (loop (cdr keys)
-		(cdr vals)
-		(add-field-to-qrp qrp (car keys) (car vals))))))
-
-  (define (make-brmlab-qrp amt cc vs)
-    (let ((iban (if (equal? cc "CZK")
-		    "CZ0520100000002500079551"
-		    (if (equal? cc "EUR")
-			"CZ9320100000002100079552"
-			(error "Invalid currency!")))))
-      (make-qrp iban amt cc vs "Brmlab")))
-
-  (define (qrp-create-svg-string qrps)
-    (let-values
-	(((ec ol)
-	  (get-process-exit+output-lines
-	   "qrencode"
-	   "-t" "svg"
-	   "--inline"
-	   "-o" "-"
-	   "-l" "M"
-	   qrps)))
-      (if (eq? ec 0)
-	  (string-intersperse ol "\n")
-	  #f)))
-
-  (define (make-brmlab-qrp-svg-string amt cc vs)
-    (qrp-create-svg-string
-     (make-brmlab-qrp amt cc vs)))
-
-  )

src/texts.scm

@@ -5,7 +5,7 @@
 ;;
 ;; ISC License
 ;;
-;; Copyright 2023-2025 Brmlab, z.s.
+;; Copyright 2023 Brmlab, z.s.
 ;; Dominik Pantůček <dominik.pantucek@trustica.cz>
 ;;
 ;; Permission to use, copy, modify, and/or distribute this software
@@ -39,7 +39,7 @@
 	 (chicken format))
 
  ;; Short banner
- (define banner-line "HackerBase 1.19-dev (c) 2023-2025 Brmlab, z.s.")
+ (define banner-line "HackerBase 1.17 (c) 2023-2024 Brmlab, z.s.")
 
  ;; Banner source with numbers for ANSI CSI SGR
  (define banner-source "