;; ;; 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 brmember) ;; 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) (brmember-nick mr)) ((#\I) (number->string (brmember-id mr))) ((#\S) (number->string (brmember-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))))))) )