Use syntax for providing versioned mailman procedures.
This commit is contained in:
parent
ae048d505a
commit
6edc7ce0de
2 changed files with 23 additions and 9 deletions
|
@ -27,18 +27,32 @@
|
||||||
|
|
||||||
(module
|
(module
|
||||||
mailman
|
mailman
|
||||||
(
|
()
|
||||||
list-mailman-lists
|
|
||||||
)
|
|
||||||
|
|
||||||
(import scheme
|
(import scheme
|
||||||
(chicken base)
|
(chicken base)
|
||||||
|
(chicken module)
|
||||||
mailman2)
|
mailman2)
|
||||||
|
|
||||||
(define *mailman-version* (make-parameter 2))
|
(define *mailman-version* (make-parameter 2))
|
||||||
|
|
||||||
(define (list-mailman-lists)
|
(define-syntax define-mailman-proc
|
||||||
(case (*mailman-version*)
|
(syntax-rules ()
|
||||||
((2) (list-mailman2-lists))))
|
((_ name proc2)
|
||||||
|
(begin
|
||||||
|
(export name)
|
||||||
|
(define (name . args)
|
||||||
|
(case (*mailman-version*)
|
||||||
|
((2) (apply proc2 args))))))
|
||||||
|
((_ name proc2 proc3)
|
||||||
|
(begin
|
||||||
|
(export name)
|
||||||
|
(define (name . args)
|
||||||
|
(case (*mailman-version*)
|
||||||
|
((2) (apply proc2 args))
|
||||||
|
((3) (apply proc3 args))))))))
|
||||||
|
|
||||||
|
(define-mailman-proc list-mailman-lists list-mailman2-lists)
|
||||||
|
(define-mailman-proc list-mailman-list-members list-mailman2-list-members)
|
||||||
|
|
||||||
)
|
)
|
||||||
|
|
|
@ -31,7 +31,7 @@
|
||||||
*mailman2-bin*
|
*mailman2-bin*
|
||||||
|
|
||||||
list-mailman2-lists
|
list-mailman2-lists
|
||||||
list-mailman-list-members
|
list-mailman2-list-members
|
||||||
load-mailman-list
|
load-mailman-list
|
||||||
load-mailman-lists
|
load-mailman-lists
|
||||||
|
|
||||||
|
@ -91,7 +91,7 @@
|
||||||
(get-mailman-output-lines "list_lists" "-b"))
|
(get-mailman-output-lines "list_lists" "-b"))
|
||||||
|
|
||||||
;; Returns the list of members of given list
|
;; Returns the list of members of given list
|
||||||
(define (list-mailman-list-members lst)
|
(define (list-mailman2-list-members lst)
|
||||||
(sort
|
(sort
|
||||||
(get-mailman-output-lines "list_members" lst)
|
(get-mailman-output-lines "list_members" lst)
|
||||||
string-ci<?))
|
string-ci<?))
|
||||||
|
@ -110,7 +110,7 @@
|
||||||
;; emails.
|
;; emails.
|
||||||
(define (load-mailman-list name)
|
(define (load-mailman-list name)
|
||||||
(make-mailman-list name
|
(make-mailman-list name
|
||||||
(list-mailman-list-members name)))
|
(list-mailman2-list-members name)))
|
||||||
|
|
||||||
;; Loads all lists and members
|
;; Loads all lists and members
|
||||||
(define (load-mailman-lists)
|
(define (load-mailman-lists)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue