Back to index

plt-scheme  4.2.1
mredmac.cxx
Go to the documentation of this file.
00001 /*
00002  * File:        mredmac.cc
00003  * Purpose:     MrEd MacOS event loop
00004  * Author:      Matthew Flatt
00005  * Created:     1996
00006  * Copyright:   (c) 2004-2009 PLT Scheme Inc.
00007  * Copyright:   (c) 1996, Matthew Flatt
00008  */
00009 
00010 #include "common.h"
00011 
00012 #include "wx_main.h"
00013 #include "wx_win.h"
00014 #include "wx_frame.h"
00015 #include "wx_canvs.h"
00016 #include "wx_utils.h"
00017 #include "scheme.h"
00018 #include "wx_macevents.h"
00019 #include "wx_het.h"
00020 
00021 #include "mred.h"
00022 
00023 #include <unistd.h>
00024 #include <fcntl.h>
00025 
00026 #ifdef __i386__ 
00027 # include <CoreServices/CoreServices.h>
00028 # define wxNATIVE_LONG(x) EndianS32_BtoN((x).bigEndianValue)
00029 #else
00030 # define wxNATIVE_LONG(x) x
00031 #endif
00032 
00033 static int dispatched = 1;
00034 
00035 extern "C" {
00036   typedef void (*HANDLE_AE)(EventRecord *e);
00037 }
00038 
00039 class MrQueueElem; /* defined below */
00040 
00041 static void QueueTransferredEvent(EventRecord *e);
00042 static void MrDequeue(MrQueueElem *q);
00043 
00044 WindowPtr MrEdMouseWindow(Point where);
00045 WindowPtr MrEdKeyWindow();
00046 
00047 int wx_leave_all_input_alone;
00048 
00049 extern int wxTranslateRawKey(int key);
00050 extern short wxMacDisableMods;
00051 
00052 typedef MrQueueElem *MrQueueRef;
00053 
00054 typedef int (*Checker_Func)(EventRecord *evt, MrQueueRef q, int check_only, 
00055                          MrEdContext *c, MrEdContext *keyOk, 
00056                          EventRecord *event, MrEdContext **which);
00057 
00058 typedef struct EventFinderClosure {
00059   int check_only;
00060   MrEdContext *c;
00061   MrEdContext *keyOk;
00062   EventRecord *event;
00063   MrEdContext **which;
00064   Checker_Func checker;
00065 } EventFinderClosure;
00066 
00067 static int queue_size, max_queue_size;
00068 static int mouse_down_in_flight;
00069 
00070 Bool wx_ignore_key; /* used in wxItem */
00071 
00072 void MrEdInitFirstContext(MrEdContext *)
00073 {
00074 }
00075 
00076 void MrEdInitNewContext(MrEdContext *)
00077 {
00078 } 
00079 
00080 void MrEdDestroyContext(MrEdFinalizedContext *)
00081 {
00082 }
00083 
00084 int MrEdGetDoubleTime(void)
00085 {
00086   return (int)(GetDblTime() * 16.67);
00087 }
00088 
00089 static wxFrame *_wxWindowPtrToFrame(WindowPtr w, wxChildList *l)
00090 {
00091   wxChildNode *n;
00092 
00093   for (n = l->First(); n; n = n->Next()) {
00094     wxFrame *f;
00095     f = (wxFrame *)n->Data();
00096     if (f->macWindow() == w)
00097       return f;
00098   }
00099 
00100   return NULL;
00101 }
00102 
00103 static wxFrame *wxWindowPtrToFrame(WindowPtr w, MrEdContext *c)
00104 {
00105   if (c)
00106     return _wxWindowPtrToFrame(w, c->topLevelWindowList);
00107   else {
00108     for (c = mred_contexts; c; c = c->next) {
00109       wxFrame *f;
00110       if ((f = _wxWindowPtrToFrame(w, c->topLevelWindowList)))
00111        return f;
00112     }
00113   }
00114 
00115   return NULL;
00116 }
00117 
00118 static void UpdateRgnToWindowCoords(WindowPtr w, RgnHandle updateRgn)
00119 {
00120   Rect windowBounds;
00121   RgnHandle contentRgn;
00122   
00123   GetWindowBounds(w, kWindowGlobalPortRgn, &windowBounds);
00124 
00125   /* Avoid overflow in offset: */
00126   contentRgn = NewRgn();
00127   if (contentRgn) {
00128     GetWindowRegion(w, kWindowContentRgn, contentRgn);
00129     SectRgn(contentRgn, updateRgn, updateRgn);
00130     DisposeRgn(contentRgn);
00131   }
00132   
00133   OffsetRgn(updateRgn, -1 * windowBounds.left, -1 * windowBounds.top);
00134 }
00135 
00136 /***************************************************************************/
00137 /*                            shadow event queue                           */
00138 /***************************************************************************/
00139 
00140 /*
00141    We need two things from the event queue:
00142 
00143     * We need to handle the event queue non-sequentially.  That is, we
00144       want to handle certain kinds of events before handling other
00145       kinds of events.
00146 
00147     * We need to be able to sleep until a new (potentially ready to
00148       handle) event arrives in the queue.
00149 
00150    The only solution appears to be sucking all of the events into a
00151    queue of our own, and dealing with them there.  This causes certain
00152    problems, but not horrible ones.
00153 */
00154 
00155 
00156 class MrQueueElem {
00157 public:
00158   EventRecord event;
00159   RgnHandle rgn;
00160   int half_done; /* e.g., window brought to front */
00161   MrQueueElem *next, *prev;
00162 };
00163 
00164 static MrQueueElem *first, *last;
00165 
00166 /* QueueTransferredEvent takes an event and puts it
00167  * in the MrEd queue, with several exceptions.
00168  * 1. Update events.  Update events are sent by the OS
00169  *    whenever the OS queue does not contain an update
00170  *    event and the update region is not empty.  That is,
00171  *    the OS will keep poking you until the update region
00172  *    is empty.  To get around this, QTE clears the update
00173  *    region manually (and then must reinstate it when it's
00174  *    time to handle the event.  ick.
00175  * 2. high level events. Dispatched immediately, and the
00176  *    handlers queue work in MzScheme threads.
00177  * 3. suspendResumeMessage. See comment at top.
00178  */
00179 
00180 static void QueueTransferredEvent(EventRecord *e)
00181 {
00182   MrQueueElem *q;
00183   int done;
00184   
00185   dispatched = 0;
00186   
00187   done = 0;
00188   if (e->what == updateEvt) {
00189     WindowPtr w = (WindowPtr)e->message;
00190     for (q = first; q; q = q->next) {
00191       if ((q->event.what == updateEvt)
00192          && (w == ((WindowPtr)q->event.message))) {
00193         RgnHandle updateRgn;
00194        updateRgn = NewRgn();
00195 
00196         GetWindowRegion(w, kWindowUpdateRgn, updateRgn);       
00197 
00198        /* Shift to window coords, because the window might
00199           move before we handle the update */
00200        UpdateRgnToWindowCoords(w, updateRgn);
00201 
00202         UnionRgn(updateRgn, q->rgn, q->rgn);
00203        DisposeRgn(updateRgn);
00204 
00205         BeginUpdate(w);
00206         EndUpdate(w);
00207         return;
00208       }
00209     }
00210   }
00211     
00212   if (e->what == kHighLevelEvent) {
00213     /* We have to dispatch the event immediately */
00214     AEProcessAppleEvent(e);
00215     return;
00216   }
00217 
00218   if ((e->what == osEvt) && !(((e->message >> 24) & 0x0ff) == suspendResumeMessage))
00219     return;
00220 
00221   q = new WXGC_PTRS MrQueueElem;
00222   memcpy(&q->event, e, sizeof(EventRecord));
00223   q->next = NULL;
00224   q->prev = last;
00225   if (last)
00226     last->next = q;
00227   else
00228     first = q;
00229   last = q;
00230   
00231   queue_size++;
00232   if (queue_size > max_queue_size) {
00233     max_queue_size = queue_size;
00234   }
00235 
00236   if ((e->what == mouseDown)
00237       || (e->what == mouseMenuDown)) {
00238     mouse_down_in_flight = 1;
00239   }
00240 
00241   q->rgn = NULL;
00242   
00243   if (e->what == updateEvt) {
00244     WindowPtr w = (WindowPtr)e->message;
00245     q->rgn = NewRgn();
00246     GetWindowRegion(w, kWindowUpdateRgn, q->rgn);
00247     BeginUpdate(w);
00248     EndUpdate(w);
00249 
00250     /* Shift to window coords, because the window might
00251        move before we handle the update */
00252     UpdateRgnToWindowCoords(w, q->rgn);
00253   } else if (e->what == osEvt) {
00254     /* Must be a suspend/resume event */
00255     int we_are_front = e->message & resumeFlag;
00256     WindowPtr front;
00257 
00258     front = ActiveNonFloatingWindow();
00259     
00260     /* Generate an activate event */
00261     q->event.what = activateEvt;
00262     q->event.modifiers = we_are_front ? activeFlag : 0;
00263     q->event.message = (long)front;
00264   }
00265 }
00266 
00267 /* Called by wxWindows to queue leave and activate events: */
00268  
00269 void QueueMrEdEvent(EventRecord *e)
00270 {
00271   QueueTransferredEvent(e);
00272 }
00273 
00274 void DequeueMrEdEvents(int type, long message)
00275 {
00276   /* Remove matching events: */
00277   MrQueueElem *qq, *next;
00278   for (qq = first; qq; qq = next) {
00279     next = qq->next;
00280     if ((qq->event.what == type)
00281        && ((long)qq->event.message == message))
00282       MrDequeue(qq);
00283   }
00284 }
00285 
00286 static RgnHandle mouseRgn;
00287 static int waiting_for_next_event;
00288 static int wne_handlersInstalled;
00289 static int pending_self_ae;
00290 
00291 static void EnsureWNEReturn()
00292 {
00293   /* Generate an event that WaitNextEvent() will return, but that we can
00294      recognize and ignore. (Note that window handlers can run nested
00295      event handlers, such as the resize handler for the little
00296      OS-provided window to implement Chinese text via pinyin. We need
00297      something that doesn't break those loops.) An AppleEvent is a
00298      heavyweight(?) but apparently reliable way to get WaitNextEvent() to
00299      return. Of course, don't install the standard handlers that are put
00300      in place by RunApplicationEventLoop(), because they'll dispatch the 
00301      dummy AppleEvent and defeat the purpose. */
00302   if (!pending_self_ae) {
00303     ProcessSerialNumber psn;
00304     AppleEvent ae, ae_target;
00305 
00306     if (GetCurrentProcess(&psn) == noErr) {
00307       if (AECreateDesc(typeProcessSerialNumber, &psn, sizeof(psn), &ae_target) == noErr) {
00308         if (AECreateAppleEvent('MrEd', 'Smug', &ae_target, kAutoGenerateReturnID, kAnyTransactionID, &ae) == noErr) {
00309           if (AESend(&ae, NULL, kAENoReply, kAENormalPriority, kNoTimeOut, NULL, NULL) == noErr) {
00310             pending_self_ae = 1;
00311           }
00312           AEDisposeDesc(&ae_target);
00313         }
00314         AEDisposeDesc(&ae);
00315       }
00316     }
00317   }
00318 }
00319 
00320 void wxSmuggleOutEvent(EventRef ref)
00321 {
00322   EventRecord e;
00323   int ok = 0;
00324 
00325   if ((GetEventClass(ref) == kEventClassMouse)
00326       && (GetEventKind(ref) == 11 /* kEventMouseScroll */)) {
00327     GetEventParameter(ref, kEventParamEventRef, typeEventRef,
00328                       NULL, sizeof(ref), NULL, &ref);
00329   }
00330 
00331   if ((GetEventClass(ref) == kEventClassMouse)
00332       && (GetEventKind(ref) == kEventMouseWheelMoved)) {
00333     UInt32 modifiers;
00334     EventMouseWheelAxis axis;
00335     SInt32 delta;
00336     Point pos;
00337        
00338     GetEventParameter(ref, kEventParamKeyModifiers, typeUInt32, 
00339                       NULL, sizeof(modifiers), NULL, &modifiers);
00340     GetEventParameter(ref, kEventParamMouseWheelAxis, 
00341                       typeMouseWheelAxis, NULL, sizeof(axis), NULL, &axis);
00342     GetEventParameter(ref, kEventParamMouseWheelDelta, 
00343                       typeLongInteger, NULL, sizeof(delta), NULL, &delta);
00344     GetEventParameter(ref, kEventParamMouseLocation,
00345                       typeQDPoint, NULL, sizeof(Point), NULL, &pos);
00346 
00347     if (axis == kEventMouseWheelAxisY) {
00348       e.what = wheelEvt;
00349       e.message = (delta > 0);
00350       e.modifiers = modifiers;
00351       e.where.h = pos.h;
00352       e.where.v = pos.v;
00353       ok = TRUE;
00354     }
00355   } else if ((GetEventClass(ref) == kEventClassTextInput)
00356              && (GetEventKind(ref) == kEventTextInputUnicodeForKeyEvent)) {
00357     UniChar *text;
00358     UInt32 actualSize; 
00359     EventRef kref;
00360     
00361     GetEventParameter(ref, kEventParamTextInputSendKeyboardEvent,
00362                       typeEventRef, NULL, sizeof(EventRef), NULL, &kref);
00363     if (ConvertEventRefToEventRecord(kref, &e)) {
00364       ok = TRUE;
00365     } else {
00366       e.modifiers = 0;
00367       e.message = 0;
00368       e.where.h = 0;
00369       e.where.v = 0;
00370     }
00371 
00372     if ((e.modifiers & (wxMacDisableMods | cmdKey))
00373         || wxTranslateRawKey((e.message & keyCodeMask) >> 8)) {
00374       /* keep the raw event */
00375     } else {
00376       GetEventParameter(ref, kEventParamTextInputSendText,
00377                         typeUnicodeText, NULL, 0, &actualSize, NULL);
00378       if (actualSize) {
00379         text = (UniChar*)scheme_malloc_atomic(actualSize);
00380         GetEventParameter(ref, kEventParamTextInputSendText,
00381                           typeUnicodeText, NULL, actualSize, NULL, text);
00382       
00383         e.what = unicodeEvt;
00384         e.message = text[0];
00385         ok = TRUE;
00386       }
00387     }
00388   } else {
00389     ok = ConvertEventRefToEventRecord(ref, &e);
00390   }
00391 
00392   if (ok) {
00393     QueueTransferredEvent(&e);
00394     EnsureWNEReturn();
00395   }
00396 }
00397 
00398 static OSStatus unhide_cursor_handler(EventHandlerCallRef inHandlerCallRef, 
00399                                       EventRef inEvent, 
00400                                       void *inUserData)
00401 {
00402   wxUnhideCursor();
00403   return eventNotHandledErr;
00404 }
00405 
00406 static OSStatus smuggle_handler(EventHandlerCallRef inHandlerCallRef, 
00407                                 EventRef inEvent, 
00408                                 void *inUserData)
00409 {
00410   if (wx_leave_all_input_alone)
00411     return eventNotHandledErr;
00412 
00413   wxSmuggleOutEvent(inEvent);
00414   return noErr;
00415 }
00416 
00417 static pascal OSErr HandleSmug(const AppleEvent *evt, AppleEvent *rae, long k)
00418 {
00419   pending_self_ae = 0;
00420   return 0;
00421 }
00422 
00423 /* WNE: a small wrapper for WaitNextEvent(), mostly to manage
00424    wake-up activities.
00425    It's tempting to try to use ReceiveNextEvent() to filter
00426    the raw events. Don't do that, because WaitNextEvent() is
00427    magic. In particular, WaitNextEvent() properly handles
00428    Cmd-~, Cmd-Q, dead keys like option-e on a U.S. keyboard,
00429    clicking that brings the application to the foreground,
00430    and the character palette. (We used ReceiveNextEvent()
00431    until version 352.7, and finally gave up when trying
00432    to get the character palette to work.) */
00433 int WNE(EventRecord *e, double sleep_secs)
00434 {
00435   int r;
00436   long ticks;
00437 
00438   if (mouse_down_in_flight) {
00439     /* Try hard to handle a mouse-down event before calling
00440        WaitNextEvent again. Otherwise, mouse events for tracking
00441        (e.g., menu clicks, close-window clicks, window-drag clicks,
00442        and button clicks) can get lost. We can't wait forever, though;
00443        the target eventspace might be stuck for some reason. If MrEd
00444        is idle enough to sleep, take that as a sign that it's ok to
00445        get new events. Another sign is if there's a new mouse-down or
00446        key-down event. Some other cases, such as a `yield' or waiting
00447        on an AppleEvent, are handled by explicitly turning off
00448        mouse_down_in_flight before we get here. */
00449     EventRef eref;
00450     EventTypeSpec poll_evts[2];
00451 
00452     if (!sleep_secs) {
00453       poll_evts[0].eventClass = kEventClassMouse;
00454       poll_evts[0].eventKind = kEventMouseDown;
00455       poll_evts[1].eventClass = kEventClassKeyboard;
00456       poll_evts[1].eventKind = kEventRawKeyDown;
00457       eref = AcquireFirstMatchingEventInQueue(GetCurrentEventQueue(),
00458                                               2,
00459                                               poll_evts,
00460                                               kEventQueueOptionsNone);
00461       if (eref) {
00462         ReleaseEvent(eref);
00463       } else {
00464         /* Looks like we should wait... */
00465         return 0;
00466       }
00467     }
00468   }
00469 
00470 
00471   wxResetCanvasBackgrounds();
00472   
00473   if (!wne_handlersInstalled) {
00474     EventTypeSpec evts[4];
00475     wne_handlersInstalled = TRUE;
00476 
00477     evts[0].eventClass = kEventClassMouse;
00478     evts[0].eventKind = kEventMouseDown;
00479     evts[1].eventClass = kEventClassMouse;
00480     evts[1].eventKind = kEventMouseMoved;
00481     evts[2].eventClass = kEventClassMouse;
00482     evts[2].eventKind = kEventMouseUp;
00483     evts[3].eventClass = kEventClassMouse;
00484     evts[3].eventKind = kEventMouseDragged;
00485 
00486     ::InstallEventHandler(GetEventDispatcherTarget(),
00487                        unhide_cursor_handler,
00488                        4,
00489                        evts,
00490                        NULL,
00491                        NULL);
00492 
00493     evts[0].eventClass = kEventClassMouse;
00494     evts[0].eventKind = 11 /* kEventMouseScroll */;
00495     evts[1].eventClass = kEventClassMouse;
00496     evts[1].eventKind = kEventMouseWheelMoved;
00497     evts[2].eventClass = kEventClassTextInput;
00498     evts[2].eventKind = kEventTextInputUnicodeForKeyEvent;
00499 
00500     ::InstallEventHandler(GetEventDispatcherTarget(),
00501                        smuggle_handler,
00502                        3,
00503                        evts,
00504                        NULL,
00505                        NULL);
00506 
00507     AEInstallEventHandler('MrEd', 'Smug', HandleSmug, 0, 0);
00508 
00509     mouseRgn = NewRgn();
00510     SetRectRgn(mouseRgn, 0, 0, 1, 1);
00511   }
00512 
00513   waiting_for_next_event = 1;
00514 
00515   if (sleep_secs < 0.0)
00516     ticks = 0x7FFFFFFF;
00517   else
00518     ticks = (long)(sleep_secs * 60);
00519 
00520   r = WaitNextEvent(everyEvent, e, ticks, mouseRgn);
00521 
00522   waiting_for_next_event = 0;
00523 
00524   return r;
00525 }
00526 
00527 void WakeUpMrEd()
00528 {
00529   /* Make sure we wake up a sleep, if this is a callback through
00530      a window painter. */
00531   if (waiting_for_next_event) {
00532     EnsureWNEReturn();
00533     waiting_for_next_event = 0;
00534   }
00535 }
00536 
00537 /* TransferQueue sucks all of the pending events out of the
00538    Application queue, sticks them in the MrEd queue, and returns 1,
00539    unless it was called less than delay_time ago, in which case do
00540    nothing and return 0. */
00541 
00542 static unsigned long lastTime;
00543 
00544 static int wne_delay_on;
00545 static unsigned long wne_delay_until;
00546  
00547 static int TransferQueue(int all)
00548 {
00549   EventRecord e;
00550   unsigned long tc;
00551   int sleep_time = 0;
00552   int delay_time = 0;
00553   
00554   /* Don't call WaitNextEvent() too often. */
00555   tc = TickCount();
00556   if (tc <= lastTime + delay_time)
00557     return 0;
00558   if (wne_delay_on && (tc < wne_delay_until))
00559     return 0;
00560   wne_delay_on = 0;
00561 
00562   while (WNE(&e, dispatched ? ((double)sleep_time/60.0) : 0)) {
00563     QueueTransferredEvent(&e);
00564   }
00565   
00566   lastTime = TickCount();
00567   
00568   return 1;
00569 }
00570 
00571 void wxStartRefreshSequence(void)
00572 {
00573   /* Editors are not buffered offscreen under Mac OS X, instead
00574      relying on the OS's buffering of all windows, which are updated
00575      on WNE boundaries. To avoid flicker, avoid calling WNE in the
00576      middle of an editor refresh.  The refresh might get stuck,
00577      though, so we only wait a little while. */
00578 
00579   if (!wne_delay_on) {
00580     wne_delay_until = TickCount() + 10;
00581   }
00582   wne_delay_on++;
00583 }
00584 
00585 void wxEndRefreshSequence(void)
00586 {
00587   if (wne_delay_on)
00588     --wne_delay_on;
00589 }
00590 
00591 static void MrDequeue(MrQueueElem *q)
00592 {
00593   if (q->prev)
00594     q->prev->next = q->next;
00595   else
00596     first = q->next;
00597   if (q->next)
00598     q->next->prev = q->prev;
00599   else
00600     last = q->prev;
00601 
00602   --queue_size;
00603 }
00604 
00605 static MrQueueRef Find(EventFinderClosure *closure)
00606 {
00607   MrQueueRef osq, next;
00608 
00609   osq = first;
00610   while (osq) {
00611     next = osq->next;
00612 
00613     if (closure->checker(&osq->event, osq, closure->check_only, 
00614                       closure->c, closure->keyOk, 
00615                       closure->event, closure->which)) {
00616       return osq;
00617     }
00618 
00619     osq = next;
00620   }
00621 
00622   return NULL;
00623 }
00624 
00625 /***************************************************************************/
00626 /*                               state finder                              */
00627 /***************************************************************************/
00628 
00629 static MrEdContext *KeyOk(int current_only)
00630 {
00631   WindowPtr w;
00632   wxFrame *fr;
00633   MrEdContext *c;
00634   
00635   c = current_only ? MrEdGetContext() : NULL;
00636   
00637   fr = wxGetFocusFrame();
00638   if (!fr) {
00639     w = ActiveNonFloatingWindow();
00640     fr = wxWindowPtrToFrame(w, c);
00641   }
00642   if (!fr || (c && (fr->context != (void *)c)) 
00643       || (!c && !((MrEdContext *)fr->context)->ready))
00644     return NULL;
00645   
00646   return (fr ? (MrEdContext *)fr->context : c);
00647 }
00648 
00649 static int WindowStillHere(WindowPtr win)
00650 {
00651   return IsValidWindowPtr(win);
00652 }
00653 
00654 static int GetMods(void)
00655 {
00656   KeyMap km;
00657   int mods = 0;
00658          
00659   GetKeys(km);
00660   if (wxNATIVE_LONG(km[1]) & 32768)
00661     mods |= cmdKey;
00662   if (wxNATIVE_LONG(km[1]) & 1)
00663     mods |= shiftKey;
00664   if (wxNATIVE_LONG(km[1]) & 4)
00665     mods |= optionKey;
00666   if (wxNATIVE_LONG(km[1]) & 8)
00667     mods |= controlKey;
00668   
00669   return mods;
00670 }
00671 
00672 /* the cont_mouse_context is used to keep information about mouse-downs around so
00673  * that later mouse-ups can be properly handled.
00674  */
00675  
00676 static MrEdContext *cont_mouse_context;
00677 static WindowPtr cont_mouse_context_window;
00678 static Point last_mouse;
00679 static WindowPtr last_front_window;
00680 
00681 void wxTracking()
00682 {
00683   /* This function is called whenever wxMac lets the toolbox process
00684      events, normally to track some button click. In that case, we
00685      assume that a mouse-up event won't come through the event
00686      queue. */
00687   cont_mouse_context = NULL;
00688   cont_mouse_context_window = NULL;
00689 }
00690 
00691 void wxMouseEventHandled(void)
00692 {
00693   mouse_down_in_flight = 0;
00694 }
00695 
00696 #ifdef RECORD_HISTORY
00697 FILE *history;
00698 #endif
00699 
00700 /***************************************************************************/
00701 /*                                event finders                            */
00702 /***************************************************************************/
00703 
00704 static int CheckForLeave(EventRecord *evt, MrQueueRef q, int check_only, 
00705                       MrEdContext *c, MrEdContext *keyOk, 
00706                       EventRecord *event, MrEdContext **which) {
00707   switch (evt->what) {
00708   case leaveEvt:
00709     {
00710       wxWindow *win;
00711       wxFrame *fr;
00712       MrEdContext *fc;
00713       void *refcon;
00714 
00715       refcon = (void *)evt->message;
00716       win = (wxWindow *)GET_SAFEREF(refcon);
00717 
00718       if ((win->__type != -1) && win->IsShown()) {
00719        fr = (wxFrame *)win->GetRootFrame();
00720        fc = fr ? (MrEdContext *)fr->context : NULL;
00721        if ((!c && !fr) || (!c && fc->ready) || (fc == c)) {
00722          if (which)
00723            *which = fc;
00724 
00725 #ifdef RECORD_HISTORY
00726          fprintf(history, "leave\n");
00727          fflush(history);
00728 #endif
00729 
00730          if (check_only)
00731            return TRUE;
00732        
00733          MrDequeue(q);
00734          memcpy(event, evt, sizeof(EventRecord));
00735          return TRUE;
00736        }
00737       } else {
00738        MrDequeue(q);
00739       }
00740     }
00741   }
00742 
00743   return FALSE;
00744 }
00745 
00746 static int saw_mdown = 0, mdown_was_ctl = 0, saw_kdown = 0;
00747 
00748 static int CheckForMouseOrKey(EventRecord *e, MrQueueRef osq, int check_only, 
00749                            MrEdContext *c, MrEdContext *keyOk, 
00750                            EventRecord *event, MrEdContext **foundc) {
00751   int found = 0;
00752   wxFrame *fr;
00753   MrEdContext *fc;
00754 
00755   switch (e->what) {
00756   case mouseMenuDown:
00757   case mouseDown:
00758     {
00759       WindowPtr window, front = NULL;
00760       int part;
00761 
00762       saw_mdown = 1;
00763       
00764       part = FindWindow(e->where, &window);
00765       if (part == inMenuBar) {
00766        front = ActiveNonFloatingWindow();
00767        window = front;
00768       }
00769 
00770       if (!window) {
00771        MrDequeue(osq);
00772        found = 1;
00773        *foundc = keyOk;
00774        cont_mouse_context = NULL;
00775       } else if (!WindowStillHere(window)) {
00776        MrDequeue(osq);
00777       } else {
00778        MrEdContext *clickOk;
00779 
00780        fr = wxWindowPtrToFrame(window, c);
00781        fc = fr ? (MrEdContext *)fr->context : NULL;
00782 
00783        if (!fr || (c && (fr->context != (void *)c)) 
00784            || (!c && !((MrEdContext *)fr->context)->ready))
00785          clickOk = NULL;
00786        else
00787          clickOk = fc;
00788 
00789        if (!front)
00790          front = ActiveNonFloatingWindow();
00791        if (window != front) {
00792          WindowClass wc;
00793 
00794          GetWindowClass(window, &wc);
00795          if ((wc != kFloatingWindowClass)
00796              && (wc != kUtilityWindowClass)
00797              && (wc != kToolbarWindowClass)) {
00798            /* Handle bring-window-to-front click immediately */
00799            if (!osq->half_done) {
00800              if (fc && (!fc->modal_window || (fr == fc->modal_window))) {
00801                 if ((part == inContent) || !(e->modifiers & cmdKey))
00802                   SelectWindow(window);
00803               cont_mouse_context = NULL;
00804              } else if (fc && fc->modal_window) {
00805               wxFrame *mfr;
00806               mfr = (wxFrame *)fc->modal_window;
00807               cont_mouse_context = NULL;
00808                 if ((part == inContent) || !(e->modifiers & cmdKey))
00809                   SelectWindow(mfr->macWindow());
00810              }
00811              osq->half_done = 1;
00812            }
00813          }
00814        }
00815 
00816        *foundc = clickOk;
00817        if (*foundc) {
00818          last_mouse.h = -1;
00819          found = 1;
00820          if (!check_only && (part != inMenuBar)) {
00821            cont_mouse_context = *foundc;
00822            cont_mouse_context_window = window;
00823            mdown_was_ctl = (e->modifiers & controlKey);
00824          } else
00825            cont_mouse_context = NULL;
00826        }
00827       }
00828     }
00829     break;
00830   case mouseUp:
00831     if (!cont_mouse_context) {
00832       if (!saw_mdown) {
00833        MrDequeue(osq);
00834       }
00835     } else if (keyOk == cont_mouse_context) {
00836       *foundc = keyOk;
00837       if (*foundc) {
00838        found = 1;
00839        if (!check_only)
00840          cont_mouse_context = NULL;
00841       }
00842     }
00843     break;
00844   case wheelEvt:
00845   case unicodeEvt:
00846   case keyDown:
00847   case autoKey:
00848   case keyUp:
00849     *foundc = keyOk;
00850     if (*foundc) {
00851       found = 1;
00852     }
00853     break;
00854   }
00855 
00856   if (found) {
00857     memcpy(event, e, sizeof(EventRecord));
00858 
00859     /* Preserve rightness (as opposed to leftness) of mouse clicks */
00860     if ((e->what == mouseUp) && mdown_was_ctl)
00861       event->modifiers |= controlKey;
00862   }
00863 
00864   return found;
00865 }
00866 
00867 static int CheckForActivate(EventRecord *evt, MrQueueRef q, int check_only, 
00868                          MrEdContext *c, MrEdContext *keyOk, 
00869                          EventRecord *event, MrEdContext **which)
00870 {
00871   WindowPtr window;
00872 
00873   switch (evt->what) {
00874   case kHighLevelEvent:
00875     {
00876       MrEdContext *fc;
00877       fc = NULL;
00878       if ((!c && !fc) || (!c && fc->ready) || (fc == c)) {
00879        if (which)
00880          *which = fc;
00881         if (check_only)
00882           return TRUE;
00883        memcpy(event, evt, sizeof(EventRecord));
00884         MrDequeue(q);
00885        return TRUE;
00886       }
00887     }
00888     break;
00889   case activateEvt:
00890     window = (WindowPtr)evt->message;
00891     if (WindowStillHere(window)) {
00892       wxFrame *fr;
00893       MrEdContext *fc;
00894 
00895       fr = wxWindowPtrToFrame(window, c);
00896       fc = fr ? (MrEdContext *)fr->context : NULL;
00897       if ((!c && !fr) || (!c && fc->ready) || (fc == c)) {
00898        if (which)
00899          *which = fc;
00900 
00901 #ifdef RECORD_HISTORY
00902        fprintf(history, "activate\n");
00903        fflush(history);
00904 #endif
00905 
00906        if (check_only)
00907          return TRUE;
00908        
00909        memcpy(event, evt, sizeof(EventRecord));
00910        MrDequeue(q);
00911        return TRUE;
00912       }
00913     } else
00914       MrDequeue(q);
00915     break;
00916   }
00917 
00918   return FALSE;
00919 }
00920 
00921 /***************************************************************************/
00922 /*                             get next event                              */
00923 /***************************************************************************/
00924 
00925 int MrEdGetNextEvent(int check_only, int current_only,
00926                    EventRecord *event, MrEdContext **which)
00927 {
00928   /* Search for an event. Handle clicks in non-frontmost windows
00929      immediately. */
00930   MrQueueRef osq;
00931   EventFinderClosure closure;
00932   EventRecord ebuf;
00933   MrEdContext *c, *keyOk, *foundc;
00934   int found = 0;
00935 
00936   saw_mdown = 0; saw_kdown = 0;
00937 
00938   if (!event)
00939     event = &ebuf;
00940   
00941   c = current_only ? MrEdGetContext() : NULL;
00942 
00943   wxResetCanvasBackgrounds();
00944     
00945   keyOk = KeyOk(current_only);
00946   
00947 #ifdef RECORD_HISTORY
00948   if (!history) history = fopen("history3", "w");
00949   fprintf(history, "%lx %lx %lx\n",
00950          c, keyOk, cont_event_context);
00951 #endif
00952 
00953 #if 0
00954   /* Update events are supposed to happen after mouse events, etc.
00955      However, OS X refreshes window displays when WNE is called.  In
00956      particular, it looks nicer to update the frontmost window before
00957      calling WNE. We must do this infrequenty, though, to avoid
00958      dispatching only update events when other sorts of events should
00959      get handled. */
00960   static RgnHandle quickUpdateRgn;
00961   static UInt32 quickUpdateTimeout;
00962   static UInt32 quickUpdateWait;
00963   if (!quickUpdateWait || (quickUpdateWait <= TickCount())) {
00964     WindowPtr front;
00965 
00966     quickUpdateWait = 0;
00967 
00968     front = FrontNonFloatingWindow();
00969     if (front) {
00970       if (!quickUpdateRgn)
00971        quickUpdateRgn = NewRgn();
00972          
00973       GetWindowRegion(front, kWindowUpdateRgn, quickUpdateRgn);       
00974       if (!EmptyRgn(quickUpdateRgn)) {
00975        /* Setup a trampoline and call WNE if the current thread
00976           if the handler thread for the front window? */
00977        quickUpdateWait = TickCount() + 15;
00978       }
00979     }
00980   }
00981 #endif
00982 
00983   TransferQueue(0);
00984     
00985   if (cont_mouse_context)
00986     if (!WindowStillHere(cont_mouse_context_window))
00987       cont_mouse_context = NULL;
00988     
00989   closure.c = c;
00990   closure.check_only = check_only;
00991   closure.keyOk = keyOk;
00992   closure.event = event;
00993   closure.which = which;
00994 
00995   /* First, service leave events: */
00996   closure.checker = CheckForLeave;
00997   if (Find(&closure))
00998     return TRUE; 
00999   
01000   /* Next, service mouse & key events: */
01001   closure.checker = CheckForMouseOrKey;
01002   closure.which = &foundc;
01003   if ((osq = Find(&closure))) {
01004     found = 1;
01005   }
01006   closure.which = which;
01007   
01008   if (found) {
01009     /* Remove intervening mouse/key events: */
01010     MrQueueElem *qq, *next;
01011     for (qq = first; qq && (qq != osq); qq = next) {
01012       next = qq->next;
01013       switch (qq->event.what) {
01014       case mouseUp:
01015        cont_mouse_context = NULL;
01016        /* fallthrough... */
01017       case mouseMenuDown:
01018       case mouseDown:
01019       case wheelEvt:
01020       case unicodeEvt:
01021       case keyDown:
01022       case keyUp:
01023       case autoKey:
01024        MrDequeue(qq);
01025        break;
01026       }
01027     }
01028 
01029     if (which)
01030       *which = foundc;
01031 
01032 #ifdef RECORD_HISTORY
01033     fprintf(history, "mouse or key\n");
01034     fflush(history);
01035 #endif
01036 
01037     if (check_only)
01038       return TRUE;
01039     
01040     MrDequeue(osq);
01041     
01042     return TRUE;
01043   }
01044   
01045   // TransferQueue(0);
01046     
01047   /* Try activate and high-level events: */
01048   closure.checker = CheckForActivate;
01049   if (Find(&closure))
01050     return TRUE; 
01051   
01052   /* Generate a motion event? */
01053   if (keyOk) {
01054     WindowPtr front;
01055 
01056     GetMouse(&event->where);
01057     LocalToGlobal(&event->where);
01058     front = MrEdMouseWindow(event->where);
01059 
01060     if (((event->where.v != last_mouse.v)
01061         || (event->where.h != last_mouse.h)
01062         || last_front_window != front)
01063        && (!cont_mouse_context || (cont_mouse_context == keyOk))) {
01064       long ticks;
01065 
01066       if (which)
01067        *which = (cont_mouse_context ? cont_mouse_context : keyOk);
01068        
01069       if (check_only) {
01070 #ifdef RECORD_HISTORY
01071        fprintf(history, "move or drag\n");
01072        fflush(history);
01073 #endif
01074        return TRUE;
01075       }
01076 
01077       last_mouse.v = event->where.v;
01078       last_mouse.h = event->where.h;
01079       last_front_window = front;
01080 
01081       event->what = nullEvent;
01082       ticks = TickCount();
01083       event->when = ticks;
01084       if (cont_mouse_context) {
01085        /* Dragging... */
01086        int mods;
01087        mods = GetMods();
01088        if (mdown_was_ctl)
01089          mods |= controlKey;
01090        event->modifiers = mods | btnState;
01091        event->message = 1;
01092 #ifdef RECORD_HISTORY
01093        fprintf(history, "drag\n");
01094        fflush(history);
01095 #endif
01096       } else {
01097        if (keyOk) {
01098          int mods;
01099          mods = GetMods();
01100          event->modifiers = mods;
01101        } else {
01102          event->modifiers = 0;
01103        }
01104        event->message = (keyOk ? 1 : 0);
01105 #ifdef RECORD_HISTORY
01106        fprintf(history, "move\n");
01107        fflush(history);
01108 #endif
01109       }
01110       return TRUE;
01111     }
01112   }
01113   
01114 #ifdef RECORD_HISTORY
01115   fprintf(history, "no event\n");
01116   fflush(history);
01117 #endif
01118   
01119   return FALSE;
01120 }
01121 
01122 extern void wxCheckFinishedSounds(void);
01123 
01124 
01125 void MrEdDispatchEvent(EventRecord *e)
01126 {
01127   dispatched = 1;
01128 
01129   if (e->what == updateEvt) {
01130     /* Find the update event for this window: */
01131     RgnHandle rgn = NULL;
01132     MrQueueElem *q;
01133     WindowPtr w;
01134 
01135     w = (WindowPtr)e->message;
01136 
01137     for (q = first; q; q = q->next) {
01138       if ((q->event.what == updateEvt)
01139          && (w == ((WindowPtr)q->event.message))) {
01140        rgn = q->rgn;
01141        MrDequeue(q);
01142        break;
01143       }
01144     }
01145     
01146     if (rgn) {
01147       /* rgn is in window co-ords */
01148       InvalWindowRgn(w, rgn);
01149       DisposeRgn(rgn);
01150     }
01151   }
01152 
01153   wxTheApp->doMacPreEvent();
01154   wxTheApp->doMacDispatch(e);
01155   wxTheApp->doMacPostEvent();
01156   
01157   wxCheckFinishedSounds();
01158 }
01159 
01160 int MrEdCheckForBreak(void)
01161 {
01162   MrQueueElem *q;
01163   
01164   if (!KeyOk(TRUE))
01165     return 0;
01166   
01167   TransferQueue(0);
01168 
01169   for (q = first; q; q = q->next) {
01170     if (q->event.what == keyDown) {
01171       if ((((q->event.message & charCodeMask) == '.') 
01172           && (q->event.modifiers & cmdKey))
01173          || (((q->event.message & charCodeMask) == 3) 
01174              && (q->event.modifiers & controlKey))) {
01175         MrDequeue(q);
01176         return TRUE;
01177       }
01178     }
01179   }
01180   
01181   return FALSE;
01182 }
01183 
01184 /***************************************************************************/
01185 /*                                 sleep                                   */
01186 /***************************************************************************/
01187 
01188 #include <pthread.h>
01189 
01190 /* These file descriptors are used for breaking the event loop. */
01191 static int cb_socket_ready;
01192 static int ready_sock, write_ready_sock;
01193 
01194 static int StartFDWatcher(void (*mzs)(float secs, void *fds), float secs, void *fds)
01195 {
01196   scheme_start_sleeper_thread(mzs, secs, fds, write_ready_sock);
01197   return 1;
01198 }
01199 
01200 static void EndFDWatcher(void)
01201 {
01202   scheme_end_sleeper_thread();
01203 }
01204 
01205 void socket_callback(CFSocketRef s, CFSocketCallBackType type, CFDataRef address, const void *data, void *info)
01206 {
01207   EnsureWNEReturn();
01208 }
01209 
01210 static const void *sock_retain(const void *info)
01211 {
01212   return NULL;
01213 }
01214 
01215 static void sock_release(const void *info)
01216 {
01217   /* do nothing */
01218 }
01219 
01220 static CFStringRef sock_copy_desc(const void *info)
01221 {
01222   return CFSTR("sock");
01223 }
01224 
01225 static int going, reported_recursive_sleep;
01226 
01227 void MrEdMacSleep(float secs, void *fds, SLEEP_PROC_PTR mzsleep)
01228 {
01229   if (going) {
01230     if (!reported_recursive_sleep) {
01231       fprintf(stderr, "BUG: recursive sleep! Please submit a bug report that explains how\n");
01232       fprintf(stderr, "you got this message. (It won't appear again until you restart.)\n");
01233       reported_recursive_sleep = 1;
01234     }
01235     return;
01236   }
01237 
01238   /* If we're asked to sleep less than 1/60 of a second, then don't
01239      bother with WaitNextEvent(). */
01240   if ((secs > 0) && (secs < 1.0/60)) {
01241     mzsleep(secs, fds);
01242   } else {
01243     EventRecord e;
01244 
01245     if (!cb_socket_ready) {
01246       /* We set up a pipe for the purpose of breaking the Carbon
01247         event manager out of its loop. When the watcher thread sees
01248         that an fd is ready, it writes to write_sock_ready, which
01249         means that sock_ready is ready to read, which means that
01250         socket_callback is invoked, and it calls EnsureWNEReturn().
01251 
01252          With the current implementation of EnsureWNEReturn(), this is
01253          probably overkill. I think the watcher thread could call
01254          EnsureWNEReturn() directly. Doing it this way moves the call
01255          into this thread, though, which seems more robust in the long
01256          run (i.e., if EnsureWNEReturn() changes). */
01257       int fds[2];
01258       if (!pipe(fds)) {
01259        CFRunLoopRef rl;
01260        CFSocketRef cfs;
01261        CFRunLoopSourceRef source;
01262        CFSocketContext context;
01263 
01264        /* True, they're not really sockets... */
01265        ready_sock = fds[0];
01266        write_ready_sock = fds[1];
01267 
01268        /* The code below simply says says "please call
01269           socket_callback from WNE when there's data to read on
01270           ready_sock" */
01271 
01272        context.version = 0; /* ? */
01273        context.info = NULL;
01274        context.retain = sock_retain;
01275        context.release = sock_release;
01276        context.copyDescription = sock_copy_desc;
01277 
01278        rl = (CFRunLoopRef)GetCFRunLoopFromEventLoop(GetMainEventLoop());
01279        cfs = CFSocketCreateWithNative(CFAllocatorGetDefault(), ready_sock, kCFSocketReadCallBack, socket_callback, &context);
01280        source = CFSocketCreateRunLoopSource(CFAllocatorGetDefault(), cfs, 0);
01281        CFRunLoopAddSource(rl, source, kCFRunLoopDefaultMode);
01282        
01283        fcntl(ready_sock, F_SETFL, O_NONBLOCK);
01284        cb_socket_ready = 1;
01285       }
01286     }
01287 
01288     /* Starts a watcher thread, which runs select() on the fds,
01289        and also breaks when SIGINT is received. */
01290     if (!StartFDWatcher(mzsleep, secs, fds)) {
01291       secs = 0;
01292     }
01293 
01294     going++;
01295 
01296     if (WNE(&e, secs ? secs : kEventDurationForever))
01297       QueueTransferredEvent(&e);
01298 
01299     --going;
01300 
01301     /* Shut down the watcher thread */
01302     EndFDWatcher();
01303     if (cb_socket_ready) {
01304       /* clear out the pipe: */
01305       char buf[1];
01306       read(ready_sock, buf, 1);
01307     }
01308   }
01309 }
01310 
01311 /***************************************************************************/
01312 /*               location->window (used for send-message)                  */
01313 /***************************************************************************/
01314 
01315 wxWindow *wxLocationToWindow(int x, int y)
01316 {
01317   Point p;
01318   WindowPtr f;
01319   Rect bounds;
01320   int part;
01321 
01322   p.h = x;
01323   p.v = y;
01324   part = FindWindow(p, &f);
01325   
01326   GetWindowBounds(f, kWindowContentRgn, &bounds);
01327   if (IsWindowVisible(f)
01328       && (bounds.left <= x)
01329       && (bounds.right >= x)
01330       && (bounds.top <= y)
01331       && (bounds.bottom >= y)) {
01332     /* Found it */
01333     wxFrame *frame;
01334     void *refcon;
01335 
01336     refcon = (void *)GetWRefCon(f);
01337     frame = (wxFrame *)GET_SAFEREF(refcon);
01338 
01339     if (frame) {
01340       /* Mac: some frames really represent dialogs. Any modal frame is
01341         a dialog, so extract its only child. */
01342       if (frame->IsModal()) {
01343        wxChildNode *node2;
01344        wxChildList *cl;
01345        cl = frame->GetChildren();
01346        node2 = cl->First();
01347        if (node2)
01348          return (wxWindow *)node2->Data();
01349       } else
01350        return frame;
01351     } else
01352       return NULL;
01353   }
01354   
01355   return NULL;
01356 }
01357 
01358 WindowPtr MrEdMouseWindow(Point where)
01359 {
01360   WindowPtr win;
01361   WindowClass wc;
01362   int part;
01363 
01364   part = FindWindow(where, &win);
01365   if (part == inMenuBar)
01366     return FrontNonFloatingWindow();
01367 
01368   GetWindowClass(win, &wc);
01369   if ((wc == kFloatingWindowClass)
01370       || (wc == kUtilityWindowClass)
01371       || (wc == kToolbarWindowClass)) {
01372     /* Floating windows always receive events: */
01373     return win;
01374   } else {
01375     return FrontNonFloatingWindow();
01376   }
01377 }
01378 
01379 WindowPtr MrEdKeyWindow()
01380 {
01381   wxFrame *f;
01382   f = wxGetFocusFrame();
01383   if (f)
01384     return f->macWindow();
01385   else
01386     return FrontWindow();
01387 }
01388 
01389 /***************************************************************************/
01390 /*                                gc                                       */
01391 /***************************************************************************/
01392 
01393 void wxmac_reg_globs(void)
01394 {
01395   wxREGGLOB(first);
01396   wxREGGLOB(last);
01397   wxREGGLOB(cont_mouse_context);
01398 }
01399 
01400 /***************************************************************************/
01401 /*                            AppleEvents                                  */
01402 /***************************************************************************/
01403 
01404 static Scheme_Object *record_symbol, *file_symbol;
01405 
01406 static long check_four(char *name, int which, int argc, Scheme_Object **argv)
01407 {
01408   Scheme_Object *o = argv[which];
01409 
01410   if (!SCHEME_BYTE_STRINGP(o) || (SCHEME_BYTE_STRTAG_VAL(o) != 4))
01411     scheme_wrong_type(name, "MacOS type/creator 4-character byte string", which, argc, argv);
01412   
01413 #ifdef __POWERPC__
01414   return *(int *)SCHEME_BYTE_STR_VAL(o);
01415 #else
01416   {
01417     int v;
01418     char tmp[4], *bs;
01419     bs = SCHEME_BYTE_STR_VAL(o);
01420     tmp[3] = bs[0];
01421     tmp[2] = bs[1];
01422     tmp[1] = bs[2];
01423     tmp[0] = bs[3];
01424     memcpy(&v, tmp, 4);
01425     return v;
01426   }
01427 #endif
01428 }
01429 
01430 static int has_null(const char *s, long l)
01431 {
01432   if (!l)
01433     return 1;
01434 
01435   while (l--) {
01436     if (!s[l])
01437       return 1;
01438   }
01439 
01440   return 0;
01441 }
01442 
01443 int scheme_mac_path_to_spec(const char *filename, FSSpec *spec)
01444 {
01445   FSRef fsref;
01446   OSErr err;
01447        
01448   // first, convert to an FSRef
01449        
01450   err = FSPathMakeRef((const UInt8 *)filename,&fsref,NULL);
01451        
01452   if (err != noErr) {
01453     return 0;
01454   }
01455 
01456   memset(spec, 0, sizeof(FSSpec));
01457        
01458   // then, convert to an FSSpec
01459   err = FSGetCatalogInfo(&fsref, kFSCatInfoNone, NULL, NULL, spec, NULL);
01460        
01461   if (err != noErr) {
01462     return 0;
01463   }
01464        
01465   return 1;
01466 }      
01467 
01468 char *scheme_mac_spec_to_path(FSSpec *spec)
01469 {
01470   FSRef fileRef;
01471   int longEnough = FALSE;
01472   int strLen = 256;
01473   char *str;
01474     
01475   str = (char *)scheme_malloc_atomic(strLen);
01476     
01477   // first, convert to an FSRef
01478   if (FSpMakeFSRef(spec,&fileRef) != noErr) {
01479     return NULL;
01480   }
01481     
01482   while (! longEnough) {
01483     if (FSRefMakePath(&fileRef,(unsigned char *)str,strLen) == pathTooLongErr) {
01484       strLen *= 2;
01485       str = (char *)scheme_malloc_atomic(strLen);
01486     } else {
01487       longEnough = TRUE;
01488     }
01489   }
01490     
01491   return str;
01492 }
01493 
01494 static int ae_marshall(AEDescList *ae, AEDescList *list_in, AEKeyword kw, Scheme_Object *v, 
01495                      char *name, OSErr *err, char **stage)
01496 {
01497   DescType type;
01498   Ptr data;
01499   Size size;
01500   Boolean x_b;
01501   long x_i;
01502   double x_d;
01503   FSSpec x_fss;
01504   Handle alias = NULL;
01505   int retval = 1;
01506   OSErr _err;
01507     
01508   switch (SCHEME_TYPE(v)) {
01509   case scheme_true_type:
01510   case scheme_false_type:
01511     x_b = SCHEME_TRUEP(v) ? TRUE : FALSE;
01512     type = typeBoolean;
01513     data = (char *)&x_b;
01514     size = sizeof(Boolean);
01515     break;
01516   case scheme_integer_type:
01517     x_i = SCHEME_INT_VAL(v);
01518     type = typeLongInteger;
01519     data = (char *)&x_i;
01520     size = sizeof(long);
01521     break;
01522   case scheme_byte_string_type:
01523     type = typeChar;
01524     data = SCHEME_BYTE_STR_VAL(v);
01525     size = SCHEME_BYTE_STRTAG_VAL(v);
01526     break;
01527   case scheme_char_string_type:
01528     type = typeChar;
01529     v = scheme_char_string_to_byte_string(v);
01530     data = SCHEME_BYTE_STR_VAL(v);
01531     size = SCHEME_BYTE_STRTAG_VAL(v);
01532     break;
01533   case scheme_float_type:
01534   case scheme_double_type:
01535     x_d = SCHEME_FLOAT_VAL(v);
01536     type = typeFloat;
01537     data = (char *)&x_d;
01538     size = sizeof(double);
01539     break;
01540   case scheme_vector_type: /* vector => record */
01541     if ((SCHEME_VEC_SIZE(v) >= 1)
01542        && ((SCHEME_VEC_ELS(v)[0] == record_symbol)
01543            || (SCHEME_VEC_ELS(v)[0] == file_symbol))) {
01544       if (SCHEME_VEC_ELS(v)[0] == file_symbol) {
01545        if ((SCHEME_VEC_SIZE(v) == 2)
01546            && SCHEME_PATH_STRINGP(SCHEME_VEC_ELS(v)[1]))  {
01547          Scheme_Object *bs;
01548          char *s;
01549          long l;
01550          bs = SCHEME_VEC_ELS(v)[1];
01551          if (!SCHEME_PATHP(bs))
01552            bs = scheme_char_string_to_byte_string(bs);
01553          s = SCHEME_BYTE_STR_VAL(bs);
01554          l = SCHEME_BYTE_STRTAG_VAL(bs);
01555          if (!has_null(s, l)) {
01556            if (scheme_mac_path_to_spec(s, &x_fss)) {
01557              _err = NewAliasMinimal(&x_fss, (AliasHandle *)&alias);
01558              *err = _err;
01559              if (_err == -43) {
01560                /* Can't make alias; make FSSpec, instead */
01561                type = typeFSS;
01562                data = (char *)&x_fss;
01563                size = sizeof(FSSpec);
01564                break;
01565              } else if (_err) {
01566               *stage = "converting file to alias: ";
01567               return 0;
01568              }
01569              type = typeAlias;
01570              HLock(alias);
01571              data = (char *)*alias;
01572              size = GetHandleSize(alias);
01573              break;
01574            }
01575          }
01576        }
01577        scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED,
01578                       "%s: cannot interpret vector as a file specification: %V",
01579                       name,
01580                       v);
01581       }
01582       /* record case falls through to list */
01583     } else {
01584       scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED,
01585                      "%s: cannot convert ill-tagged or untagged vector: %V",
01586                      name,
01587                      v);
01588     }
01589   case scheme_pair_type: /* /\ falls through */
01590   case scheme_null_type:
01591     {
01592       int l;
01593       int isrec = SCHEME_VECTORP(v);
01594         
01595       if (isrec)
01596        v = SCHEME_CDR(scheme_vector_to_list(v));
01597         
01598       l = scheme_proper_list_length(v);
01599       if (l >= 0) {
01600        AEDescList *list;
01601        list = (AEDescList *)scheme_malloc_atomic(sizeof(AEDescList));
01602           
01603         list->descriptorType = typeNull;
01604         list->dataHandle = NULL;
01605        _err = AECreateList(NULL, 0, isrec, list);
01606        if (_err) {
01607          *err = _err;
01608          *stage = "cannot create list/record: ";
01609          return 0;
01610        }
01611                 
01612        while (!SCHEME_NULLP(v)) {
01613          Scheme_Object *a = SCHEME_CAR(v);
01614          AEKeyword rkw;
01615          if (isrec) {
01616            Scheme_Object *k;
01617            if (!SCHEME_PAIRP(a)
01618               || !SCHEME_PAIRP(SCHEME_CDR(a))
01619               || !SCHEME_NULLP(SCHEME_CDR(SCHEME_CDR(a)))
01620               || !SCHEME_BYTE_STRINGP(SCHEME_CAR(a))) {
01621              /* Bad record form. */
01622              scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED,
01623                             "%s: cannot interpret vector part as a record field: %s",
01624                             name,
01625                             scheme_make_provided_string(a, 1, NULL));
01626            }
01627            k = SCHEME_CAR(a);
01628            a = SCHEME_CADR(a);
01629            rkw = check_four(name, 0, 1, &k);
01630          } else
01631            rkw = 0;
01632          if (!ae_marshall(NULL, list, rkw, a, name, err, stage)) {
01633            AEDisposeDesc(list);
01634            return 0;
01635          }
01636          v = SCHEME_CDR(v);
01637        }
01638                 
01639        if (list_in) {
01640          if (kw)
01641            _err = AEPutKeyDesc(list_in, kw, list);
01642          else
01643            _err = AEPutDesc(list_in, 0, list);
01644          if (_err) {
01645            *err = _err;
01646            *stage = "cannot add list item: ";
01647            AEDisposeDesc(list);
01648            return 0;
01649          }
01650        } else {
01651          if (kw)
01652            _err = AEPutParamDesc(ae, kw, list);
01653          else
01654            _err = AEPutParamDesc(ae, keyDirectObject, list);
01655          if (_err) {
01656            *err = _err;
01657            *stage = "cannot install argument: ";
01658            AEDisposeDesc(list);
01659            return 0;
01660          }
01661        }
01662               
01663        AEDisposeDesc(list);
01664                 
01665        return 1;
01666       }
01667     }
01668   default:
01669     /* Don't know how to marshall */
01670     scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED,
01671                    "%s: cannot convert value for sending: %s",
01672                    name,
01673                    scheme_make_provided_string(v, 1, NULL));
01674     return 0;
01675   }
01676     
01677   if (list_in) {
01678     if (kw)
01679       _err = AEPutKeyPtr(list_in, kw, type, data, size);
01680     else
01681       _err = AEPutPtr(list_in, 0, type, data, size);
01682     if (_err) {
01683       *err = _err;
01684       *stage = "cannot add list item: ";
01685       retval = 0;
01686     }
01687   } else {
01688     if (kw)
01689       _err = AEPutParamPtr(ae, kw, type, data, size);
01690     else
01691       _err = AEPutParamPtr(ae, keyDirectObject, type, data, size);
01692     if (_err) {
01693       *err = _err;
01694       *stage = "cannot install argument: ";
01695       retval = 0;
01696     }
01697   }
01698 
01699   if (alias)
01700     DisposeHandle(alias);
01701        
01702   return retval;
01703 }
01704 
01705 static Scheme_Object *ae_unmarshall(AppleEvent *reply, AEDescList *list_in, int pos,
01706                                     OSErr *err, char **stage, Scheme_Object **record)
01707 {
01708 
01709   DescType rtype;
01710   long sz;
01711   AEKeyword kw;
01712   Scheme_Object *result = NULL;
01713   OSErr _err;
01714 
01715   if (list_in) {
01716     if (AEGetNthPtr(list_in, pos, typeWildCard, &kw, &rtype, NULL, 0, &sz))
01717       return scheme_void;
01718   } else {
01719     if (AEGetParamPtr(reply, keyDirectObject, typeWildCard, &rtype, NULL, 0, &sz))
01720       return scheme_void;
01721   }
01722   
01723   {
01724     Boolean x_b;
01725     long x_i;
01726     double x_d;
01727     char *x_s = NULL;
01728     FSSpec x_f;
01729     Ptr data;
01730     
01731     switch (rtype) {
01732     case typeBoolean:
01733       data = (char *)&x_b;
01734       break;
01735     case typeLongInteger:
01736     case typeShortInteger:
01737       rtype = typeLongInteger;
01738       data = (char *)&x_i;
01739       sz = sizeof(long);
01740       break;
01741     case typeLongFloat:
01742     case typeShortFloat:
01743     case typeExtended:
01744       rtype = typeFloat;
01745       data = (char *)&x_d;
01746       sz = sizeof(double);
01747       break;
01748     case typeChar:
01749       x_s = (char *)scheme_malloc_atomic(sz + 1);
01750       data = x_s;
01751       x_s[0] = 0;
01752       break;
01753     case typeAlias:
01754     case typeFSS:
01755       rtype = typeFSS;
01756       data = (char *)&x_f;
01757       sz = sizeof(FSSpec);
01758       break;
01759     case typeAEList:
01760     case typeAERecord:
01761       {
01762        AEDescList *list;
01763        Scheme_Object *first = scheme_null, *last = NULL, *v, *rec, **recp;
01764        int i;
01765          
01766        list = (AEDescList *)scheme_malloc_atomic(sizeof(AEDescList));
01767           
01768        if (list_in) {
01769          if (AEGetNthDesc(list_in, pos, rtype, &kw, list))
01770            return NULL;
01771          if (record) {
01772            rec = scheme_make_sized_utf8_string((char *)&kw, sizeof(long));
01773            *record = rec;
01774          }
01775        } else {
01776          if (AEGetParamDesc(reply, keyDirectObject, rtype, list))
01777            return NULL;
01778        }
01779          
01780        if (rtype == typeAERecord)
01781          recp = &rec;
01782        else
01783          recp = NULL;
01784          
01785        for (i = 1; (v = ae_unmarshall(NULL, list, i, err, stage, recp)); i++) {
01786          if (v == scheme_void)
01787            break;
01788          else if (!v) {
01789            AEDisposeDesc(list);
01790            return NULL;
01791          } else {
01792            Scheme_Object *pr;
01793 
01794            pr = scheme_make_pair(v, scheme_null);
01795            if (recp) {
01796              pr = scheme_make_pair(rec, pr);
01797              pr = scheme_make_pair(pr, scheme_null);
01798            }
01799                   
01800            if (last)
01801              SCHEME_CDR(last) = pr;
01802            else
01803              first = pr;
01804            last = pr;
01805          }
01806        }
01807          
01808        if (recp)
01809          first = scheme_list_to_vector(scheme_make_pair(record_symbol, first));
01810          
01811        AEDisposeDesc(list);
01812        return first;
01813       }
01814     default:
01815       /* Don't know how to un-marshall */
01816       *err = -1;
01817       *stage = "error translating the reply to a Scheme value: ";
01818       return NULL;
01819     }
01820     
01821     if (list_in) {
01822       _err = AEGetNthPtr(list_in, pos, rtype, &kw, &rtype, data, sz, &sz);
01823       if (record) {
01824        Scheme_Object *rec;
01825        rec = scheme_make_sized_utf8_string((char *)&kw, sizeof(long));
01826        *record = rec;
01827       }
01828       if (_err) {
01829        *err = _err;
01830         *stage = "lost a list value: ";
01831         return NULL;
01832       }
01833     } else {
01834       _err = AEGetParamPtr(reply, keyDirectObject, rtype, &rtype, data, sz, &sz);
01835       if (_err) {
01836        *err = _err;
01837         *stage = "lost the return value: ";
01838         return NULL;
01839       }
01840     }
01841     
01842     switch (rtype) {
01843     case typeBoolean:
01844       result = (x_b ? scheme_true : scheme_false);
01845       break;
01846     case typeLongInteger:
01847       result = scheme_make_integer(x_i);
01848       break;
01849     case typeFloat:
01850       result = scheme_make_double(x_d);
01851       break;
01852     case typeChar:
01853       result = scheme_make_sized_utf8_string(x_s, sz);
01854       break;
01855     case typeFSS:
01856       result = scheme_make_sized_utf8_string(scheme_mac_spec_to_path(&x_f), -1);
01857       break;      
01858     }
01859   }
01860   
01861   return result;
01862 }
01863 
01864 /* Single-threaded ok: */
01865 static int escaped = 0;
01866 
01867 static int handlerInstalled = 0;
01868 class ReplyItem;
01869 class ReplyItem {
01870 public:
01871   long id;
01872   AppleEvent *ae;
01873   ReplyItem *next;
01874 };
01875 static ReplyItem *reply_queue;
01876 
01877 static pascal Boolean while_waiting(EventRecord *e, long *sleeptime, RgnHandle *rgn)
01878 {
01879   mz_jmp_buf *save, newbuf;
01880   
01881   if (escaped) return TRUE;
01882   
01883   QueueTransferredEvent(e);
01884   
01885   save = scheme_current_thread->error_buf;
01886   scheme_current_thread->error_buf = &newbuf;
01887   
01888   if (scheme_setjmp(newbuf)) {
01889     scheme_current_thread->error_buf = save;
01890     escaped = 1;
01891     return TRUE; /* Immediately return to AESend */
01892   } else {
01893     scheme_thread_block(0);
01894     scheme_current_thread->ran_some = 1;
01895     scheme_current_thread->error_buf = save;
01896   }
01897   
01898   return FALSE;
01899 }
01900 
01901 static pascal OSErr HandleAnswer(const AppleEvent *evt, AppleEvent *rae, long k)
01902 {
01903   ReplyItem *r;
01904   DescType rtype;
01905   long sz;
01906   AppleEvent *ae;
01907   
01908   r = new WXGC_PTRS ReplyItem;
01909   ae = (AppleEvent *)scheme_malloc_atomic(sizeof(AppleEvent));
01910   r->ae = ae;
01911   
01912   AEGetAttributePtr(evt, keyReturnIDAttr, typeLongInteger, &rtype, &r->id, sizeof(long), &sz);
01913   
01914   AEDuplicateDesc(evt, r->ae);
01915 
01916   r->next = reply_queue;
01917   reply_queue = r;
01918   
01919   return 0;
01920 }
01921 
01922 static void wait_for_reply(AppleEvent *ae, AppleEvent *reply)
01923 {
01924   EventRecord e;
01925   DescType rtype;
01926   long id, sz;
01927   ReplyItem *r, *prev;
01928   
01929   if (!handlerInstalled) {
01930     handlerInstalled = TRUE;
01931     AEInstallEventHandler(kCoreEventClass, kAEAnswer, NewAEEventHandlerUPP(HandleAnswer), 0, 0);
01932     wxREGGLOB(reply_queue);
01933   }
01934   
01935   AEGetAttributePtr(ae, keyReturnIDAttr, typeLongInteger, &rtype, &id, sizeof(long), &sz);
01936   
01937   while (1) {
01938     wxMouseEventHandled();
01939     WNE(&e, 1.0);
01940     if (e.what == kHighLevelEvent)
01941       AEProcessAppleEvent(&e);
01942     else {
01943       if (while_waiting(&e, NULL, NULL))
01944        break;
01945     }
01946        
01947     prev = NULL;
01948     for (r = reply_queue; r; r = r->next) {
01949       if (r->id == id) {
01950        /* Got the reply */
01951        memcpy(reply, r->ae, sizeof(AppleEvent));
01952        if (prev)
01953          prev->next = r->next;
01954        else
01955          reply_queue = r->next;
01956        return;
01957       }
01958       prev = r;
01959     }
01960   }
01961 }
01962 
01963 int scheme_mac_send_event(char *name, int argc, Scheme_Object **argv, 
01964                        Scheme_Object **result, int *err, char **stage)
01965 {
01966   OSErr oerr;
01967   AEEventClass classid;
01968   AEEventID eventid;
01969   AppleEvent *ae = NULL, *reply = NULL;
01970   AEAddressDesc *target = NULL;
01971   DescType rtype;
01972   int retval;
01973   long ret, sz, dst;
01974   Scheme_Object *res;
01975 
01976   if (!record_symbol) {
01977     wxREGGLOB(record_symbol);
01978     wxREGGLOB(file_symbol);
01979 
01980     record_symbol = scheme_intern_symbol("record");
01981     file_symbol = scheme_intern_symbol("file");
01982   }
01983 
01984   dst = check_four(name, 0, argc, argv);
01985   classid = check_four(name, 1, argc, argv);
01986   eventid = check_four(name, 2, argc, argv);
01987 
01988   target = (AEAddressDesc *)malloc(sizeof(AEAddressDesc));
01989   oerr = AECreateDesc(typeApplSignature, &dst, sizeof(long), target);
01990   if (oerr) {
01991     free(target);
01992     target = NULL;
01993     *err = (int)oerr;
01994     *stage = "application not found: ";
01995     goto fail;
01996   }
01997     
01998   ae = (AppleEvent *)malloc(sizeof(AppleEvent));
01999   oerr = AECreateAppleEvent(classid, eventid, target, kAutoGenerateReturnID, 
02000                             kAnyTransactionID, ae);
02001   if (oerr) {
02002     free(ae);
02003     ae = NULL;
02004     *err = (int)oerr;
02005     *stage = "cannot create event: ";
02006     ae = NULL;    
02007     goto fail;
02008   }
02009   
02010   if ((argc > 3) && !SCHEME_VOIDP(argv[3])) {
02011     if (!ae_marshall(ae, NULL, 0, argv[3], name, &oerr, stage)) {
02012       *err = (int)oerr;
02013       goto fail;
02014     }
02015   }
02016   
02017   if (argc > 4) {
02018     Scheme_Object *l = argv[4];
02019     char *expected = "list of pairs containing a type-string and a value";
02020     while (SCHEME_PAIRP(l)) {
02021       Scheme_Object *a = SCHEME_CAR(l), *k, *v;
02022       AEKeyword kw;
02023       /* Must be a list of 2-item lists: keyword and value */
02024       if (!SCHEME_PAIRP(a) 
02025           || !SCHEME_PAIRP(SCHEME_CDR(a))
02026           || !SCHEME_NULLP(SCHEME_CDR(SCHEME_CDR(a)))
02027           || !SCHEME_BYTE_STRINGP(SCHEME_CAR(a)))
02028         break; /* => type error */
02029       k = SCHEME_CAR(a);
02030       v = SCHEME_CADR(a);
02031       kw = check_four(name, 0, 1, &k);
02032       if (!ae_marshall(ae, NULL, kw, v, name, &oerr, stage)) {
02033        *err = (int)oerr;
02034         goto fail;
02035       }
02036       l = SCHEME_CDR(l);
02037     }
02038     if (!SCHEME_NULLP(l))
02039       scheme_wrong_type(name, expected, 4, argc, argv);
02040   }
02041   
02042   reply = (AppleEvent *)malloc(sizeof(AppleEvent));
02043   oerr = AESend(ae, reply, kAEQueueReply | kAECanInteract, kAENormalPriority, kNoTimeOut, NULL, NULL);
02044   if (oerr) {
02045     free(reply);
02046     reply = NULL;
02047     *err = (int)oerr;
02048     *stage = "send failed: ";
02049     reply = NULL;
02050     goto fail;
02051   }
02052   wait_for_reply(ae, reply);
02053   if (escaped) {
02054      reply = NULL;
02055      escaped = 0;
02056      goto escape;
02057   }
02058   
02059   if (!AEGetParamPtr(reply, keyErrorString, typeChar, &rtype, NULL, 0, &sz) && sz) {
02060     char *st;
02061     *err = -1;
02062     if (sz > 256) sz = 256;
02063     st = (char *)scheme_malloc_atomic(sz + 1);
02064     *stage = st;
02065     (*stage)[sz] = 0;
02066     AEGetParamPtr(reply, keyErrorString, typeChar, &rtype, *stage, sz, &sz);
02067     goto fail;
02068   }
02069   if (!AEGetParamPtr(reply, keyErrorNumber, typeLongInteger, &rtype, &ret, sizeof(long), &sz)
02070       && ret) {
02071     *err = (int)ret;
02072     
02073     *stage = "application replied with error: ";
02074     goto fail;
02075   }
02076   
02077   res = ae_unmarshall(reply, NULL, 0, &oerr, stage, NULL);
02078   *result = res;
02079   if (!*result) {
02080     *err = (int)oerr;
02081     goto fail;
02082   }
02083   
02084   retval = 1;
02085   goto done;
02086 escape:
02087   retval = -1;
02088   goto done;
02089 fail:
02090   retval = 0;
02091    
02092 done:
02093   if (ae) {
02094     AEDisposeDesc(ae);
02095     free(ae);
02096   }
02097   if (reply) {
02098     AEDisposeDesc(reply);
02099     free(reply);
02100   }
02101   if (target) {
02102     AEDisposeDesc(target);
02103     free(target);
02104   }
02105   
02106   if (retval < 0) {
02107     scheme_longjmp(scheme_error_buf, 1);
02108   }
02109   
02110   return retval;
02111 }
02112 
02113 
02114 /**********************************************************************/
02115 /*          Generic control tracking with callbacks                   */
02116 /*                 or frame painting on show                          */
02117 /**********************************************************************/
02118 
02119 static RgnHandle clipRgn;
02120 
02121 class wxTC_Closure {
02122 public:
02123   ControlRef ctl;
02124   Point start;
02125   ControlActionUPP proc;
02126 };
02127 
02128 static int call_tc(void *_c)
02129 {
02130   wxTC_Closure *c;
02131 
02132   c = (wxTC_Closure *)_c;
02133 
02134   return TrackControl(c->ctl, c->start, c->proc);
02135 }
02136 
02137 ControlPartCode wxHETTrackControl(ControlRef theControl, Point startPoint, ControlActionUPP actionProc)
02138 {
02139   wxTC_Closure *c;
02140   int v;
02141 
02142   c = new WXGC_PTRS wxTC_Closure;
02143   c->ctl = theControl;
02144   c->start = startPoint;
02145   c->proc = actionProc;
02146 
02147   v = wxHiEventTrampoline(call_tc, (void *)c);
02148 
02149   return v;
02150 }
02151 
02152 class wxSW_Closure {
02153 public:
02154   WindowPtr w, pw;
02155 };
02156 
02157 static int call_sw(void *_c)
02158 {
02159   wxSW_Closure *c;
02160 
02161   c = (wxSW_Closure *)_c;
02162 
02163   if (c->pw)
02164     ShowSheetWindow(c->w, c->pw);
02165   else
02166     ShowWindow(c->w);
02167 
02168   return 0;
02169 }
02170 
02171 extern void wxHETShowWindow(WindowPtr w)
02172 {
02173   wxHETShowSheetWindow(w, NULL);
02174 }
02175 
02176 extern void wxHETShowSheetWindow(WindowPtr w, WindowPtr pw)
02177 {
02178   wxSW_Closure *c;
02179   c = new WXGC_PTRS wxSW_Closure;
02180   c->w = w;
02181   c->pw = pw;
02182 
02183   wxHiEventTrampoline(call_sw, (void *)c);
02184 }
02185 
02186 
02187 int wxHETYield(wxWindow *win, HiEventTrampProc do_f, void *do_data)
02188 {
02189   CGrafPtr savep;
02190   GDHandle savegd;
02191   ThemeDrawingState s;
02192   int more;
02193   wxMacDC *mdc;
02194 
02195   if (!clipRgn)
02196     clipRgn = NewRgn();
02197 
02198   GetGWorld(&savep, &savegd);  
02199   GetThemeDrawingState(&s);
02200   GetClip(clipRgn);
02201 
02202   /* We assume that win was the old MacDC user, and savep is win's
02203      MacDC. But control tracking has changed properties of the
02204      grafport, so indicate the need for a reset: */
02205   mdc = win->MacDC();
02206   mdc->setCurrentUser(NULL);
02207 
02208   more = mred_het_run_some(do_f, do_data);
02209 
02210   wxResetCanvasBackgrounds();
02211 
02212   SetGWorld(savep, savegd);
02213   SetThemeDrawingState(s, TRUE);
02214   SetClip(clipRgn);
02215 
02216   /* Again. win may not be the current user, but whoever
02217      is the current user for savep needs a reset. */
02218   mdc->setCurrentUser(NULL);
02219 
02220   return more;
02221 }
02222 
02223 void MrEdAtomicallyPaint(wxCanvas *win)
02224 {
02225   int block_descriptor;
02226 
02227   block_descriptor = scheme_current_thread->block_descriptor;
02228   scheme_current_thread->block_descriptor = 0;
02229 
02230   scheme_start_atomic();
02231   win->OnPaint();
02232   scheme_end_atomic_no_swap();
02233 
02234   scheme_current_thread->block_descriptor = block_descriptor;
02235 }