Back to index

plt-scheme  4.2.1
mredmsw.cxx
Go to the documentation of this file.
00001 /*
00002  * File:        mredmsw.cc
00003  * Purpose:     MrEd Windows 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 
00011 #if defined(MZ_PRECISE_GC)
00012 # include "wx.h"
00013 #endif
00014 #include "wx_main.h"
00015 #include "wx_utils.h"
00016 #include "scheme.h"
00017 #include "wx_dialg.h"
00018 
00019 #include "mred.h"
00020 
00021 #pragma optimize("", off)
00022 
00023 #define wxLOG_EVENTS 0
00024 #if wxLOG_EVENTS
00025 static FILE *log;
00026 #endif
00027 
00028 #ifndef MZ_PRECISE_GC
00029 # define HIDE_FROM_XFORM(x) x
00030 #endif
00031 
00032 void mred_log_msg(const char *msg, ...);
00033 
00034 #define OS_SEMAPHORE_TYPE HANDLE
00035 
00036 #include "../mzscheme/src/schwinfd.h"
00037 
00038 #include <winsock.h>
00039 
00040 extern long last_msg_time;
00041 
00042 extern "C" {
00043   struct Scheme_Thread_Memory *scheme_remember_thread(void *);
00044   void scheme_forget_thread(struct Scheme_Thread_Memory *);
00045 };
00046 
00047 static volatile int need_quit;
00048 
00049 extern void wxDoPreGM(void);
00050 extern void wxDoPostGM(void);
00051 extern int wxCheckMousePosition();
00052 extern void wxDoLeaveEvent(wxWindow *w, int x, int y, int flags);
00053 extern LRESULT APIENTRY wxWndProc(HWND hWnd, UINT message, WPARAM wParam, LPARAM lParam);
00054 extern struct MrEdContext *MrEdGetContext(wxObject *w);
00055 extern void MrEdQueueInEventspace(void *context, Scheme_Object *thunk);
00056 
00057 class LeaveEvent {
00058 public:
00059   wxWindow *wnd;
00060   int x, y, flags;
00061   LeaveEvent *next;
00062   void *saferef;
00063 };
00064 
00065 #ifdef MZ_PRECISE_GC
00066 # define WRAP_SAFEREF(x) (void *)GC_malloc_immobile_box(GC_malloc_weak_box(gcOBJ_TO_PTR(x), NULL, 0))
00067 # define FREE_SAFEREF(x) GC_free_immobile_box((void **)x)
00068 typedef struct {
00069   short tag;
00070   short filler_used_for_hashing;
00071   void *val;
00072 } wxWeak_Box;
00073 # define GET_SAFEREF(x) ((*(void **)x) ? gcPTR_TO_OBJ((*(wxWeak_Box **)x)->val) : NULL)
00074 #else
00075 # define WRAP_SAFEREF(x) (scheme_dont_gc_ptr(x), x)
00076 # define FREE_SAFEREF(x) scheme_gc_ptr_ok(x)
00077 # define GET_SAFEREF(x) x
00078 #endif
00079 
00080 static void CALLBACK HETRunSome(HWND hwnd, UINT uMsg, UINT idEvent, DWORD dwTime);
00081 static Scheme_Object *call_wnd_proc(void *data, int argc, Scheme_Object **argv);
00082 
00083 static int WM_MRED_LEAVE;
00084 
00085 #ifndef WM_MOUSEWHEEL
00086 # define WM_MOUSEWHEEL 0x020A
00087 #endif
00088 
00089 void MrEdInitFirstContext(MrEdContext *c)
00090 {
00091 }
00092 
00093 void MrEdInitNewContext(MrEdContext *c)
00094 {
00095 }
00096 
00097 void MrEdDestroyContext(MrEdFinalizedContext *)
00098 {
00099 }
00100 
00101 void MrEdSyncCurrentDir(void)
00102 {
00103   Scheme_Object *v;
00104   
00105   v = scheme_get_param(scheme_current_config(), MZCONFIG_CURRENT_DIRECTORY);
00106   scheme_os_setcwd(SCHEME_PATH_VAL(v), 0);
00107 }
00108 
00109 int MrEdGetDoubleTime(void)
00110 {
00111   return GetDoubleClickTime();
00112 }
00113 
00114 extern wxWindow *wxHWNDtoWindow(HWND);
00115 
00116 static MrEdContext *GetContext(HWND hwnd)
00117 {
00118   wxWindow *w;
00119   HWND next = hwnd, wnd;
00120 
00121   do {
00122     do {
00123       wnd = next;
00124       next = GetParent(next);
00125     } while (next);
00126     next = GetWindow(wnd, GW_OWNER);
00127   } while (next);
00128 
00129   w = wxHWNDtoWindow(wnd);
00130 
00131   if (!w)
00132     return NULL;
00133 
00134   if (wxSubType(w->__type, wxTYPE_FRAME))
00135     return (MrEdContext *)((wxFrame *)w)->context;
00136   else if (wxSubType(w->__type, wxTYPE_DIALOG_BOX))
00137     return (MrEdContext *)((wxDialogBox *)w)->context;
00138   else
00139     return NULL;
00140 }
00141 
00142 /**********************************************************************/
00143 
00144 typedef struct {
00145   MrEdContext *c, *c_return;
00146   MSG *msg;
00147   int remove;
00148   HWND wnd;
00149 } CheckInfo;
00150 
00151 static BOOL CALLBACK CheckWindow(HWND wnd, LPARAM param)
00152 {
00153   CheckInfo *info = (CheckInfo *)param;
00154   MrEdContext *c;
00155 
00156   c = GetContext(wnd);
00157 
00158   if ((!info->c && (!c || c->ready)) || (info->c == c)) {
00159     if (c && c->queued_leaves) {
00160       if (info->remove) {
00161        if (!WM_MRED_LEAVE)
00162          WM_MRED_LEAVE = RegisterWindowMessage("MrEd_Leave_" MRED_GUID);
00163        info->wnd = wnd;
00164        info->c_return = c;
00165        info->msg->message = WM_MRED_LEAVE;
00166        {
00167          if (!c->queued_leaves->saferef) {
00168            void *sr;
00169            sr = WRAP_SAFEREF(c->queued_leaves);
00170            c->queued_leaves->saferef = sr;
00171          }
00172        }
00173        info->msg->lParam = (long)c->queued_leaves->saferef;
00174        c->queued_leaves = c->queued_leaves->next;
00175       }
00176       return FALSE;
00177     }
00178 
00179     if (PeekMessage(info->msg, wnd, NULL, NULL,
00180                     info->remove ? PM_REMOVE : PM_NOREMOVE)) {
00181       info->wnd = wnd;
00182       info->c_return = c;
00183       scheme_notify_sleep_progress();
00184       return FALSE;
00185     }
00186   }
00187 
00188   return TRUE;
00189 }
00190 
00191 int FindReady(MrEdContext *c, MSG *msg, int remove, MrEdContext **c_return)
00192 {
00193   MSG backup;
00194   CheckInfo info;
00195   int result = 0;
00196 
00197   if (!msg)
00198     msg = &backup;
00199 
00200   info.c = c;
00201   info.msg = msg;
00202   info.remove = remove;
00203 
00204   if (!EnumThreadWindows(GetCurrentThreadId(), (WNDENUMPROC)CheckWindow, (LPARAM)&info)) {
00205     if (c_return)
00206       *c_return = info.c_return;
00207     result = 1;
00208   }
00209 
00210   /* XP uses messages above 0x4000 to hilite items in the task bar,
00211      etc. In any case, these messages won't be handled by us, so they
00212      can't trigger Scheme code. (If 0x4000 handling ends up sending a
00213      window a message that we *do* handle, we'll end up ignoring it,
00214      as we do for all unexpected messages that can call into
00215      Scheme.) */
00216   {
00217     MSG pmsg;
00218     while (PeekMessage(&pmsg, NULL, 0x4000, 0xFFFF, PM_REMOVE)) {
00219       wxTranslateMessage(&pmsg);
00220       DispatchMessage(&pmsg);
00221       scheme_notify_sleep_progress();
00222     }
00223   }
00224 
00225   return result;
00226 }
00227 
00228 int MrEdGetNextEvent(int check_only, int current_only,
00229                    MSG *event, MrEdContext **which)
00230 {
00231   MrEdContext *c;
00232 
00233   if (which)
00234     *which = NULL;
00235 
00236   if (need_quit) {
00237     /* This function can be called in any thread; it queues as necessary: */
00238     need_quit = 0;
00239     wxDrop_Quit();
00240   }
00241 
00242   if (current_only)
00243     c = MrEdGetContext();
00244   else
00245     c = NULL;
00246 
00247   wxCheckMousePosition();
00248 
00249   return FindReady(c, event, !check_only, which);
00250 }
00251 
00252 static HWND can_trampoline_win;
00253 static HWND need_trampoline_win;
00254 static UINT need_trampoline_message;
00255 static WPARAM need_trampoline_wparam;
00256 static LPARAM need_trampoline_lparam;
00257 static WNDPROC need_trampoline_proc;
00258 int wx_trampolining;
00259 
00260 static int HETDispatchMessage(void *_msg)
00261 {
00262   MSG *msg = (MSG *)_msg;
00263   DispatchMessage(msg);
00264   return 0;
00265 }
00266 
00267 void MrEdDispatchEvent(MSG *msg)
00268 {
00269   switch (msg->message) {
00270   case WM_RBUTTONDOWN:
00271   case WM_RBUTTONUP:
00272   case WM_RBUTTONDBLCLK:
00273   case WM_MBUTTONDOWN:
00274   case WM_MBUTTONUP:
00275   case WM_MBUTTONDBLCLK:
00276   case WM_LBUTTONDOWN:
00277   case WM_LBUTTONUP:
00278   case WM_LBUTTONDBLCLK:
00279   case WM_MOUSEMOVE:
00280   case WM_MOUSEWHEEL:
00281   case WM_NCLBUTTONDOWN:
00282   case WM_NCRBUTTONDOWN:
00283   case WM_NCMBUTTONDOWN:
00284   case WM_NCLBUTTONDBLCLK:
00285   case WM_NCRBUTTONDBLCLK:
00286   case WM_NCMBUTTONDBLCLK:
00287   case WM_NCMOUSEMOVE:
00288   case WM_NCLBUTTONUP:
00289   case WM_NCRBUTTONUP:
00290   case WM_NCMBUTTONUP:
00291     wxUnhideCursor();
00292     break;
00293   default:
00294     break;
00295   }
00296 
00297   if (WM_MRED_LEAVE && (msg->message == WM_MRED_LEAVE)) {
00298     /* Queued leave event */
00299     void *sr = (void *)msg->lParam;
00300     LeaveEvent *e;
00301     e = (LeaveEvent *)GET_SAFEREF(sr);
00302     FREE_SAFEREF(sr);
00303     if (e)
00304       wxDoLeaveEvent(e->wnd, e->x, e->y, e->flags);
00305   } else if (!wxTheApp->ProcessMessage(msg)) {
00306 #if wxLOG_EVENTS
00307     if (!log)
00308       log = fopen("evtlog", "w");
00309     fprintf(log, "{SEND %lx (%lx) %lx\n",
00310            msg->hwnd, GetContext(msg->hwnd),
00311            msg->message);
00312     fflush(log);
00313 #endif
00314 
00315     wxTranslateMessage(msg);
00316 
00317     can_trampoline_win = msg->hwnd;
00318     last_msg_time = msg->time;
00319       
00320     DispatchMessage(msg);
00321 
00322 #if wxLOG_EVENTS
00323     if (!log)
00324       log = fopen("evtlog", "w");
00325     fprintf(log, " SENT %lx (%lx) %lx %lx %lx}\n",
00326            msg->hwnd, GetContext(msg->hwnd), msg->message,
00327            need_trampoline_win, need_trampoline_message);
00328     fflush(log);
00329 #endif
00330 
00331     can_trampoline_win = 0;
00332 
00333     /* See wxEventTrampoline, below: */
00334     {
00335       int iterations;
00336 
00337       for (iterations = 0; iterations < 10; iterations++) {
00338        if (msg->hwnd && (need_trampoline_win == msg->hwnd)) {
00339          HWND win = need_trampoline_win;
00340          need_trampoline_win = 0;
00341          wx_trampolining = 1;
00342          if (iterations < 9)
00343            can_trampoline_win = win;
00344          else
00345            can_trampoline_win = NULL;
00346          need_trampoline_proc(win, need_trampoline_message,
00347                             need_trampoline_wparam, need_trampoline_lparam);
00348        } else
00349          break;
00350       }
00351     }
00352   }
00353 }
00354 
00355 void wxCopyData(LPARAM lParam)
00356 {
00357   /* Is this a message from another MrEd? */
00358   int len;
00359   COPYDATASTRUCT *cd;
00360   len = strlen(MRED_GUID);
00361   cd = (COPYDATASTRUCT *)lParam;
00362   if ((cd->cbData > len + 4 + sizeof(DWORD)) 
00363       && !strncmp((char *)cd->lpData, MRED_GUID, len)) {
00364     if (!strncmp((char *)cd->lpData + len, "OPEN", 4)) {
00365       /* This is an "OPEN" event, with a command line.
00366         The command line's argv (sans argv[0]) is
00367         expressed as a DWORD for the number of args,
00368         followed by each arg. Each arg is a DWORD
00369         for the number of chars and then the chars. */
00370       DWORD w;
00371       int cnt, i, pos;
00372       char **argv, *s;
00373       memcpy(&w, (char *)cd->lpData + len + 4, sizeof(DWORD));
00374       cnt = w;
00375       pos = len + 4 + sizeof(DWORD);
00376       argv = new char*[cnt];
00377       for (i = 0; i < cnt; i++) {
00378        if (pos + sizeof(DWORD) <= cd->cbData) {
00379          memcpy(&w, (char *)cd->lpData + pos, sizeof(DWORD));
00380          pos += sizeof(DWORD);
00381          if (w >= 0 && (pos + w <= cd->cbData)) {
00382            s = new WXGC_ATOMIC char[w + 1];
00383            memcpy(s, (char *)cd->lpData + pos, w);
00384            s[w] = NULL;
00385            argv[i] = s;
00386            pos += w;
00387          } else {
00388            cnt = i;
00389            break;
00390          }
00391        } else {
00392          cnt = i;
00393          break;
00394        }
00395       }
00396       wxDrop_Runtime(argv, cnt);
00397     }
00398   }
00399 }
00400 
00401 int wxEventTrampoline(HWND hWnd, UINT message, WPARAM wParam, LPARAM lParam,
00402                     LRESULT *res, WNDPROC proc)
00403   /* The Windows event dispatcher doesn't like MrEd's thread
00404      implementation.  In particular, if a message causes a thread
00405      switch or kill, because it triggers Scheme code, then event
00406      dispatches don't return in the way that Windows expects.
00407 
00408      We therefore set up a special trampoline for events that trigger
00409      Scheme code. For example, WM_LBUTTONDOWN. Other events, such as
00410      WM_PAINT or WM_SETFOCUS messages, are handled through a
00411      "trampoline" in the form of queued callbacks, since those events
00412      may be received other than through an event dispatch (i.e., some
00413      other Windows toolbox call triggers and event that it sends
00414      directly).
00415 
00416      For trampolined events, we return from the Windows-sponsored
00417      message send, and then re-send the message (where the re-send
00418      might trigger Scheme code). These events *cannot* be handled
00419      without a trampoline. For example, if somehow the WM_LBUTTONDOWN
00420      message is sent directly to a window, we can't handle it. The
00421      wx_start_win_event() function returns 0 to say "give up".
00422 
00423      For certain kinds of events, the callback queueing is most easily
00424      implemented in Scheme within mred.ss. For those cases, we put
00425      MzScheme into atomic mode while handling the event. The "mred.ss"
00426      implementation promises to run quickly (and not call user code).
00427 
00428      Scrolling is a special case. To implement interactive scrolling,
00429      we jump into a special mode started by wxHiEventTrampoline().
00430      This mode calls into Windows to implement scrolling, but handles
00431      WM_HSCROLL and WM_VSCROLL messages specially. See mred.cxx for details
00432      on wxHiEventTrampoline. */
00433 {
00434   int tramp;
00435 
00436 #if wxLOG_EVENTS
00437   if (!log)
00438     log = fopen("evtlog", "w");
00439   fprintf(log,
00440          "[TCHECK %lx %lx (%lx) %lx"
00441 # ifdef MZ_PRECISE_GC
00442          " %lx"
00443 # endif
00444          "]\n",
00445          scheme_current_thread,
00446          hWnd, can_trampoline_win, message
00447 # ifdef MZ_PRECISE_GC
00448          , ((void **)__gc_var_stack__[0])[0]
00449 # endif
00450          );
00451   fflush(log);
00452 #endif
00453 
00454 
00455   switch (message) {
00456   case WM_HSCROLL:
00457   case WM_VSCROLL:
00458     /* Special cases */
00459     tramp = 0;
00460     break;
00461   case WM_QUERYENDSESSION:
00462     /* Always allow end-session here; see wx_pdf for the effective guardian */
00463     tramp = 1;
00464     *res = 1;
00465     break;
00466   case WM_ENDSESSION:
00467   case WM_CLOSE:
00468     tramp = 1;
00469     *res = 1;
00470     break;
00471   case WM_RBUTTONDOWN:
00472   case WM_RBUTTONUP:
00473   case WM_RBUTTONDBLCLK:
00474   case WM_MBUTTONDOWN:
00475   case WM_MBUTTONUP:
00476   case WM_MBUTTONDBLCLK:
00477   case WM_LBUTTONDOWN:
00478   case WM_LBUTTONUP:
00479   case WM_LBUTTONDBLCLK:
00480   case WM_MOUSEMOVE:
00481   case WM_MOUSEWHEEL:
00482   case WM_SYSKEYUP:
00483   case WM_SYSKEYDOWN:
00484   case WM_KEYUP:
00485   case WM_KEYDOWN:
00486   case WM_SYSCHAR:
00487   case WM_CHAR:
00488   case WM_INITMENU:
00489   case WM_DROPFILES:
00490     tramp = 1;
00491     *res = 1;
00492     break;
00493     /* These three are for pre-emptive WM_INITMENU
00494        and for on-pre-event over scrollbars plus interactive scrolling */
00495   case WM_NCLBUTTONDOWN:
00496   case WM_NCRBUTTONDOWN:
00497   case WM_NCMBUTTONDOWN:
00498   case WM_NCLBUTTONDBLCLK:
00499   case WM_NCRBUTTONDBLCLK:
00500   case WM_NCMBUTTONDBLCLK:
00501     if ((wParam == HTMENU) || (wParam == HTVSCROLL) || (wParam == HTHSCROLL)) {
00502       tramp = 1;
00503       *res = 1;
00504     } else
00505       tramp = 0;
00506     break;
00507     /* These are for on-pre-event over scrollbars plus interactive scrolling */
00508   case WM_NCMOUSEMOVE:
00509   case WM_NCLBUTTONUP:
00510   case WM_NCRBUTTONUP:
00511   case WM_NCMBUTTONUP:
00512     if ((wParam == HTVSCROLL) || (wParam == HTHSCROLL)) {
00513       tramp = 1;
00514       *res = 1;
00515     } else
00516       tramp = 1;
00517     break;
00518   default:
00519     tramp = 0;
00520     break;
00521   }
00522 
00523   if (can_trampoline_win != hWnd) {
00524     if (tramp)
00525       return 1;
00526     return 0;
00527   }
00528 
00529   if (tramp) {
00530     can_trampoline_win = 0;
00531     need_trampoline_win = hWnd;
00532     need_trampoline_proc = proc;
00533     need_trampoline_message = message;
00534     need_trampoline_wparam = wParam;
00535     need_trampoline_lparam = lParam;
00536     return 1;
00537   } else
00538     return 0;
00539 }
00540 
00541 int wx_start_win_event(const char *who, HWND hWnd, UINT message, WPARAM wParam, LPARAM lParam, int tramp, LONG *_retval)
00542 {
00543   /* See wxEventTrampoline notes above. */
00544 
00545 #if wxLOG_EVENTS
00546   if (!log)
00547     log = fopen("evtlog", "w");
00548   fprintf(log, "(%lx %lx %lx[%d] %s %d"
00549 # ifdef MZ_PRECISE_GC
00550          " <%lx %lx %lx>"
00551 # endif
00552          "\n",
00553          scheme_current_thread, hWnd, message, wParam, who, tramp
00554 # ifdef MZ_PRECISE_GC
00555          , GC_variable_stack
00556          , ((void **)__gc_var_stack__[0])[0]
00557          , ((void **)((void **)__gc_var_stack__[0])[0])[0]
00558 # endif
00559          );
00560   fflush(log);
00561 #endif
00562 
00563   if (!tramp && scheme_current_thread) {
00564     Scheme_Object *v;
00565     HiEventTramp *het;
00566 
00567     v = scheme_extract_one_cc_mark(NULL, mred_het_key);
00568     if (!v)
00569       het = NULL;
00570     else
00571       het = (HiEventTramp *)SCHEME_CAR(v);
00572 
00573     if (het) {
00574       /* we're in restricted mode; general calls into Scheme are bad */
00575       switch (message) {
00576        /* These shouldn't happen; reject them if they do! */
00577       case WM_ACTIVATE:
00578       case WM_NCACTIVATE:
00579       case WM_SETFOCUS:
00580       case WM_KILLFOCUS:
00581       case WM_SIZE:
00582       case WM_MOVE:
00583       case WM_COMMAND:
00584       case WM_MDIACTIVATE:
00585       case WM_CLOSE:
00586 #if wxLOG_EVENTS
00587        fprintf(log, " RESTRICTED)\n");
00588        fflush(log);
00589 #endif
00590        return 0;
00591       case WM_VSCROLL:
00592       case WM_HSCROLL:
00593        /* need to re-queue the scroll event (in the MrEd middle queue) */
00594 #if wxLOG_EVENTS
00595        fprintf(log, "_scroll_ %lx\n", GetCurrentThreadId());
00596 #endif
00597        {
00598          MSG *msg;
00599          Scheme_Object *thunk;
00600          msg = (MSG *)scheme_malloc_atomic(sizeof(MSG));
00601 #if wxLOG_EVENTS
00602          fprintf(log, "_scroll1_\n");
00603 #endif
00604          msg->hwnd = hWnd;
00605          msg->message = message;
00606          msg->wParam = wParam;
00607          msg->lParam = lParam;
00608          thunk = scheme_make_closed_prim(call_wnd_proc, (Scheme_Object *)msg);
00609 #if wxLOG_EVENTS
00610        fprintf(log, "_scroll2_\n");
00611 #endif
00612          MrEdQueueInEventspace(MrEdGetContext(NULL), thunk);
00613        }
00614 #if wxLOG_EVENTS
00615        fprintf(log, "_scrolly_ %d\n", het->yielding);
00616 #endif
00617        if (!het->yielding) {
00618          if (het->timer_on) {
00619            het->timer_on = 0;
00620            KillTimer(NULL, het->timer_id);
00621          }
00622 #if wxLOG_EVENTS
00623          fprintf(log, "{HET\n");
00624 #endif
00625          mred_het_run_some(NULL, NULL);
00626 #if wxLOG_EVENTS
00627          fprintf(log, "HET}\n");
00628 #endif
00629          if (het->in_progress && !het->timer_on) {
00630            /* Make a timer event so that we get more time... */
00631            het->timer_on = 1;
00632            het->timer_id = SetTimer(0, NULL, 100, HETRunSome);
00633          }
00634 #if wxLOG_EVENTS
00635          if (het->in_progress)
00636            fprintf(log, " HET_START)\n");
00637          else
00638            fprintf(log, " HET_DONE)\n");
00639          fflush(log);
00640 #endif
00641        } else {
00642 #if wxLOG_EVENTS
00643          fprintf(log, " NESTED)\n");
00644          fflush(log);
00645 #endif
00646        }
00647        return 0;
00648       default:
00649        /* anything else is ok, because it doesn't call Scheme */
00650        break;
00651       }
00652     }
00653   }
00654 
00655   if (!tramp) {
00656     switch (message) {
00657     case WM_QUERYENDSESSION:
00658       *_retval = 1;
00659       return 0;
00660     case WM_NCRBUTTONDOWN:
00661     case WM_NCRBUTTONUP:
00662     case WM_NCRBUTTONDBLCLK:
00663     case WM_NCMBUTTONDOWN:
00664     case WM_NCMBUTTONUP:
00665     case WM_NCMBUTTONDBLCLK:
00666     case WM_NCLBUTTONDOWN:
00667     case WM_NCLBUTTONUP:
00668     case WM_NCLBUTTONDBLCLK:
00669     case WM_NCMOUSEMOVE:
00670       if ((wParam != HTVSCROLL) && (wParam != HTHSCROLL))
00671        break;
00672     case WM_CLOSE: /* ^^^^ fallthrough &&&& */
00673     case WM_RBUTTONDOWN:
00674     case WM_RBUTTONUP:
00675     case WM_RBUTTONDBLCLK:
00676     case WM_MBUTTONDOWN:
00677     case WM_MBUTTONUP:
00678     case WM_MBUTTONDBLCLK:
00679     case WM_LBUTTONDOWN:
00680     case WM_LBUTTONUP:
00681     case WM_LBUTTONDBLCLK:
00682     case WM_MOUSEMOVE:
00683     case WM_MOUSEWHEEL:
00684     case WM_SYSKEYUP:
00685     case WM_SYSKEYDOWN:
00686     case WM_KEYUP:
00687     case WM_KEYDOWN:
00688     case WM_SYSCHAR:
00689     case WM_CHAR:
00690     case WM_INITMENU:
00691     case WM_DROPFILES:
00692 #if wxLOG_EVENTS
00693       fprintf(log, " CAN'T HANDLE!)\n");
00694       fflush(log);
00695 #endif
00696       return 0;
00697       break;
00698     default:
00699       /* non-tramp ok */
00700       break;
00701     }
00702   }
00703 
00704   if (!tramp)
00705     scheme_start_atomic();
00706 
00707 #if wxLOG_EVENTS
00708   fprintf(log, " ...\n");
00709 #endif
00710 
00711   return 1;
00712 }
00713 
00714 void wx_end_win_event(const char *who, HWND hWnd, UINT message, int tramp)
00715 {
00716   /* See wxEventTrampoline notes above. */
00717 
00718 #if wxLOG_EVENTS
00719   fprintf(log, " %lx %lx %lx %s %d)"
00720 # ifdef MZ_PRECISE_GC
00721          " <%lx %lx>"
00722 # endif
00723          "\n",
00724          scheme_current_thread, hWnd, message, who, tramp
00725 # ifdef MZ_PRECISE_GC
00726          , GC_variable_stack
00727          , ((void **)__gc_var_stack__[0])[0]
00728 # endif
00729          );
00730   fflush(log);
00731 #endif
00732 
00733   if (!tramp)
00734     scheme_end_atomic_no_swap();
00735 
00736 
00737   if (!tramp && ((message == WM_VSCROLL) || (message == WM_HSCROLL)) && scheme_current_thread) {
00738     HiEventTramp *het;
00739     Scheme_Object *v;
00740 
00741     v = scheme_extract_one_cc_mark(NULL, mred_het_key);
00742     if (!v)
00743       het = NULL;
00744     else
00745       het = (HiEventTramp *)SCHEME_CAR(v);
00746 
00747     if (het) {
00748       mred_het_run_some(NULL, NULL);
00749       if (het->in_progress && !het->timer_on) {
00750        /* Make a timer event so that we get more time... */
00751        het->timer_on = 1;
00752        het->timer_id = SetTimer(0, NULL, 100, HETRunSome);
00753       }
00754     }
00755   }
00756 }
00757 
00758 static Scheme_Object *call_wnd_proc(void *data, int argc, Scheme_Object **argv)
00759 {
00760   MSG *msg = (MSG *)data;
00761 
00762 #if wxLOG_EVENTS
00763   fprintf(log, "{CWP\n");
00764 #endif
00765 
00766   wx_trampolining = 1;
00767   wxWndProc(msg->hwnd, msg->message, msg->wParam, msg->lParam);
00768 
00769 #if wxLOG_EVENTS
00770   fprintf(log, " CWP}\n");
00771 #endif
00772 
00773   return scheme_void;
00774 }
00775 
00776 static void CALLBACK HETRunSome(HWND hwnd, UINT uMsg, UINT idEvent, DWORD dwTime)
00777 {
00778   HiEventTramp *het;
00779   Scheme_Object *v;
00780   
00781   v = scheme_extract_one_cc_mark(NULL, mred_het_key);
00782   if (!v)
00783     het = NULL;
00784   else
00785     het = (HiEventTramp *)SCHEME_CAR(v);
00786 
00787   if (het) {
00788 #if wxLOG_EVENTS
00789     fprintf(log, "(HET_TIMER_CONT\n");
00790 #endif
00791     if (het->timer_on) {
00792       het->timer_on = 0;
00793       KillTimer(NULL, het->timer_id);
00794     }
00795     mred_het_run_some(NULL, NULL);
00796     if (het->in_progress) {
00797       het->timer_on = 1;
00798       het->timer_id = SetTimer(0, NULL, 100, HETRunSome);
00799     }
00800 #if wxLOG_EVENTS
00801     if (het->in_progress)
00802       fprintf(log, " HET_TIMER_SUSPEND)\n");
00803     else
00804       fprintf(log, " HET_TIMER_DONE)\n");
00805 #endif
00806   }
00807 }
00808 
00809 /***************************************************************************/
00810 
00811 void wxPostQueryEndSession()
00812   /* Called from non-main Windows thread */
00813 {
00814   need_quit = 1;
00815 }
00816 
00817 /***************************************************************************/
00818 
00819 int MrEdCheckForBreak(void)
00820 {
00821   HWND w;
00822 
00823   w = GetActiveWindow();
00824 
00825   if (MrEdGetContext() != GetContext(w))
00826     return 0;
00827 
00828   {
00829     SHORT hit = (SHORT)0x8000;
00830     SHORT hitnow = (SHORT)0x0001;
00831     SHORT c, shift, control;
00832 
00833     c = GetAsyncKeyState('C');
00834 #if BREAKING_REQUIRES_SHIFT
00835     shift = GetAsyncKeyState(VK_SHIFT);
00836 #else
00837     shift = hit;
00838 #endif
00839     control = GetAsyncKeyState(VK_CONTROL);
00840 
00841     return ((c & hit) && (c & hitnow) && (control & hit) && (shift & hit));
00842   }
00843 }
00844 
00845 void MrEdMSWSleep(float secs, void *fds, SLEEP_PROC_PTR mzsleep)
00846 {
00847   if (fds && ((win_extended_fd_set *)fds)->no_sleep)
00848     return;
00849 
00850   if (wxCheckMousePosition())
00851     return;
00852 
00853   scheme_add_fd_eventmask(fds, QS_ALLINPUT);
00854   mzsleep(secs, fds);
00855 }
00856 
00857 void wxQueueLeaveEvent(void *ctx, wxWindow *wnd, int x, int y, int flags)
00858 {
00859   MrEdContext *c = (MrEdContext *)ctx;
00860   LeaveEvent *e, *prev, *n;
00861 
00862   e = new LeaveEvent();
00863 
00864   e->wnd = wnd;
00865   e->x = x;
00866   e->y = y;
00867   e->flags = flags;
00868   e->next = NULL;
00869 
00870   prev = NULL;
00871   for (n = c->queued_leaves; n; n = n->next) {
00872     prev = n;
00873   }
00874 
00875   if (prev)
00876     prev->next = e;
00877   else
00878     c->queued_leaves = e;
00879 }
00880 
00881 /**********************************************************************/
00882 
00883 /* For Windows 95/98/Me, it's important to release all GDI object
00884    handles on exit. The gdi_objects table maps integers to pairs of
00885    HANDLES.  The integer is the handle | 0x1, which ensures that the
00886    key looks like a Scheme fixnum. The pair of handles has something
00887    in the first slot for !(handle & 0x1), and something in the second
00888    slot for (handle & 0x1). */
00889 
00890 static Scheme_Hash_Table *gdi_objects;
00891 static void (*orig_exit)(int);
00892 
00893 void mred_clean_up_gdi_objects(void)
00894 {
00895   int i;
00896 
00897   if ((long)gdi_objects == 0x1)
00898     return;
00899 
00900   for (i = 0; i < gdi_objects->size; i++) {
00901     if (gdi_objects->vals[i]) {
00902       Scheme_Object *key;
00903       HANDLE *val;
00904       key = gdi_objects->keys[i];
00905       val = (HANDLE *)gdi_objects->vals[i];
00906       scheme_hash_set(gdi_objects, key, NULL);
00907       if (val[0])
00908        DeleteObject(val[0]);
00909       if (val[1])
00910        DeleteObject(val[1]);
00911     }
00912   }
00913 }
00914 
00915 static void clean_up_and_exit(int v)
00916 {
00917   mred_clean_up_gdi_objects();
00918   wxGDIShutdown();
00919   if (orig_exit)
00920     orig_exit(v);
00921   exit(v);
00922 }
00923 
00924 void RegisterGDIObject(HANDLE x)
00925 {
00926   if (!gdi_objects) {
00927     /* Only need this table if we're in 95/98/Me */
00928     OSVERSIONINFO info;
00929     info.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
00930     GetVersionEx(&info);
00931     if (info.dwPlatformId != VER_PLATFORM_WIN32_NT) {
00932       /* Need it... */
00933       wxREGGLOB(gdi_objects);
00934       gdi_objects = scheme_make_hash_table(SCHEME_hash_ptr);
00935       orig_exit = scheme_exit;
00936       scheme_exit = clean_up_and_exit;
00937     } else
00938       gdi_objects = (Scheme_Hash_Table *)0x1;
00939   }
00940 
00941   if ((long)gdi_objects == 0x1)
00942     return;
00943 
00944   if (x) {
00945     Scheme_Object *key;
00946     HANDLE *v;
00947     key = (Scheme_Object *)(((long)x) | 0x1);
00948     v = (HANDLE *)scheme_hash_get(gdi_objects, key);
00949     if (!v) {
00950       v = (HANDLE *)scheme_malloc_atomic(sizeof(HANDLE)*2);
00951       v[0] = v[1] = NULL;
00952     }
00953     if (((long)x) & 1)
00954       v[1] = x;
00955     else
00956       v[0] = x;
00957     scheme_hash_set(gdi_objects, key, (Scheme_Object *)v);
00958   }
00959 }
00960 
00961 void DeleteRegisteredGDIObject(HANDLE x)
00962 {
00963   Scheme_Object *key;
00964   HANDLE *v;
00965 
00966   if ((long)gdi_objects != 0x1) {
00967     key = (Scheme_Object *)(((long)x) | 0x1);
00968     v = (HANDLE *)scheme_hash_get(gdi_objects, key);
00969     if (v) {
00970       if (((long)x) & 1)
00971        v[1] = NULL;
00972       else
00973        v[0] = NULL;
00974 
00975       if (!v[0] && !v[1]) {
00976        /* Remove from hash table: */
00977        scheme_hash_set(gdi_objects, key, NULL);
00978       }
00979     }
00980   }
00981 
00982   DeleteObject(x);
00983 }
00984 
00985 /**************************************************/
00986 
00987 void mred_log_msg(const char *msg, ...)
00988 {
00989   long len;
00990   GC_CAN_IGNORE va_list args;
00991   FILE *f;
00992 
00993   f = fopen("mredlog", "a");
00994 
00995   fprintf(f, "0x%lx ", scheme_current_thread);
00996 
00997   HIDE_FROM_XFORM(va_start(args, msg));
00998   len = vfprintf(f, msg, args);
00999   HIDE_FROM_XFORM(va_end(args));
01000 
01001   fclose(f);
01002 }
01003