May 2005 - cl-carbon-cvs@lists.common-lisp.net

[cl-carbon-cvs] CVS update: CL-Carbon/package.lisp CL-Carbon/utils.lisp
by dsteuber＠common-lisp.net 21 May '05

21 May '05

Update of /project/cl-carbon/cvsroot/CL-Carbon In directory common-lisp.net:/tmp/cvs-serv14938 Modified Files: package.lisp utils.lisp Log Message: Fixed macros in utils.lisp that were using FFI reader macros with side effects. This bug showed up as undeclared free variables that are created by the #$ reader macros. I also made some utility functions for the #_ reader macro functions being used in utils.lisp macros. This should allow dfsl files to work properly when loaded into an image even though they were created during a different lisp session. I also did some package exports cleanup. Instead of using EXPORT in utils.lisp, I moved the exported symbols to the :exports section of the DEFPACKAGE form in package.lisp. At some point, those exports probably should be sorted into alphabetical order. I tested these chages with Example which I have not made any changes to. Example symlinks in CL-Carbon, so the make script can't remove dfsl files built when making CL-Carbon which was hiding the bug from me. Example still seems to work. It just needs to use more of CL-Carbon :-). Date: Sat May 21 09:27:22 2005 Author: dsteuber Index: CL-Carbon/package.lisp diff -u CL-Carbon/package.lisp:1.1.1.1 CL-Carbon/package.lisp:1.2 --- CL-Carbon/package.lisp:1.1.1.1 Fri Apr 29 22:19:03 2005 +++ CL-Carbon/package.lisp Sat May 21 09:27:21 2005 @@ -8,7 +8,7 @@ ;;;; Programmer: David Steuber ;;;; Date Started: 1/21/2005 ;;;; -;;;; $Id: package.lisp,v 1.1.1.1 2005/04/29 20:19:03 dsteuber Exp $ +;;;; $Id: package.lisp,v 1.2 2005/05/21 07:27:21 dsteuber Exp $ ;;;; *********************************************************************** ;;;; ;;;; Copyright (c) 2005 by David Steuber @@ -74,6 +74,13 @@ "DISABLE-DEBUGGING" "DEBUG-LOG" "INT32-TO-STRING" + "WITH-CFSTRING" + "WITH-CFSTRINGS" + "CONST-CFSTRING" + "MAKE-CFSTRING" + "REQUIRE-NOERROR" + "SHOW-ALERT" + "MAKE-LISP-STRING-FROM-CFSTRINGREF" "NIB" "NIB-FILE-NAME" "NIB-RESOURCE-NAME"))) Index: CL-Carbon/utils.lisp diff -u CL-Carbon/utils.lisp:1.1.1.1 CL-Carbon/utils.lisp:1.2 --- CL-Carbon/utils.lisp:1.1.1.1 Fri Apr 29 22:19:03 2005 +++ CL-Carbon/utils.lisp Sat May 21 09:27:21 2005 @@ -8,7 +8,7 @@ ;;;; Programmer: David Steuber ;;;; Date Started: 1/21/2005 ;;;; -;;;; $Id: utils.lisp,v 1.1.1.1 2005/04/29 20:19:03 dsteuber Exp $ +;;;; $Id: utils.lisp,v 1.2 2005/05/21 07:27:21 dsteuber Exp $ ;;;; *********************************************************************** ;;;; ;;;; Copyright (c) 2005 by David Steuber @@ -36,37 +36,38 @@ (in-package :cl-carbon) +(defun cf-string-make-constant-string (s) + (#___CFStringMakeConstantString s)) + (defmacro const-cfstring (str) (let ((s (gensym))) - `(ccl::with-cstr (,s ,str) (#___CFStringMakeConstantString ,s)))) -(export 'const-cfstring) + `(ccl::with-cstr (,s ,str) (cl-carbon::cf-string-make-constant-string ,s)))) (defun make-cfstring (str) "Allocates a CFString object stored in a MACPTR which must be CFRelease(d) when no longer needed." (ccl::with-cstr (cstr str) (#_CFStringCreateWithCString (ccl:%null-ptr) cstr #$kCFStringEncodingMacRoman))) -(export 'make-cfstring) + +(defun cf-release (cf-ptr) + (#_CFRelease cf-ptr)) (defmacro with-cfstring ((sym str) &rest body) "Create, use, and then release a CFString." `(let ((,sym (make-cfstring ,str))) (unwind-protect (progn ,@body) - (#_CFRelease ,sym)))) -(export 'with-cfstring) + (cl-carbon::cf-release ,sym)))) (defmacro with-cfstrings (speclist &body body) "Create, use, and then release CFStrings." (ccl::with-specs-aux 'with-cfstring speclist body)) -(export 'with-cfstrings) (defmacro require-noerror (&body forms) (let* ((err (gensym)) (body (reverse `(let (,err))))) (dolist (form forms (nreverse body)) (push `(setf ,err ,form) body) - (push `(assert (eql ,err #$noErr)) body)))) -(export 'require-noerror) + (push `(assert (eql ,err #.#.(read-from-string "#$noErr"))) body)))) (defmacro case-equal (exp &body clauses) (let ((temp (gensym))) @@ -80,12 +81,10 @@ `((member ,temp ',keys :test #'equal) ,@clause-forms))))) clauses))))) -(export 'case-equal) (defun show-alert (s) (ccl::with-pstr (message-str s) (#_StandardAlert #$kAlertNoteAlert message-str (%null-ptr) (%null-ptr) (%null-ptr)))) -(export 'show-alert) (defun make-lisp-string-from-cfstringref (ptr &optional (encoding #$kCFStringEncodingMacRoman)) "Use the CFStringRef in ptr to make a Lisp string useing the provided encoding." @@ -95,4 +94,3 @@ (when (= 1 (#_CFStringGetCString ptr buffer 1024 encoding)) (ccl::%get-cstring buffer))) (ccl::%get-cstring (ccl::%get-ptr cstr))))) -(export 'make-lisp-string-from-cfstringref)

1 0

[cl-carbon-cvs] CVS update: CL-Carbon/application.lisp CL-Carbon/event.lisp CL-Carbon/window.lisp
by dsteuber＠common-lisp.net 06 May '05

06 May '05

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)

1 0

[cl-carbon-cvs] CVS update: CL-Carbon/application.lisp CL-Carbon/event.lisp
by dsteuber＠common-lisp.net 04 May '05

04 May '05

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

1 0

[cl-carbon-cvs] CVS update: Module imported: Example
by dsteuber＠common-lisp.net 02 May '05

02 May '05

Update of /project/cl-carbon/cvsroot/Example In directory common-lisp.net:/home/dsteuber/usr/src/Example Log Message: Initial checkin of Example project that uses CL-Carbon. Status: Vendor Tag: INITIAL Release Tags: start N Example/example.asd N Example/make.sh N Example/bin/Example.app/Contents/Info.plist N Example/bin/Example.app/Contents/PkgInfo N Example/bin/Example.app/Contents/Resources/English.lproj/InfoPlist.strings N Example/bin/Example.app/Contents/Resources/English.lproj/main.nib/classes.nib N Example/bin/Example.app/Contents/Resources/English.lproj/main.nib/info.nib N Example/bin/Example.app/Contents/Resources/English.lproj/main.nib/objects.xib N Example/src/main.dfsl N Example/src/main.lisp N Example/src/package.dfsl N Example/src/package.lisp No conflicts created by this import Date: Tue May 3 00:35:22 2005 Author: dsteuber New module Example added

1 0