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 | ||||
| * 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 | ||||
|  |  | |||
|  | @ -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) | ||||
|  |  | |||
							
								
								
									
										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	\
 | ||||
| 	 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	\
 | ||||
|  | @ -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) | ||||
|  | @ -205,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) | ||||
|  | @ -543,3 +545,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 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. | ||||
| ;; | ||||
|  |  | |||
|  | @ -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) | ||||
| 
 | ||||
|  |  | |||
|  | @ -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) | ||||
|  | @ -406,7 +409,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) | ||||
|  |  | |||
|  | @ -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 | ||||
|  |  | |||
|  | @ -77,13 +77,25 @@ | |||
| 	       (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)) | ||||
| 			  (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)) | ||||
| 			  (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))) | ||||
| 
 | ||||
|  ;; Special comparator (originally with JendaSAP hack) | ||||
|  |  | |||
|  | @ -67,7 +67,8 @@ | |||
| 	 cal-format | ||||
| 	 util-git | ||||
| 	 cal-day | ||||
| 	 racket-kwargs) | ||||
| 	 racket-kwargs | ||||
| 	 tiocgwinsz) | ||||
| 
 | ||||
|  (define *show-payments-count* (make-parameter 36)) | ||||
| 
 | ||||
|  | @ -267,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 brmember<?) | ||||
| 	   fmt) | ||||
| 	  60))) | ||||
| 	 (member-records->string | ||||
| 	  (sort mrs brmember<?) | ||||
| 	  fmt))) | ||||
| 
 | ||||
|  ;; Generic table of members attributes | ||||
|  (define (members-attrs-table mrs fmt hdr row) | ||||
|  | @ -301,102 +300,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) | ||||
| 		       brmember<?)) | ||||
| 	  (soon-expire-mrs (sort | ||||
| 			    (find-members-by-predicate | ||||
| 			     mb | ||||
| 			     (brmember-suspended-for 21 24)) | ||||
| 			    brmember<?))) | ||||
|      (print "Known members: " total-count) | ||||
|      (newline) | ||||
|      (print | ||||
|       (table->string | ||||
|        (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) | ||||
| 			 brmember<?)) | ||||
| 	    (soon-expire-mrs (sort | ||||
| 			      (find-members-by-predicate | ||||
| 			       mb | ||||
| 			       (brmember-suspended-for 21 24)) | ||||
| 			      brmember<?))) | ||||
|        (print "Known members: " total-count) | ||||
|        (newline) | ||||
|        (print | ||||
| 	(table->string | ||||
| 	 (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) | ||||
|  | @ -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<?))) | ||||
| 	    (balances (map (lambda (m) | ||||
| 			     (list-ref m 6)) | ||||
|  |  | |||
|  | @ -227,11 +227,39 @@ | |||
| 		 #: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) | ||||
| 		       ", "))))) | ||||
| 	  (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" | ||||
|  |  | |||
|  | @ -39,7 +39,7 @@ | |||
| 	 (chicken format)) | ||||
| 
 | ||||
|  ;; 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 | ||||
|  (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)) | ||||
| 
 | ||||
|  |  | |||
|  | @ -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)) | ||||
| 
 | ||||
|  |  | |||
|  | @ -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)) | ||||
| 
 | ||||
|  |  | |||
|  | @ -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)) | ||||
| 
 | ||||
|  |  | |||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue