Use table for member information, fix a few design mistakes in period/month display.

Makefile

@@ -143,7 +143,7 @@ MEMBERS-BASE-SOURCES=members-base.scm testing.import.scm		\
 	utils.import.scm dictionary.import.scm member-file.import.scm	\
 	primes.import.scm member-record.import.scm ansi.import.scm	\
 	period.import.scm month.import.scm configuration.import.scm	\
-	progress.import.scm
+	progress.import.scm table.import.scm
 
 members-base.so: members-base.o
 members-base.o: members-base.import.scm
@@ -164,7 +164,7 @@ primes.import.scm: $(PRIMES-SOURCES)
 MEMBER-RECORD-SOURCES=member-record.scm dictionary.import.scm		\
 	period.import.scm testing.import.scm month.import.scm		\
 	member-file.import.scm listing.import.scm ansi.import.scm	\
-	configuration.import.scm
+	configuration.import.scm table.import.scm utils.import.scm
 
 member-record.so: member-record.o
 member-record.o: member-record.import.scm

bbstool.scm

@@ -126,7 +126,7 @@ CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
    (print "Current month: " (month->string (*current-month*)))
    (newline)
    (if mr
-       (print-member-record-info mr)
+       (print-member-record-table mr)
        (print-members-base-info MB))
    (newline))
   ((print-stats)

member-record.scm

@@ -30,6 +30,7 @@
  member-record
  (
   print-member-record-info
+  print-member-record-table
   member-destroyed?
   member-suspended?
   member-active?
@@ -57,7 +58,9 @@
 	 member-file
 	 listing
 	 ansi
-	 configuration)
+	 configuration
+	 table
+	 utils)
 
  ;; Prints human-readable information
  (define (print-member-record-info mr)
@@ -88,6 +91,56 @@
 			v)))
 	   (loop (cdr sinfo)))))))
 
+ ;; Prints nicely formatted table
+ (define (print-member-record-table mr)
+   (let* ((aliases (mr-ref mr 'symlinks))
+	  (head (list (list "ID:" (mr-ref mr 'id))
+		      (list (sprintf "Alias~A:" (if (> (length aliases) 1) "es" ""))
+			    (string-intersperse (map symbol->string aliases) ", "))
+		      (if (member-suspended? mr)
+			  (list "Suspended for:"
+				(let ((msm (member-suspended-months mr)))
+				  (sprintf "~A month~A" msm
+					   (if (> msm 1) "s" ""))))
+			  #f)))
+	  (info (dict-ref mr 'info))
+	  (sikeys (sort (dict-keys info)
+			(lambda (a b)
+			  (string<?
+			   (symbol->string a)
+			   (symbol->string b)))))
+	  (body (map (lambda (k)
+		       (if (eq? k member-file-error-symbol)
+			   #f
+			   (let ((v (dict-ref info k)))
+			     (case k
+			       ((joined)
+				(list k (month->string v)))
+			       ((card desfire credit)
+				(list k
+				      (table->string
+				       (map
+					(lambda (c)
+					  (list (car c) (cdr c)))
+					v)
+				       #:col-border #t)))
+			       ((suspend student)
+				(list k
+				      (table->string
+				       (cons (list "Since" "Until")
+					     (map
+					      (lambda (p)
+						(list
+						 (month->string (car p))
+						 (month->string (cdr p))))
+					      v))
+				       #:col-border #t)))
+			       (else
+				(list k v))))))
+		     sikeys))
+	  (result (filter identity (append head body))))
+     (print (table->string result #:table-border #t #:row-border #t #:col-border #t))))
+
  ;; Returns key from the top-level (members-base) record if it exists,
  ;; queries the 'info key otherwise. Optional default argument works
  ;; like with dict-ref.

month.scm

@@ -87,14 +87,16 @@
 
  ;; Formats (valid) month as YYYY-MM string
  (define (month->string M)
-   (if (month-valid? M)
+   (if M
-       (let ((y (car M))
+       (if (month-valid? M)
-	     (m (cadr M)))
+	   (let ((y (car M))
-	 (sprintf "~A-~A~A"
+		 (m (cadr M)))
-		  y
+	     (sprintf "~A-~A~A"
-		  (if (< m 10) "0" "")
+		      y
-		  m))
+		      (if (< m 10) "0" "")
-       (error 'string->month "Invalid month" M)))
+		      m))
+	   (error 'string->month "Invalid month" M))
+       "____-__"))
 
  ;; Returns true if both arguments are a valid month and are equal
  (define (month=? m n)

table.scm

@@ -31,10 +31,6 @@
   *table-border-style*
   table->string
   table-tests!
-  ;;---
-  table-row-delimiter
-  table-row-delimiter/styled
-  table-borders-lookup
   )
 
  (import scheme
@@ -48,7 +44,20 @@
 	 utils)
 
  ;; Default table border style to use if not explicitly specified.
- (define *table-border-style* (make-parameter 'ascii))
+ (define *table-border-style* (make-parameter 'unicode))
+
+ ;; Table border styles in visual form
+ (define table-borders-lookup-source
+   '((ascii
+      "/=,\\"
+      "] |["
+      ">-+<"
+      "'~^`")
+     (unicode
+      "┌─┬┐"
+      "│ ││"
+      "├─┼┤"
+      "└─┴┘")))
 
  ;; Returns a list of strings representing the rows in the original
  ;; string.
@@ -130,9 +139,9 @@
 	 (reverse r)
 	 (loop (cdr c)
 	       (cons (let* ((cs (car c))
-			    (csl (string-length cs)))
+			    (csl (ansi-string-length cs)))
 		       (if (< csl w)
-			   (string-append cs (make-string (- w csl) #\space))
+			   (string-append cs (string-repeat " " (- w csl)))
 			   cs))
 		     r)))))
 
@@ -165,19 +174,6 @@
       (table-stringify
        (table-rectangularize tbl))))))
 
- ;; Table border styles in visual form
- (define table-borders-lookup-source
-   '((ascii
-      "/=,\\"
-      "] |["
-      ">-+<"
-      "'~^`")
-     (unicode
-      "┌─┬┐"
-      "│ ││"
-      "├─┼┤"
-      "└─┴┘")))
-
  ;; Compiled table borders for rendering
  (define table-borders-lookup
    (map (lambda (src)
@@ -237,7 +233,7 @@
 	 (let* ((table-border (get-keyword #:table-border args (lambda () #f)))
 		(row-border (get-keyword #:row-border args (lambda () #f)))
 		(column-border (get-keyword #:col-border args (lambda () #f)))
-		(border-style (get-keyword #:border-style args (lambda () 'ascii)))
+		(border-style (get-keyword #:border-style args (lambda () (*table-border-style*))))
 		(stylepair (assq border-style table-borders-lookup))
 		(stylevec
 		 (if stylepair