Update of /project/cl-carbon/cvsroot/CL-Carbon In directory common-lisp.net:/tmp/cvs-serv27829
Modified Files: application.lisp event.lisp window.lisp Log Message: Added code to hopefully delete the event handler so that the associated object can be freed. Also removed a slot from the cl-carbon:window class. Objects should generally not know about their containers.
Date: Fri May 6 06:41:47 2005 Author: dsteuber
Index: CL-Carbon/application.lisp diff -u CL-Carbon/application.lisp:1.2 CL-Carbon/application.lisp:1.3 --- CL-Carbon/application.lisp:1.2 Wed May 4 11:15:54 2005 +++ CL-Carbon/application.lisp Fri May 6 06:41:47 2005 @@ -8,7 +8,7 @@ ;;;; Programmer: David Steuber ;;;; Date Started: 1/26/2005 ;;;; -;;;; $Id: application.lisp,v 1.2 2005/05/04 09:15:54 dsteuber Exp $ +;;;; $Id: application.lisp,v 1.3 2005/05/06 04:41:47 dsteuber Exp $ ;;;; *********************************************************************** ;;;; ;;;; Copyright (c) 2005 by David Steuber @@ -56,8 +56,7 @@ (require-noerror (install-event-handler app (#_GetApplicationEventTarget) - (get-event-type-specs app) - (ccl::%null-ptr)))) + (get-event-type-specs app))))
(defmethod get-event-type-specs ((app application)) `(,(carbon:make-event-type-spec #$kEventClassCommand #$kEventCommandProcess)))
Index: CL-Carbon/event.lisp diff -u CL-Carbon/event.lisp:1.2 CL-Carbon/event.lisp:1.3 --- CL-Carbon/event.lisp:1.2 Wed May 4 11:15:54 2005 +++ CL-Carbon/event.lisp Fri May 6 06:41:47 2005 @@ -8,7 +8,7 @@ ;;;; Programmer: David Steuber ;;;; Date Started: 1/27/2005 ;;;; -;;;; $Id: event.lisp,v 1.2 2005/05/04 09:15:54 dsteuber Exp $ +;;;; $Id: event.lisp,v 1.3 2005/05/06 04:41:47 dsteuber Exp $ ;;;; *********************************************************************** ;;;; ;;;; Copyright (c) 2005 by David Steuber @@ -37,7 +37,7 @@ (in-package :cl-carbon)
(defclass event-target () - ((user-data :initform (ccl::%null-ptr)) + ((event-handler-callback :initform (ccl::%null-ptr)) (event-handler-ref :initform (ccl::%null-ptr))) (:documentation "An object that receives Carbon events"))
@@ -66,10 +66,10 @@ (declare (ignore command)) nil)
-(defgeneric install-event-handler (event-target target event-type-specs user-data) +(defgeneric install-event-handler (event-target target event-type-specs) (:documentation "Installs an event handler"))
-(defmethod install-event-handler ((et event-target) target event-type-specs userdata) +(defmethod install-event-handler ((et event-target) target event-type-specs) (let* ((num-specs (length event-type-specs)) (offset 0) (event-specs (ccl::malloc (* num-specs (ccl::record-length :<e>vent<t>ype<s>pec))))) @@ -79,26 +79,27 @@ (setf (ccl::%get-unsigned-long event-specs offset) (ets-event-kind ets)) (incf offset (ccl::record-length :unsigned))) (rlet ((ehr :<e>vent<h>andler<r>ef)) - (let ((retval (#_InstallEventHandler target - (#_NewEventHandlerUPP (make-event-target-callback et)) - num-specs - event-specs - userdata - ehr))) - (ccl::free event-specs) - (with-slots (user-data event-handler-ref) et - (setf user-data userdata) - (setf event-handler-ref (ccl::%get-ptr ehr)) - (debug-log "Installed event handler: ~S~%" event-handler-ref)) - retval)))) + (with-slots (event-handler-callback event-handler-ref) et + (let ((retval (#_InstallEventHandler target + (#_NewEventHandlerUPP (setf event-handler-callback + (make-event-target-callback et))) + num-specs + event-specs + (ccl::%null-ptr) + ehr))) + (ccl::free event-specs) + (setf event-handler-ref (ccl::%get-ptr ehr)) + (debug-log "Installed event handler: ~S~%" event-handler-ref) + retval)))))
(defgeneric remove-event-handler (event-target) (:documentation "Removes (uninstalls) an event handler"))
(defmethod remove-event-handler ((et event-target)) - (with-slots (event-handler-ref) et + (with-slots (event-handler-callback event-handler-ref) et (debug-log "Removing event handler: ~S~%" event-handler-ref) - (#_RemoveEventHandler event-handler-ref))) + (#_RemoveEventHandler event-handler-ref) + (delete-event-target-callback event-handler-callback)))
(defgeneric add-event-types-to-handler (event-target event-specs))
@@ -141,9 +142,9 @@ (menu-command et (ccl::pref command :<hic>ommand.command<id>))))
(defun make-event-target-callback (et) - (let (fn) - (declare (special fn)) - (ccl:defcallback fn + (let (fn-carbon-event-handler) + (declare (special fn-carbon-event-handler)) + (ccl:defcallback fn-carbon-event-handler (:<e>vent<h>andler<c>all<r>ef next-handler :<e>vent<r>ef event (:* t) user-data :<oss>tatus) (let ((class (#_GetEventClass event)) (kind (#_GetEventKind event))) @@ -157,4 +158,18 @@ (when c (debug-log "Condition signaled from CARBON-EVENT-HANDLER: < ~A >~%" c)) (if r #$noErr #$eventNotHandledErr)))) - fn)) \ No newline at end of file + fn-carbon-event-handler)) + +;; this function is based on code that Gary Byers posted to openmcl-devel +(defun delete-event-target-callback (pointer) + (with-lock-grabbed (ccl::*callback-lock*) + (let ((index (dotimes (i (length ccl::%pascal-functions%)) + (when (eql (ccl::pfe.routine-descriptor (svref ccl::%pascal-functions% i)) + pointer) + (return i))))) + (when index + (let ((entry (svref ccl::%pascal-functions% index))) + (setf (svref ccl::%pascal-functions% index) nil) + (ccl::free (ccl::pfe.routine-descriptor entry)) + t))))) +
Index: CL-Carbon/window.lisp diff -u CL-Carbon/window.lisp:1.1.1.1 CL-Carbon/window.lisp:1.2 --- CL-Carbon/window.lisp:1.1.1.1 Fri Apr 29 22:19:03 2005 +++ CL-Carbon/window.lisp Fri May 6 06:41:47 2005 @@ -8,7 +8,7 @@ ;;;; Programmer: David Steuber ;;;; Date Started: 1/29/2005 ;;;; -;;;; $Id: window.lisp,v 1.1.1.1 2005/04/29 20:19:03 dsteuber Exp $ +;;;; $Id: window.lisp,v 1.2 2005/05/06 04:41:47 dsteuber Exp $ ;;;; *********************************************************************** ;;;; ;;;; Copyright (c) 2005 by David Steuber @@ -37,10 +37,8 @@ (in-package :cl-carbon)
(defclass window (event-target) - ((owner :accessor window-owner :initarg :owner :initform nil ; TODO: Remove window-owner and all references - :documentation "The object that owns this window") - (window-ptr :accessor window-ptr :initform nil - :documentation "The MACPTR that holds the Carbon WindowRef")) + ((window-ptr :accessor window-ptr :initform nil + :documentation "The MACPTR that holds the Carbon WindowRef")) (:documentation "Proxy for a Carbon window"))
@@ -60,7 +58,7 @@ ;; (with-slots (window-ptr) w (install-event-handler w (#_GetWindowEventTarget window-ptr) - (get-event-type-specs w) window-ptr)) + (get-event-type-specs w))) v))
(defgeneric create-window (window)