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