Add brmember-format module.
This commit is contained in:
parent
dd7d43fda4
commit
9f98bcb17d
3 changed files with 72 additions and 26 deletions
|
@ -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 \
|
member-parser.o web-static.o environment.o mailman.o \
|
||||||
util-set-list.o util-time.o util-tag.o util-io.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 \
|
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
|
.PHONY: imports
|
||||||
imports: $(HACKERBASE-DEPS)
|
imports: $(HACKERBASE-DEPS)
|
||||||
|
@ -326,3 +327,9 @@ UTIL-FORMAT-SOURCES=util-format.scm
|
||||||
|
|
||||||
util-format.o: util-format.import.scm
|
util-format.o: util-format.import.scm
|
||||||
util-format.import.scm: $(UTIL-FORMAT-SOURCES)
|
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
64
src/brmember-format.scm
Normal 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)))))))
|
||||||
|
|
||||||
|
)
|
|
@ -61,8 +61,6 @@
|
||||||
member-id
|
member-id
|
||||||
member-suspended-months
|
member-suspended-months
|
||||||
|
|
||||||
member-format
|
|
||||||
|
|
||||||
member<?
|
member<?
|
||||||
|
|
||||||
member-record-add-payment
|
member-record-add-payment
|
||||||
|
@ -321,29 +319,6 @@
|
||||||
0))
|
0))
|
||||||
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.
|
;; Comparator of member records based on nickname.
|
||||||
(define (member<? a b)
|
(define (member<? a b)
|
||||||
(string-ci<? (member-nick a)
|
(string-ci<? (member-nick a)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue