From 2969a2833ccbd97a8a9b623e10d592c04f31469c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?=
 <dominik.pantucek@trustica.cz>
Date: Thu, 23 Mar 2023 16:56:07 +0100
Subject: [PATCH] Finish members base info table.

---
 README.md         | 12 +++++++++++-
 ansi.scm          | 34 ++++++++++++++++++++++++++++++++++
 bbstool.scm       |  4 +---
 configuration.scm |  4 ++++
 members-base.scm  | 41 ++++++++++++++++++++++++++++++++++++++++-
 5 files changed, 90 insertions(+), 5 deletions(-)

diff --git a/README.md b/README.md
index db5a6dd..45a9d87 100644
--- a/README.md
+++ b/README.md
@@ -358,11 +358,21 @@ Generic highlight of given text. Defaults to bold blue text.
 
     (ansi-string-length str)
 
-* ```str``` string that may contain ANSI CSI SGR sequences
+* ```str``` - string that may contain ANSI CSI SGR sequences
 
 Returns the string length in characters without any ANSI CSI SGR
 sequences contained.
 
+    (ansi-paragraph-format str width)
+
+* ```str``` - a string that may contain ANSI CSI SGR sequences
+* ```width``` - a number representing themaximum number of characters per line
+
+If the string ```str``` is longer than the supplied ```width```,
+splits it into multiple lines on word boundaries to wrap it
+nicely. The resulting string is free of ANSI CSI SGR sequences and may
+contain newline characters.
+
 ### Command Line parsing
 
 Generic syntax-based implementation of command-line options parsing
diff --git a/ansi.scm b/ansi.scm
index 968d9e1..14c5800 100644
--- a/ansi.scm
+++ b/ansi.scm
@@ -37,6 +37,7 @@
   a:muted
   a:highlight
   ansi-string-length
+  ansi-paragraph-format
   ansi-tests!
   )
 
@@ -109,6 +110,31 @@
 		      (loop (cdr lst) 0 len)
 		      (loop (cdr lst) 2 len))))))))
 
+ ;; Removes all ANSI CSI SGR sequences from the string.
+ (define (ansi-remove str)
+   (irregex-replace/all (irregex "\x1b\\[[0-9;]*[^0-9;]" 'u) str ""))
+
+ ;; Formats string as paragraph of maximum given width while removing
+ ;; all ANSI CSI SGR from it.
+ (define (ansi-paragraph-format str width)
+   (let loop ((words (string-split
+		      (ansi-remove str)))
+	      (res '("")))
+     (if (null? words)
+	 (string-intersperse (reverse res) "\n")
+	 (let* ((word (car words))
+		(wlen (ansi-string-length word))
+		(llen (ansi-string-length (car res))))
+	   (loop (cdr words)
+		 (if (> (+ llen wlen 1) width)
+		     (cons word res)
+		     (cons (string-append (car res)
+					  (if (eq? (string-length (car res)) 0)
+					      ""
+					      " ")
+					  word)
+			   (cdr res))))))))
+
  ;; Performs ANSI module self-tests.
  (define (ansi-tests!)
    (run-tests
@@ -120,6 +146,14 @@
     (test-eq? ansi-string-length (ansi-string-length "\x1b[1mtest") 4)
     (test-eq? ansi-string-length (ansi-string-length "\x1b[30mtest\x1b[0m") 4)
     (test-eq? ansi-string-length (ansi-string-length "\x1b[30mščřž\x1b[0m") 4)
+    (test-equal? ansi-remove (ansi-remove "\x1b[1mtest") "test")
+    (test-equal? ansi-remove (ansi-remove "\x1b[30mščřž\x1b[0m") "ščřž")
+    (test-equal? ansi-paragraph-format
+		 (ansi-paragraph-format "Formats string as paragraph of maximum given width" 80)
+		 "Formats string as paragraph of maximum given width")
+    (test-equal? ansi-paragraph-format
+		 (ansi-paragraph-format "Formats string as paragraph of maximum given width" 20)
+		 "Formats string as\nparagraph of maximum\ngiven width")
     ))
 
  )
diff --git a/bbstool.scm b/bbstool.scm
index 69fa086..4625a12 100644
--- a/bbstool.scm
+++ b/bbstool.scm
@@ -131,9 +131,7 @@ CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
    (newline)
    (if mr
        (print-member-record-table mr)
-       (let ()
-	 (print-members-base-info MB)
-	 (print-members-base-table MB)))
+       (print-members-base-table MB))
    (newline))
   ((print-stats)
    (newline)
diff --git a/configuration.scm b/configuration.scm
index 9d31cac..5bf834a 100644
--- a/configuration.scm
+++ b/configuration.scm
@@ -32,6 +32,7 @@
   *member-file-context*
   *member-file-check-syntax*
   *member-default-joined*
+  *member-suspend-max-months*
   )
 
  (import scheme
@@ -60,4 +61,7 @@
  ;; key is missing in member file.
  (define *member-default-joined* (make-parameter (make-month 2015 1)))
 
+ ;; How long the member can be suspended without any action required?
+ (define *member-suspend-max-months* (make-parameter 24))
+
  )
diff --git a/members-base.scm b/members-base.scm
index 6593540..78ded92 100644
--- a/members-base.scm
+++ b/members-base.scm
@@ -334,9 +334,48 @@
 	       (member-records->string (sort invalid-mrs member<?) "~N (~I)")
 	       a:default)))))
 
+ ;; Helper function for pretty-formatting the filtered members lists
+ ;; in a table.
+ (define (members-table-row a:? label mrs fmt)
+   (list (string-append a:? label)
+	 (length mrs)
+	 (ansi-paragraph-format
+	  (member-records->string
+	   (sort mrs member<?)
+	   fmt)
+	  60)))
+
  ;; Prints nicely aligned members base info
  (define (print-members-base-table mb)
-   (print "TEST"))
+   (let* ((bi (members-base-info mb))
+	  (all-mrs (dict-ref bi 'total))
+	  (invalid-mrs (dict-ref bi 'invalid))
+	  (active-mrs (dict-ref bi 'active))
+	  (suspended-mrs (dict-ref bi 'suspended))
+	  (destroyed-mrs (dict-ref bi 'destroyed))
+	  (student-mrs (dict-ref bi 'students)))
+     (print "Known members: " (length all-mrs))
+     (print
+      (table->string
+       (filter
+	identity
+	(list (list "Type" "Count" "List")
+	      (members-table-row a:success "Active:" active-mrs "~N~E")
+	      (members-table-row a:warning "Suspended:" suspended-mrs "~N~E")
+	      (members-table-row a:warning "Destroyed:" destroyed-mrs "~N~E")
+	      (let ((suspended2 (filter-members-by-predicate
+				 suspended-mrs
+				 (lambda (mr)
+				   (>= (member-suspended-months mr)
+				       (*member-suspend-max-months*))))))
+		(if (null? suspended2)
+		    #f
+		    (members-table-row (ansi #:magenta) "Suspended (long):" suspended2 "~N (~S)")))
+	      ))
+       #:ansi #t
+       #:row-border #t
+       #:col-border #t
+       ))))
 
  ;; Prints the stats in format used by gnuplot.
  (define (print-members-base-stats ms)