Finish splitting mailman 2.x driver.

src/mailman.scm

@@ -34,13 +34,21 @@
   find-mailman-list
   
   email-in-mailman-list?
+
+  mailman-ensure-member
+  mailman-ensure-not-member
+  
+  mailman-compare-members
+  
+  mailman-sync-members
   )
 
  (import scheme
 	 (chicken base)
 	 (chicken module)
 	 mailman2
-	 mailman-common)
+	 mailman-common
+	 util-bst-lset)
 
  (define *mailman-version* (make-parameter 2))
 
@@ -69,4 +77,41 @@
  (define (find-mailman-list lsts name)
    (assoc name lsts))
 
+ (define-mailman-proc add-email-to-mailman-list add-email-to-mailman2-list)
+ (define-mailman-proc remove-email-from-mailman-list remove-email-from-mailman2-list)
+
+ ;; Ensures given email is in given ML
+ (define (mailman-ensure-member ml email)
+   (when (not (email-in-mailman-list? ml email))
+     (add-email-to-mailman-list (mailman-list-name ml) email)))
+
+ ;; Makes sure given member is removed
+ (define (mailman-ensure-not-member ml email)
+   (when (email-in-mailman-list? ml email)
+     (remove-email-from-mailman-list (mailman-list-name ml) email)))
+
+
+ ;; Returns two values - missing members and surplus list members
+ (define (mailman-compare-members ml emails)
+   (let* ((mlemails (list->lset (mailman-list-members ml)))
+	  (emails (list->lset emails))
+	  (surplus (lset-subtract mlemails emails))
+	  (missing (lset-subtract emails mlemails)))
+     (values (lset->list missing)
+	     (lset->list surplus))))
+
+ ;; Ensures given ML subscribers are exactly what is in emails list
+ (define (mailman-sync-members ml emails)
+   (let-values (((missing surplus)
+		 (mailman-compare-members ml emails)))
+     (let ((listname (mailman-list-name ml)))
+       (let loop ((emails missing))
+	 (when (not (null? emails))
+	   (add-email-to-mailman-list listname (car emails))
+	   (loop (cdr emails))))
+       (let loop ((emails surplus))
+	 (when (not (null? emails))
+	   (remove-email-from-mailman-list listname (car emails))
+	   (loop (cdr emails)))))))
+
  )

src/mailman2.scm

@@ -35,15 +35,8 @@
   load-mailman2-list
   load-mailman2-lists
   
-  add-email-to-mailman-list
+  add-email-to-mailman2-list
-  remove-email-from-mailman-list
+  remove-email-from-mailman2-list
-  
-  mailman-ensure-member
-  mailman-ensure-not-member
-  
-  mailman-compare-members
-  
-  mailman-sync-members
   )
 
  (import scheme
@@ -125,7 +118,7 @@
 		    (add1 idx))))))))
 
  ;; Adds given email to given listname
- (define (add-email-to-mailman-list listname email)
+ (define (add-email-to-mailman2-list listname email)
    (print "Add " email " to " listname ".")
    (let ((result
 	  (mailman-send/recv
@@ -138,7 +131,7 @@
 	 (loop (cdr lines))))))
 
  ;; Removes given email from given listname
- (define (remove-email-from-mailman-list listname email)
+ (define (remove-email-from-mailman2-list listname email)
    (print "Remove " email " from " listname ".")
    (let ((result
 	  (get-mailman-output-lines
@@ -149,37 +142,4 @@
 	 (print " | " (car lines))
 	 (loop (cdr lines))))))
 
- ;; Ensures given email is in given ML
- (define (mailman-ensure-member ml email)
-   (when (not (email-in-mailman-list? ml email))
-     (add-email-to-mailman-list (mailman-list-name ml) email)))
-
- ;; Makes sure given member is removed
- (define (mailman-ensure-not-member ml email)
-   (when (email-in-mailman-list? ml email)
-     (remove-email-from-mailman-list (mailman-list-name ml) email)))
-
- ;; Returns two values - missing members and surplus list members
- (define (mailman-compare-members ml emails)
-   (let* ((mlemails (list->lset (mailman-list-members ml)))
-	  (emails (list->lset emails))
-	  (surplus (lset-subtract mlemails emails))
-	  (missing (lset-subtract emails mlemails)))
-     (values (lset->list missing)
-	     (lset->list surplus))))
-
- ;; Ensures given ML subscribers are exactly what is in emails list
- (define (mailman-sync-members ml emails)
-   (let-values (((missing surplus)
-		 (mailman-compare-members ml emails)))
-     (let ((listname (mailman-list-name ml)))
-       (let loop ((emails missing))
-	 (when (not (null? emails))
-	   (add-email-to-mailman-list listname (car emails))
-	   (loop (cdr emails))))
-       (let loop ((emails surplus))
-	 (when (not (null? emails))
-	   (remove-email-from-mailman-list listname (car emails))
-	   (loop (cdr emails)))))))
-
  )