Work on making the lists more 2.xx-like.

This commit is contained in:
Dominik Pantůček 2023-09-15 17:50:00 +02:00
parent d802cf13c8
commit aaa6e582a4
4 changed files with 44 additions and 42 deletions

View file

@ -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)

View file

@ -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)

View file

@ -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<?))
;; Loads a single mailman list as mailman structure, if
;; unsuccessfull, returns only a list with ML name and no member
;; emails.
(define (load-mailman2-list name)
(make-mailman-list name
(list-mailman2-list-members name)))
;; Loads all lists and members
(define (load-mailman2-lists)
(with-progress%
#t "Mailman"
(progress%-advance 0)
(let* ((lists (list-mailman2-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-mailman2-list mln) res)
(add1 idx))))))))
;; Adds given email to given listname
(define (add-email-to-mailman2-list listname email)
(print "Add " email " to " listname ".")

View file

@ -35,6 +35,7 @@
(import scheme
(chicken string)
(chicken sort)
(chicken format)
configuration
util-io)
@ -51,12 +52,14 @@
;; Returns the list of available lists
(define (list-mailman3-lists)
(get-mailman3-output-lines "lists -q"))
(get-mailman3-output-lines "lists" "-q"))
;; Returns the list of members of given list
(define (list-mailman3-list-members lst)
(sort
(get-mailman3-output-lines "members" lst "-e")
(get-mailman3-output-lines "members"
(format "~A@brmlab.cz" lst)
"-e")
string-ci<?))
)