[noctool-cvs] CVS source

[imattsson]

Update of /project/noctool/cvsroot/source
In directory cl-net:/tmp/cvs-serv27841

Modified Files:
	config.lisp 
Log Message:
IM

New CLUSTER macro, all optional stuff has been moved into keyword
parameters. In the case of "no optionals given", there should be no change.
CLUSTER will now wrap its expansion in a LET with the counter variable
bound to low, then SETFed to each incremental value, so sub-forms can
correctly use the counter value for formatting.

New WITH-FORMAT added (alas, at the moment only catering for CL format
strings). Looks (rouyghly like):
(with-format (<spec1> ...) &body body)
The binding specifications are:
  (varname fmt-string [<variable> ...])


--- /project/noctool/cvsroot/source/config.lisp	2009/02/17 17:48:20	1.13
+++ /project/noctool/cvsroot/source/config.lisp	2009/02/18 17:56:12	1.14
@@ -177,18 +177,23 @@
   `(defnested ,mon-class (&rest options) :machine
      `(noctool::make-monitor ',',mon-class ,*config-object* , at options)))
 
-(defmacro cluster ((fmt low high &optional (name nil) (c-fmt t) (count nil)) form)
+(defmacro cluster ((fmt low high &key (counter (gensym "CFGCNT")) (name nil) (c-fmt t)) form)
   (let ((format-string (if c-fmt
 			   (translate-format fmt)
 			   fmt)) 
 	(name (or name
-		  (get-config-symbol "NAME")))
-        (count (or count
-                   (get-config-symbol "COUNT"))))
-    `(progn
-       ,@(loop for n from low to high
-            for realname = (format nil format-string n)
-            collect (subst n count (subst realname name form))))))
+		  (get-config-symbol "NAME"))))
+    `(let ((,counter 0))
+      ,@(loop for n from low to high
+	      for realname = (format nil format-string n)
+	      collect `(setf ,counter ,n)
+	      collect (substitute realname name form)))))
+
+(defmacro with-format (bind-list &body body)
+  (let ((let-bindings (loop for (var fmt-string . vars) in bind-list
+			    collect `(,var (format nil ,fmt-string , at vars)))))
+    `(let ,let-bindings
+      , at body)))
 
 (defun load (file)
   (let ((load-package (bodge-package)))
@@ -198,6 +203,7 @@
 	  (*loaded-objects* nil)
 	  )
       (cl:load file)
+
       (loop for val in *loaded-objects*
 	    do (cond ((typep val (find-class 'noctool::equipment))
 		      (noctool::default-monitors val)