[cells-cvs] CVS Celtk

[fgoenninger]

Update of /project/cells/cvsroot/Celtk
In directory clnet:/tmp/cvs-serv8667

Modified Files:
	tk-object.lisp 
Log Message:
added: 1. deftk now automatically export the class of the widget
       2. it also exports the mk- macro for that class.
 
fixed: bug in tk-class-options generic function.

--- /project/cells/cvsroot/Celtk/tk-object.lisp	2008/03/17 20:33:57	1.14
+++ /project/cells/cvsroot/Celtk/tk-object.lisp	2008/03/23 11:52:56	1.15
@@ -70,12 +70,14 @@
          ,@(cdr (find :default-initargs defclass-options :key 'car))))
      (defmethod tk-class-options append ((self ,class))
        ',tk-options)
+     (export ',class)
      (export ',(loop for (slot nil) in tk-options
                    nconcing (list slot (intern (conc$ "^" slot)))))
      (defmacro ,(intern (conc$ "MK-" (symbol-name class))) (&rest inits)
        `(make-instance ',',class
           :fm-parent *parent*
-          , at inits)))))
+          , at inits))
+     (export ',(intern (conc$ "MK-" (symbol-name class)))))))
 
 (defun tk-options-normalize (tk-options)
   "normalize '(-aaa (tk-bbb -bbb)) => '((aaa -aaa)(tk-bbb -bbb))"
@@ -99,7 +101,7 @@
                                   (case (type-of self)
                                     (label '(pady padx height indicatoron relief tk-label))
                                     (otherwise '(pady padx #+hmmm height indicatoron relief tk-label))));;
-                     do (setf old (delete old all :key 'car))
+                     do (setf all (delete old all :key 'car))
                      finally (return all))))))
 
 (defun tk-config-option (self slot-name)