[cells-cvs] CVS update: cells/cells.lpr cells/fm-utilities.lisp cells/md-utilities.lisp

[Kenny Tilton]

Update of /project/cells/cvsroot/cells
In directory common-lisp.net:/tmp/cvs-serv7918

Modified Files:
	cells.lpr fm-utilities.lisp md-utilities.lisp 
Log Message:
mere synchronization
Date: Mon Sep 26 17:05:42 2005
Author: ktilton

Index: cells/cells.lpr
diff -u cells/cells.lpr:1.5 cells/cells.lpr:1.6
--- cells/cells.lpr:1.5	Fri Aug 26 16:28:00 2005
+++ cells/cells.lpr	Mon Sep 26 17:05:42 2005
@@ -1,4 +1,4 @@
-;; -*- lisp-version: "7.0 [Windows] (Aug 5, 2005 12:23)"; cg: "1.54.2.17"; -*-
+;; -*- lisp-version: "7.0 [Windows] (Sep 4, 2005 16:25)"; cg: "1.54.2.17"; -*-
 
 (in-package :cg-user)
 


Index: cells/fm-utilities.lisp
diff -u cells/fm-utilities.lisp:1.2 cells/fm-utilities.lisp:1.3
--- cells/fm-utilities.lisp:1.2	Sat May 21 03:40:53 2005
+++ cells/fm-utilities.lisp	Mon Sep 26 17:05:42 2005
@@ -25,9 +25,10 @@
 (defparameter *fmdbg* nil)
 
 (eval-when (compile eval load)
-  (export '(make-part mk-part fm-other fm-other? fm-traverse fm-descendant-typed do-like-fm-parts
+  (export '(make-part mk-part fm-other fm-other? fm-traverse fm-descendant-typed
+             do-like-fm-parts
              container-typed *fmdbg* fm-other-v fm! fm^ fm-find-one fm-kid-named
-             
+             fm-prior-sib
              fm-value-dictionary fm-otherv?)))
 
 (defun make-part (partname part-class &rest initargs)


Index: cells/md-utilities.lisp
diff -u cells/md-utilities.lisp:1.1 cells/md-utilities.lisp:1.2
--- cells/md-utilities.lisp:1.1	Fri May  6 23:05:45 2005
+++ cells/md-utilities.lisp	Mon Sep 26 17:05:42 2005
@@ -104,3 +104,18 @@
 (defun make-be (class &rest initargs)
   (to-be (apply 'make-instance class initargs)))
 
+(defmacro defparts (partName (partClass &rest partDefArgs)
+                   &optional customArgs customValuesList
+                   &rest commonArgPairs)
+  (assert (null partDefArgs))
+  (let ((part-no (gensym))
+        (cvls (gensym)))
+    `(loop with ,cvls = (list , at customValuesList)
+           for ,part-no below ,(max 1 (length customValuesList))
+           for custom-values = (elt ,part-no cvs)
+           collecting (make-instance ',partClass
+                      :md-name ',partName
+                      ,@(loop for arg in customargs
+                              for n below (length customargs)
+                              nconcing (list arg `(elt ,n custom-values)))
+                      , at commonArgPairs))))
\ No newline at end of file