From: jsancho <devnull@localhost>
Date: Tue, 31 May 2011 17:12:59 +0000 (+0000)
Subject: (no commit message)
X-Git-Url: https://git.jsancho.org/?a=commitdiff_plain;h=364a8728f17c1ab5c37486685cf3b848eee178c6;p=gacela.git

---

diff --git a/src/gacela_mobs.scm b/src/gacela_mobs.scm
index 09e296a..c0037f1 100755
--- a/src/gacela_mobs.scm
+++ b/src/gacela_mobs.scm
@@ -17,12 +17,16 @@
 
 (use-modules (srfi srfi-1))
 
+;;; Actions for mobs
+
+
+
 ;;; Mob Factory
 
 (define-macro (makemob name . methods)
   `(define* (,name . args)
      (let ((option (car args)))
-       ,(union
+       ,(lset-union eq?
 	 `(case option
 	    (:on (mob-on ',name))
 	    (:off (mob-off ',name)))
@@ -32,6 +36,20 @@
 		   (else (cons (list option `(apply ,body (cdr args))) (options (cddr m)))))))
 	 (options methods)))))
 
+(define-macro (makemob name . methods)
+  (define (options m)
+    (cond ((null? m) '((else #f)))
+	  (else
+	   (let ((option (caar m)) (body (cadar m)))
+	     (cons `((,option) (apply ,body (cdr args))) (options (cdr m)))))))
+  (let ((m (options methods)))
+    `(define (,name . args)
+       (let ((option (car args)))
+	 (case option
+	   ((#:on) (mob-on ',name))
+	   ((#:off) (mob-off ',name))
+	   ,@m)))))
+
 
 (define mob-on #f)
 (define run-mobs #f)
@@ -51,7 +69,8 @@
 		  (else
 		   (cond (function (function)))
 		   (catch #t (lambda () (apply (car mobs) (cons option args))) (lambda (key . args) #f))
-		   (or #t (run-mobs-rec (cdr mobs))))))))
+		   (or #t (run-mobs-rec (cdr mobs))))))
+	  (run-mobs-rec running-mobs)))
 
   (set! mob-off
 	(lambda (mob)
@@ -61,7 +80,7 @@
 	(lambda ()
 	  (do ((mob (pop mobs-to-add) (pop mobs-to-add))) ((null? mob))
 	    (push mob running-mobs)
-	    (secure-block nil (mob #:init)))
+	    (catch #t (lambda () (mob #:init)) (lambda (key . args) #f)))
 	  (set! running-mobs (reverse (lset-difference eq? running-mobs mobs-to-quit)))
 	  (set! mobs-to-quit '())))