[cl-carbon-cvs] CVS update: CL-Carbon/application.lisp CL-Carbon/event.lisp CL-Carbon/window.lisp
David Steuber
dsteuber at common-lisp.net
Fri May 6 04:41:48 UTC 2005
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)
More information about the Cl-carbon-cvs
mailing list