diff --git a/src/Makefile b/src/Makefile index 71d0f72..3fa3cef 100644 --- a/src/Makefile +++ b/src/Makefile @@ -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) diff --git a/src/brmember-format.scm b/src/brmember-format.scm new file mode 100644 index 0000000..8eafeca --- /dev/null +++ b/src/brmember-format.scm @@ -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 +;; +;; 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))))))) + + ) diff --git a/src/member-record.scm b/src/member-record.scm index 5376865..b9896df 100644 --- a/src/member-record.scm +++ b/src/member-record.scm @@ -61,8 +61,6 @@ member-id member-suspended-months - member-format - memberlist 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