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