Work on making the lists more 2.xx-like.
This commit is contained in:
parent
d802cf13c8
commit
aaa6e582a4
4 changed files with 44 additions and 42 deletions
10
src/Makefile
10
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)
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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 ".")
|
||||
|
|
|
@ -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<?))
|
||||
|
||||
)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue