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

Modified Files: CELTK.lpr togl.lisp Log Message: Get destroy callbacks working on Togls

--- /project/cells/cvsroot/Celtk/CELTK.lpr 2006/05/24 20:38:54 1.12 +++ /project/cells/cvsroot/Celtk/CELTK.lpr 2006/05/27 06:04:22 1.13 @@ -10,6 +10,7 @@ (make-instance 'module :name "tk-interp.lisp") (make-instance 'module :name "tk-events.lisp") (make-instance 'module :name "tk-object.lisp") + (make-instance 'module :name "fileevent.lisp") (make-instance 'module :name "widget.lisp") (make-instance 'module :name "font.lisp") (make-instance 'module :name "layout.lisp") @@ -103,7 +104,7 @@ :old-space-size 256000 :new-space-size 6144 :runtime-build-option :standard - :on-initialization 'celtk::tk-test + :on-initialization 'celtk::test-fileevent :on-restart 'do-default-restart)

;; End of Project Definition --- /project/cells/cvsroot/Celtk/togl.lisp 2006/05/26 17:50:36 1.7 +++ /project/cells/cvsroot/Celtk/togl.lisp 2006/05/27 06:04:22 1.8 @@ -98,7 +98,7 @@ ;(assert (not (zerop (tk-init-stubs interp "8.1" 0)))) (togl_init interp) (togl-create-func (callback togl-create)) - ;;; needed? (togl-destroy-func (callback togl-destroy) + (togl-destroy-func (callback togl-destroy)) (togl-display-func (callback togl-display)) (togl-reshape-func (callback togl-reshape)) (togl-timer-func (callback togl-timer)) ;; probably want to make this optional @@ -175,6 +175,7 @@ (let ((,self-var (or (gethash (pointer-address ,ptr-var) (tkwins *tkw*)) (gethash (togl-ident ,ptr-var)(dictionary *tkw*))))) ,@preamble + (trc nil "selves" ,cb$ (togl-ident ,ptr-var) (gethash (pointer-address ,ptr-var) (tkwins *tkw*))(gethash (togl-ident ,ptr-var)(dictionary *tkw*))) (,(intern uc$) ,self-var)))) (defmethod ,(intern uc$) :around ((self togl)) (if (,(intern cb-slot$) self) @@ -183,7 +184,9 @@ (defmethod ,(intern uc$) ((self togl))))))

(def-togl-callback create () - (setf (togl-ptr self) togl-ptr)) + (setf (togl-ptr self) togl-ptr) + (setf (gethash (pointer-address togl-ptr) (tkwins *tkw*)) self)) + (def-togl-callback display ()) (def-togl-callback reshape ()) (def-togl-callback destroy ()) @@ -195,3 +198,16 @@ (tk-format-now "togl ~a ~{~(~a~) ~a~^ ~}" (path self)(tk-configurations self)))) ;; this leads to "togl <path> [-<config option> <value]*", in turn to togl_create

+ +;;; +;;;(DEFCFUN ("Togl_DestroyFunc" TOGL-DESTROY-FUNC) :VOID (CALLBACK :POINTER)) +;;;(defcallback togl-destroy :void ((togl-ptr :pointer)) +;;; (trc "togl-destroy ptr" togl-ptr (loop for k being the hash-keys of (tkwins *tkw*) +;;; collecting k)) +;;; (unless (c-stopped) +;;; (let ((self (or (gethash (pointer-address togl-ptr) (tkwins *tkw*)) (gethash (togl-ident togl-ptr) (dictionary *tkw*))))) +;;; +;;; (togl-destroy-using-class self)))) +;;;(DEFMETHOD TOGL-DESTROY-USING-CLASS :AROUND ((SELF TOGL)) +;;; (IF (CB-DESTROY SELF) (FUNCALL (CB-DESTROY SELF) SELF) (CALL-NEXT-METHOD))) +;;;(DEFMETHOD TOGL-DESTROY-USING-CLASS ((SELF TOGL))) \ No newline at end of file