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

Start moving universal procedures to the common mailman module.

Browse source
This commit is contained in:
Dominik Pantůček 2023-09-14 21:51:09 +02:00
parent 6edc7ce0de
commit 7b0db71b01
2 changed files with 14 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

10
src/mailman.scm
View file

@ -27,7 +27,9 @@
(module (module
mailman mailman
() (
find-mailman-list
)
(import scheme (import scheme
(chicken base) (chicken base)
@ -54,5 +56,11 @@
(define-mailman-proc list-mailman-lists list-mailman2-lists) (define-mailman-proc list-mailman-lists list-mailman2-lists)
(define-mailman-proc list-mailman-list-members list-mailman2-list-members) (define-mailman-proc list-mailman-list-members list-mailman2-list-members)
(define-mailman-proc load-mailman-list load-mailman2-list)
(define-mailman-proc load-mailman-lists load-mailman2-lists)
;; List of lists, returns the whole list record (including name)
(define (find-mailman-list lsts name)
(assoc name lsts))
) )

16
src/mailman2.scm
View file

@ -32,10 +32,8 @@
list-mailman2-lists list-mailman2-lists
list-mailman2-list-members list-mailman2-list-members
load-mailman-list load-mailman2-list
load-mailman-lists load-mailman2-lists
find-mailman-list
mailman-list-name mailman-list-name
mailman-list-members mailman-list-members
@ -108,12 +106,12 @@
;; Loads a single mailman list as mailman structure, if ;; Loads a single mailman list as mailman structure, if
;; unsuccessfull, returns only a list with ML name and no member ;; unsuccessfull, returns only a list with ML name and no member
;; emails. ;; emails.
(define (load-mailman-list name) (define (load-mailman2-list name)
(make-mailman-list name (make-mailman-list name
(list-mailman2-list-members name))) (list-mailman2-list-members name)))
;; Loads all lists and members ;; Loads all lists and members
(define (load-mailman-lists) (define (load-mailman2-lists)
(with-progress% (with-progress%
#t "Mailman" #t "Mailman"
(progress%-advance 0) (progress%-advance 0)
@ -131,13 +129,9 @@
(let ((mln (car lsts))) (let ((mln (car lsts)))
(progress%-advance (/ idx total)) (progress%-advance (/ idx total))
(loop (cdr lsts) (loop (cdr lsts)
(cons (load-mailman-list mln) res) (cons (load-mailman2-list mln) res)
(add1 idx)))))))) (add1 idx))))))))
;; List of lists, returns the whole list record (including name)
(define (find-mailman-list lsts name)
(assoc name lsts))
;; Returns #t if the email is in given ml ;; Returns #t if the email is in given ml
(define (email-in-mailman-list? ml email) (define (email-in-mailman-list? ml email)
(if (lset-member? (list->lset (mailman-list-members ml) string-ci=?) (if (lset-member? (list->lset (mailman-list-members ml) string-ci=?)