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 ,@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))) + ,@commonArgPairs)))) \ No newline at end of file