diff --git a/src/Makefile b/src/Makefile index 4a62a53..3cbaf92 100644 --- a/src/Makefile +++ b/src/Makefile @@ -258,10 +258,9 @@ ENVIRONMENT-SOURCES=environment.scm ansi.import.scm environment.o: environment.import.scm environment.import.scm: $(ENVIRONMENT-SOURCES) -MAILMAN2-SOURCES=mailman2.scm progress.import.scm \ - util-bst-lset.import.scm util-io.import.scm \ - util-list.import.scm mailman-common.import.scm \ - configuration.import.scm +MAILMAN2-SOURCES=mailman2.scm util-bst-lset.import.scm \ + util-io.import.scm util-list.import.scm \ + mailman-common.import.scm configuration.import.scm mailman2.o: mailman2.import.scm mailman2.import.scm: $(MAILMAN2-SOURCES) @@ -532,7 +531,8 @@ util-bst-lset.import.scm: $(UTIL-BST-LSET-SOURCES) MAILMAN-SOURCES=mailman.scm mailman2.import.scm \ mailman-common.import.scm util-bst-lset.import.scm \ - configuration.import.scm mailman3.import.scm + configuration.import.scm mailman3.import.scm \ + progress.import.scm mailman.o: mailman.import.scm mailman.import.scm: $(MAILMAN-SOURCES) diff --git a/src/mailman.scm b/src/mailman.scm index 4ff85c0..cbb5c62 100644 --- a/src/mailman.scm +++ b/src/mailman.scm @@ -31,6 +31,9 @@ mailman-list-name mailman-list-members + load-mailman-list + load-mailman-lists + find-mailman-list email-in-mailman-list? @@ -50,7 +53,8 @@ mailman-common util-bst-lset configuration - mailman3) + mailman3 + progress) ;; Syntax for simplifying export of case-version procedures (define-syntax define-mailman-proc @@ -73,8 +77,35 @@ list-mailman2-lists list-mailman3-lists) (define-mailman-proc list-mailman-list-members list-mailman2-list-members list-mailman3-list-members) - (define-mailman-proc load-mailman-list load-mailman2-list) - (define-mailman-proc load-mailman-lists load-mailman2-lists) + + ;; Loads a single mailman list as mailman structure, if + ;; unsuccessfull, returns only a list with ML name and no member + ;; emails. + (define (load-mailman-list name) + (make-mailman-list name + (list-mailman-list-members name))) + + ;; Loads all lists and members + (define (load-mailman-lists) + (with-progress% + #t "Mailman" + (progress%-advance 0) + (let* ((lists (list-mailman-lists)) + (total (length lists))) + (let loop ((lsts lists) + (res '()) + (idx 0)) + (if (null? lsts) + (let () + (progress%-advance 1) + ;; Will be prepended, therefore reversing result is a + ;; bad idea! + res) + (let ((mln (car lsts))) + (progress%-advance (/ idx total)) + (loop (cdr lsts) + (cons (load-mailman-list mln) res) + (add1 idx)))))))) ;; List of lists, returns the whole list record (including name) (define (find-mailman-list lsts name) diff --git a/src/mailman2.scm b/src/mailman2.scm index 81308ce..e5d7c24 100644 --- a/src/mailman2.scm +++ b/src/mailman2.scm @@ -30,8 +30,6 @@ ( list-mailman2-lists list-mailman2-list-members - load-mailman2-list - load-mailman2-lists add-email-to-mailman2-list remove-email-from-mailman2-list @@ -44,7 +42,6 @@ (chicken sort) (chicken format) util-list - progress util-bst-lset util-io mailman-common @@ -79,35 +76,6 @@ (get-mailman-output-lines "list_members" lst) string-ci