[Openmcl-devel] Carbon FFI: How can I debug this?

[David Steuber]

I'm trying to get an event handler working so that I can be finished 
with Chapter 6 of Learning Carbon.  The problem is, I am getting no 
feedback from the program I've written.  I do not know how far along I 
go before the code fails.  How do people debug their code when FORMAT T 
doesn't send output through a SLIME swank socket.  Is there a way I can 
get FORMAT to send output there when it is called from the main thread?

Can anyone see anything obviously wrong with this code?

(defun main ()
   ;; Allow SLIME to connect
   (when *swank-port*
     (swank:create-server :port *swank-port* :dont-close t))

   (setf *main-window* (ccl::make-record :<w>indow<r>ef))

   (rlet ((nibref :<ibn>ib<r>ef)
          (mainspec :<e>vent<t>ype<s>pec :event<c>lass 
#$kEventClassCommand :event<k>ind #$kEventCommandProcess))
     (let ((err (#_CreateNibReference (const-cfstring "main") nibref)))
       (assert (eql err #$noErr) ()
               "unable to get the main menu nib reference")
       (setf err (#_SetMenuBarFromNib (ccl::%get-ptr nibref) 
(const-cfstring "MainMenu")))
       (assert (eql err #$noErr) ()
               "Can't set the menubar!")
       (setf err (#_CreateWindowFromNib (ccl::%get-ptr nibref) 
(const-cfstring "MainWindow") *main-window*))
       (assert (eql err #$noErr) ()
               "Can't create the main window!")
       (#_ShowWindow (ccl::%get-ptr *main-window*))
       (#_DisposeNibReference (ccl::%get-ptr nibref))

       ;; Install event handler
       (#_InstallEventHandler (#_GetWindowEventTarget *main-window*)
                              (#_NewEventHandlerUPP 
main-window-event-handler)
                              1 mainspec
                              *main-window*
                              (ccl::%null-ptr))

       ;; Start the main event loop
       (#_RunApplicationEventLoop)))

   (#_free *main-window*) ; superfluous since we are about to exit anyway

   (quit))

(ccl::defcallback main-window-event-handler
     (:<e>vent<h>andler<c>all<r>ef handler :<e>vent<r>ef event (:* t) 
user-data :<oss>tatus)
   (declare (ignore handler))
   (rlet ((command :<hic>ommand))
     (#_GetEventParameter event #$kEventParamDirectObject #$typeHICommand
                          (ccl::%null-ptr) 
(ccl::%foreign-type-or-record-size :<HIC>ommand :bytes)
                          (ccl::%null-ptr) command)
     (cond ((equal (ccl::pref command :<hic>ommand.command<id>)
                   +compute-command+)
            (compute-command-handler user-data)
            #$noErr)
           (t #$eventNotHandledErr))))

(defun compute-command-handler (windowref)
   (rlet ((mode-of-transport-button-group :<c>ontrol<h>andle)
          (travel-time-field :<c>ontrol<h>andle)
          (mode-of-transport-control-id :<c>ontrol<id>
                                        :signature 
+application-signature+
                                        :id 
+mode-of-transport-button-group-id+)
          (travel-time-control-id :<c>ontrol<id>
                                  :signature +application-signature+
                                  :id +travel-time-field-id+))
     (#_GetControlByID (ccl::%get-ptr windowref)
                       mode-of-transport-control-id 
mode-of-transport-button-group)
     (#_GetControlByID (ccl::%get-ptr windowref)
                       travel-time-control-id travel-time-field)
     (let* ((transport-mode-value (#_GetControl32BitValue 
mode-of-transport-button-group))
            (travel-time (cond ((= transport-mode-value +foot-mode+)
                                (/ (/ +distance-to-moon+ (/ 4.0 0.62)) 
+hours-per-day+))
                               ((= transport-mode-value +car-mode+)
                                (/ (/ +distance-to-moon+ (/ 70.0 0.62)) 
+hours-per-day+))
                               ((= transport-mode-value 
+commercial-jet-mode+)
                                (/ (/ +distance-to-moon+ (/ 600.0 0.62)) 
+hours-per-day+))
                               ((= transport-mode-value 
+apollo-spacecraft-mode+)
                                4)
                               (t -1.0))))
       (with-cfstring (text (format nil "~,2F" travel-time))
         (#_SetControlData travel-time-field #$kControlEntireControl 
#$kControlEditTextCFStringTag
                           (ccl::%foreign-type-or-record-size 
:<cfs>tring<r>ef :bytes) text))
       (#_Draw1Control travel-time-field))))