[cl-carbon-cvs] CVS update: CL-Carbon/application.lisp CL-Carbon/event.lisp
David Steuber
dsteuber at common-lisp.net
Wed May 4 09:15:55 UTC 2005
Update of /project/cl-carbon/cvsroot/CL-Carbon
In directory common-lisp.net:/tmp/cvs-serv29155
Modified Files:
application.lisp event.lisp
Log Message:
Converted Carbon event handler callback to a closure.
This makes the Carbon event dispatching code cleaner,
easier to maintain, and faster. It looks like it works
quite nicely too.
I did a little other cleanup as a consequence.
Date: Wed May 4 11:15:54 2005
Author: dsteuber
Index: CL-Carbon/application.lisp
diff -u CL-Carbon/application.lisp:1.1.1.1 CL-Carbon/application.lisp:1.2
--- CL-Carbon/application.lisp:1.1.1.1 Fri Apr 29 22:19:03 2005
+++ CL-Carbon/application.lisp Wed May 4 11:15:54 2005
@@ -8,7 +8,7 @@
;;;; Programmer: David Steuber
;;;; Date Started: 1/26/2005
;;;;
-;;;; $Id: application.lisp,v 1.1.1.1 2005/04/29 20:19:03 dsteuber Exp $
+;;;; $Id: application.lisp,v 1.2 2005/05/04 09:15:54 dsteuber Exp $
;;;; ***********************************************************************
;;;;
;;;; Copyright (c) 2005 by David Steuber
@@ -51,14 +51,13 @@
(defmethod initialize-instance :after ((app application) &rest initargs)
(declare (ignore initargs))
- (enable-debug-log (make-pathname :directory (ccl::getenv "HOME") :name "OpenGL Demo debug" :type "log"))
+ (enable-debug-log (make-pathname :directory (ccl::getenv "HOME") :name "CL-Carbon application debug" :type "log"))
(debug-log "Initializing Carbon application -- CARBON:APPLICATION.INITIALIZE-APPLICATION called~%")
(require-noerror
(install-event-handler app
(#_GetApplicationEventTarget)
(get-event-type-specs app)
- (ccl::%null-ptr)))
- (debug-log "Event handler ~S installed.~%" carbon-event-handler))
+ (ccl::%null-ptr))))
(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.1.1.1 CL-Carbon/event.lisp:1.2
--- CL-Carbon/event.lisp:1.1.1.1 Fri Apr 29 22:19:03 2005
+++ CL-Carbon/event.lisp Wed May 4 11:15:54 2005
@@ -8,7 +8,7 @@
;;;; Programmer: David Steuber
;;;; Date Started: 1/27/2005
;;;;
-;;;; $Id: event.lisp,v 1.1.1.1 2005/04/29 20:19:03 dsteuber Exp $
+;;;; $Id: event.lisp,v 1.2 2005/05/04 09:15:54 dsteuber Exp $
;;;; ***********************************************************************
;;;;
;;;; Copyright (c) 2005 by David Steuber
@@ -36,22 +36,6 @@
(in-package :cl-carbon)
-(defparameter carbon-event-handler nil
- "A MACPTR containing the carbon event handler callback")
-(defparameter *event-targets* (make-hash-table)
- "A collection of event-targets")
-(defparameter *conditions* nil
- "Conditions raised in the event handler")
-
-(defun add-event-target (macptr obj)
- (setf (gethash macptr *event-targets*) obj))
-
-(defun find-event-target (macptr)
- (gethash macptr *event-targets*))
-
-(defun delete-event-target (macptr)
- (remhash macptr *event-targets*))
-
(defclass event-target ()
((user-data :initform (ccl::%null-ptr))
(event-handler-ref :initform (ccl::%null-ptr)))
@@ -86,7 +70,6 @@
(:documentation "Installs an event handler"))
(defmethod install-event-handler ((et event-target) target event-type-specs userdata)
- (add-event-target userdata et)
(let* ((num-specs (length event-type-specs))
(offset 0)
(event-specs (ccl::malloc (* num-specs (ccl::record-length :<e>vent<t>ype<s>pec)))))
@@ -97,7 +80,7 @@
(incf offset (ccl::record-length :unsigned)))
(rlet ((ehr :<e>vent<h>andler<r>ef))
(let ((retval (#_InstallEventHandler target
- (#_NewEventHandlerUPP carbon-event-handler)
+ (#_NewEventHandlerUPP (make-event-target-callback et))
num-specs
event-specs
userdata
@@ -105,17 +88,17 @@
(ccl::free event-specs)
(with-slots (user-data event-handler-ref) et
(setf user-data userdata)
- (setf event-handler-ref (ccl::%get-ptr ehr)))
+ (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 (user-data event-handler-ref) et
- (debug-log "Removing event handler: ~S~%" user-data)
- (#_RemoveEventHandler event-handler-ref)
- (delete-event-target user-data)))
+ (with-slots (event-handler-ref) et
+ (debug-log "Removing event handler: ~S~%" event-handler-ref)
+ (#_RemoveEventHandler event-handler-ref)))
(defgeneric add-event-types-to-handler (event-target event-specs))
@@ -153,20 +136,25 @@
(declare (ignore next-handler user-data))
(rlet ((command :<hic>ommand))
(#_GetEventParameter event #$kEventParamDirectObject #$typeHICommand
- (ccl::%null-ptr) (ccl::record-length :<HIC>ommand)
+ (ccl::%null-ptr) (ccl::record-length :<hic>ommand)
(ccl::%null-ptr) command)
(menu-command et (ccl::pref command :<hic>ommand.command<id>))))
-(ccl::defcallback carbon-event-handler
- (:<e>vent<h>andler<c>all<r>ef next-handler :<e>vent<r>ef event (:* t) user-data :<oss>tatus)
- (let ((ev-class (#_GetEventClass event))
- (ev-kind (#_GetEventKind event)))
- (debug-log "Callback CARBON-EVENT-HANDLER: user-data = ~S; Class: '~A' Kind: ~A~%"
- user-data (int32-to-string ev-class) ev-kind)
- (multiple-value-bind (r c)
- (ignore-errors
- (handle-event (find-event-target user-data) ev-class ev-kind next-handler event user-data))
- (when c
- (push c *conditions*)
- (debug-log "Condition signaled: < ~A >~%" c))
- (if r #$noErr #$eventNotHandledErr))))
+(defun make-event-target-callback (et)
+ (let (fn)
+ (declare (special fn))
+ (ccl:defcallback fn
+ (:<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)))
+ (declare (dynamic-extent class kind))
+ (debug-log "Callback CARBON-EVENT-HANDLER: event-handler-ref = ~S; Class: '~A' Kind: ~A~%"
+ (slot-value et 'event-handler-ref) (int32-to-string class) kind)
+ (multiple-value-bind (r c)
+ (ignore-errors
+ (handle-event et class kind next-handler event user-data))
+ (declare (dynamic-extent r c))
+ (when c
+ (debug-log "Condition signaled from CARBON-EVENT-HANDLER: < ~A >~%" c))
+ (if r #$noErr #$eventNotHandledErr))))
+ fn))
\ No newline at end of file
More information about the Cl-carbon-cvs
mailing list