brmlab/hackerbase
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Add brmember-format module.

Browse source
This commit is contained in:
Dominik Pantůček 2023-04-11 13:26:38 +02:00
parent dd7d43fda4
commit 9f98bcb17d
3 changed files with 72 additions and 26 deletions
Download patch file Download diff file Expand all files Collapse all files

9
src/Makefile
View file

@ -47,7 +47,8 @@ HACKERBASE-OBJS=hackerbase.o testing.o listing.o month.o period.o \
member-parser.o web-static.o environment.o mailman.o \
util-set-list.o util-time.o util-tag.o util-io.o \
util-string.o util-io.o util-list.o util-parser.o texts.o \
tests.o util-proc.o util-mail.o reminders.o util-format.o
tests.o util-proc.o util-mail.o reminders.o util-format.o \
brmember-format.o
.PHONY: imports
imports: $(HACKERBASE-DEPS)
@ -326,3 +327,9 @@ UTIL-FORMAT-SOURCES=util-format.scm
util-format.o: util-format.import.scm
util-format.import.scm: $(UTIL-FORMAT-SOURCES)
BRMEMBER-FORMAT-SOURCES=brmember-format.scm util-dict-list.import.scm \
member-record.import.scm
brmember-format.o: brmember-format.import.scm
brmember-format.import.scm: $(BRMEMBER-FORMAT-SOURCES)

64
src/brmember-format.scm Normal file
View file

@ -0,0 +1,64 @@
;;
;; brmember-format.scm
;;
;; "Simple" formatting function that gathers information from other
;; modules.
;;
;; 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 brmember-format))
(module
brmember-format
(
brmember-format
)
(import scheme
(chicken string)
(chicken format)
util-dict-list
member-record)
;; Member formatting function for general use.
(define (brmember-format fmt mr)
(let loop ((fmtl (string->list fmt))
(resl '()))
(if (null? fmtl)
(string-intersperse (reverse resl) "")
(let ((ch (car fmtl)))
(if (eq? ch #\~)
(loop (cddr fmtl)
(cons (case (cadr fmtl)
((#\N) (member-record-info mr 'nick))
((#\I) (number->string (member-id mr)))
((#\S) (number->string (member-suspended-months mr)))
((#\E)
(let ((n (length (ldict-ref mr 'highlights '()))))
(if (eq? n 0)
""
(sprintf "[~A]" n))))
((#\~) "~"))
resl))
(loop (cdr fmtl)
(cons (make-string 1 (car fmtl)) resl)))))))
)

25
src/member-record.scm
View file

@ -61,8 +61,6 @@
member-id
member-suspended-months
member-format
member<?
member-record-add-payment
@ -321,29 +319,6 @@
0))
0))
;; Member formatting function for general use.
(define (member-format fmt mr)
(let loop ((fmtl (string->list fmt))
(resl '()))
(if (null? fmtl)
(string-intersperse (reverse resl) "")
(let ((ch (car fmtl)))
(if (eq? ch #\~)
(loop (cddr fmtl)
(cons (case (cadr fmtl)
((#\N) (member-record-info mr 'nick))
((#\I) (number->string (member-id mr)))
((#\S) (number->string (member-suspended-months mr)))
((#\E)
(let ((n (length (ldict-ref mr 'highlights '()))))
(if (eq? n 0)
""
(sprintf "[~A]" n))))
((#\~) "~"))
resl))
(loop (cdr fmtl)
(cons (make-string 1 (car fmtl)) resl)))))))
;; Comparator of member records based on nickname.
(define (member<? a b)
(string-ci<? (member-nick a)