do-macro-for-children
Fri Aug 24 04:01:11 PDT 2007 Ryszard Szopa <ryszard.szopa@gmail.com>
* do-macro-for-children
diff -rN -u old-mop-utils/mop-utils.lisp new-mop-utils/mop-utils.lisp
--- old-mop-utils/mop-utils.lisp 2014-07-22 00:25:45.000000000 -0700
+++ new-mop-utils/mop-utils.lisp 2014-07-22 00:25:45.000000000 -0700
@@ -5,7 +5,7 @@
(:documentation "A set of Metaobject Protocol utilities.")
(:use :cl #+sbcl :sb-mop #-sbcl :closer-mop)
(:export #:defmetaclass #:class-name-of #:slots-of #:slot-names-of #:get-slot-of-by-name #:get-slot-by-name
- #:do-children))
+ #:do-children #:do-macro-for-children))
(in-package :mop-utils)
@@ -98,4 +98,13 @@
(let ((children (class-direct-subclasses (find-class class-name))))
`(loop :for ,var :in ',children
:do ,@body)))
+
+(defmacro do-macro-for-children (macro class-name)
+ "Use MACRO with the names of all the subclasses of the class named
+by CLASS-NAME."
+ (let ((child (gensym "child"))
+ (child-name (gensym "child-name")))
+ `(do-children (,child ,class-name)
+ (let ((,child-name (class-name ,child)))
+ (eval `(,',macro ,,child-name))))))
\ No newline at end of file