Back to index

plt-scheme  4.2.1
mred.cxx
Go to the documentation of this file.
00001 /*
00002  * File:        mred.cc
00003  * Purpose:     MrEd main file, including a hodge-podge of global stuff
00004  * Author:      Matthew Flatt
00005  * Created:     1995
00006  * Copyright:   (c) 2004-2009 PLT Scheme Inc.
00007  * Copyright:   (c) 1995-2000, Matthew Flatt
00008  */
00009 
00010 /* wx_xt: */
00011 #define Uses_XtIntrinsic
00012 #define Uses_XtIntrinsicP
00013 #define Uses_XLib
00014 
00015 #if defined(_MSC_VER) && defined(MZ_PRECISE_GC)
00016 # include "wx.h"
00017 #endif
00018 
00019 /* wx_motif, for wxTimer: */
00020 #ifdef __GNUG__
00021 # pragma implementation "wx_timer.h"
00022 #endif
00023 
00024 #include "common.h"
00025 
00026 #include "wx_frame.h"
00027 #include "wx_utils.h"
00028 #include "wx_main.h"
00029 #include "wx_buttn.h"
00030 #include "wx_messg.h"
00031 #include "wx_timer.h"
00032 #include "wx_dialg.h"
00033 #include "wx_cmdlg.h"
00034 #include "wx_menu.h"
00035 #include "wx_dcps.h"
00036 #include "wx_clipb.h"
00037 #include "wx_types.h"
00038 #ifdef wx_mac
00039 # include "simpledrop.h"
00040 #endif
00041 #ifdef wx_msw
00042 # include "wx_wmgr.h"
00043 #endif
00044 #include <ctype.h>
00045 #include <stdio.h>
00046 #include <stdarg.h>
00047 
00048 /* Solaris: getdtablesize sometimes not available */
00049 #if !defined(USE_ULIMIT) && defined(sun) && defined(__svr4__)
00050 # define USE_ULIMIT
00051 #endif
00052 
00053 #if defined(wx_xt)
00054 # include <X11/Xlib.h>
00055 # include <X11/keysymdef.h>
00056 #endif
00057 
00058 #ifdef wx_x
00059 # include <sys/types.h>
00060 # include <sys/time.h>
00061 # include <unistd.h>
00062 #  if defined(_IBMR2)
00063 #   include <sys/select.h>
00064 #  endif
00065 # include <signal.h>
00066 #endif
00067 
00068 #ifdef wx_msw
00069 # ifdef _MSC_VER
00070 #  include <direct.h>
00071 # else
00072 #  include <dir.h>
00073 # endif
00074 #endif
00075 
00076 #ifdef wx_mac
00077 # ifndef WX_CARBON
00078 #  include <Events.h>
00079 # endif
00080 # ifdef OS_X
00081 int wx_in_terminal;
00082 # else
00083 #  define wx_in_terminal 0
00084 # endif
00085 #else
00086 # ifdef wx_msw
00087 static int wx_in_terminal = 0;
00088 # else
00089 #  define wx_in_terminal 0
00090 # endif
00091 #endif
00092 
00093 #ifdef OS_X
00094 extern "C" void _signal_nobind(...);
00095 #endif
00096 
00097 #if defined(wx_x) || defined(wx_msw)
00098 # define ADD_OBJ_DUMP 0
00099 #else
00100 # define ADD_OBJ_DUMP 0
00101 #endif
00102 
00103 #define INTERRUPT_CHECK_ON 0
00104 
00105 # include "wxs/wxscheme.h"
00106 # include "wxs/wxsmred.h"
00107 # include "wxs/wxs_fram.h"
00108 # include "wxs/wxs_obj.h"
00109 
00110 wxFrame *mred_real_main_frame;
00111 
00112 #if defined(wx_xt) || defined(OS_X)
00113 # define mred_BREAK_HANDLER
00114 #endif
00115 
00116 static Scheme_Thread *user_main_thread;
00117 
00118 extern void wxMouseEventHandled(void);
00119 #ifdef wx_xt
00120 extern int wx_single_instance;
00121 #endif
00122 
00123 #include "mred.h"
00124 
00125 #ifdef MPW_CPLUS
00126 extern "C" {
00127   typedef void (*GC_F_PTR)(void *, void *);
00128   typedef void (*ON_KILL_PTR)(struct Scheme_Thread *p);
00129   typedef Scheme_Object *(*MK_PTR)(void);
00130 # if !defined(USE_SENORA_GC) && !defined(MZ_PRECISE_GC)
00131   typedef void (*IGNORE_PTR)(char *, GC_word);
00132 # endif
00133   typedef void (*CONSOLE_PRINTF_PTR)(char *str, ...);
00134   typedef void (*CONSOLE_OUTPUT_PTR)(char *str, long len);
00135   typedef void (*EXIT_PTR)(int);
00136   typedef void (*DW_PRE_PTR)(void *);
00137   typedef Scheme_Object *(*DW_RUN_PTR)(void *);
00138   typedef void (*DW_POST_PTR)(void *);
00139   typedef void (*ON_SUSPEND_PTR)(void);
00140 }
00141 # define CAST_SCP (Scheme_Closed_Prim *)
00142 # define CAST_GCP (GC_F_PTR)
00143 # define CAST_SCCC (Scheme_Close_Custodian_Client *)
00144 # define CAST_BLKCHK (Scheme_Ready_Fun)
00145 # define CAST_WU (Scheme_Needs_Wakeup_Fun)
00146 # define CAST_TOK (ON_KILL_PTR)
00147 # define CAST_GS (Scheme_Get_String_Fun)
00148 # define CAST_IREADY (Scheme_In_Ready_Fun)
00149 # define CAST_ICLOSE (Scheme_Close_Input_Fun)
00150 # define CAST_WS (Scheme_Write_String_Fun)
00151 # define CAST_MK (MK_PTR)
00152 # define CAST_SLEEP (SLEEP_PROC_PTR)
00153 # define CAST_IGNORE (IGNORE_PTR)
00154 # define CAST_PRINTF (CONSOLE_PRINTF_PTR)
00155 # define CAST_OUTPUT (CONSOLE_OUTPUT_PTR)
00156 # define CAST_EXIT (EXIT_PTR)
00157 # define CAST_DW_PRE (DW_PRE_PTR)
00158 # define CAST_DW_RUN (DW_RUN_PTR)
00159 # define CAST_DW_POST (DW_POST_PTR)
00160 # define CAST_SUSPEND (ON_SUSPEND_PTR)
00161 # define CAST_EXT (Scheme_Custodian_Extractor)
00162 #else
00163 # define CAST_SCP /* empty */
00164 # define CAST_GCP /* empty */
00165 # define CAST_SCCC  /* empty */
00166 # define CAST_BLKCHK /* empty */
00167 # define CAST_WU /* empty */
00168 # define CAST_TOK /* empty */
00169 # define CAST_GS /* empty */
00170 # define CAST_IREADY /* empty */
00171 # define CAST_ICLOSE /* empty */
00172 # define CAST_WS /* empty */
00173 # define CAST_MK /* empty */
00174 # define CAST_SLEEP /* empty */
00175 # define CAST_IGNORE /* empty */
00176 # define CAST_PRINTF /* empty */
00177 # define CAST_OUTPUT /* empty */
00178 # define CAST_EXIT /* empty */
00179 # define CAST_DW_PRE /* empty */
00180 # define CAST_DW_RUN /* empty */
00181 # define CAST_DW_POST /* empty */
00182 # define CAST_SUSPEND /* empty */
00183 # define CAST_EXT /* empty */
00184 #endif
00185 
00186 /* Set by mrmain.cxx: */
00187 /* (The indirection is needed to avoid mutual .dll dependencies.) */
00188 MrEd_Finish_Cmd_Line_Run_Proc mred_finish_cmd_line_run;
00189 void mred_set_finish_cmd_line_run(MrEd_Finish_Cmd_Line_Run_Proc p) { mred_finish_cmd_line_run = p; }
00190 MrEd_Run_From_Cmd_Line_Proc mred_run_from_cmd_line;
00191 void mred_set_run_from_cmd_line(MrEd_Run_From_Cmd_Line_Proc p) { mred_run_from_cmd_line = p; }
00192 
00193 #if 0
00194 /* Force initialization of the garbage collector (currently needed
00195    only when supporting Irix sprocs) */
00196 class GCInit {
00197 public:
00198   GCInit() {
00199     GC_INIT();
00200   }
00201 };
00202 static GCInit _gcinit;
00203 #endif
00204 
00205 static Scheme_Env *global_env;
00206 
00207 class MrEdApp: public wxApp
00208 {
00209 public:
00210   Bool initialized;
00211   int xargc;
00212   char **xargv;
00213 
00214   MrEdApp();
00215   wxFrame *OnInit(void);
00216   void RealInit(void);
00217 #ifdef wx_mac
00218   char *GetDefaultAboutItemName();
00219   void DoDefaultAboutItem();
00220 #endif
00221   int OnExit(void);
00222 };
00223 
00224 MrEdApp *TheMrEdApp;
00225 
00226 static int exit_val = 0;
00227 
00228 #ifdef LIBGPP_REGEX_HACK
00229 /* Fixes weirdness with libg++ and the compiler: it tries to
00230    destroy global regexp objects that were never created. Calling
00231    the constructor forces the other global values to be initialized. */
00232 # include <Regex.h>
00233 #endif
00234 
00235 /****************************************************************************/
00236 /*                               Contexts                                   */
00237 /****************************************************************************/
00238 
00239 MrEdContext *mred_contexts;
00240 static MrEdContext *mred_main_context;
00241 static MrEdContext *mred_only_context;
00242 static int only_context_just_once = 0;
00243 static MrEdContext *user_main_context;
00244 static MrEdContextFramesRef mred_frames; /* list of all frames (weak link to invisible ones) */
00245 static Scheme_Hash_Table *timer_contexts;
00246 int mred_eventspace_param;
00247 int mred_event_dispatch_param;
00248 Scheme_Type mred_eventspace_type;
00249 Scheme_Type mred_nested_wait_type;
00250 static Scheme_Type mred_eventspace_hop_type;
00251 static Scheme_Object *def_dispatch;
00252 int mred_ps_setup_param;
00253 #ifdef NEED_HET_PARAM
00254 Scheme_Object *mred_het_key;
00255 #endif
00256 
00257 typedef struct Nested_Wait {
00258   Scheme_Object so;
00259   Scheme_Object *wait_on;
00260 } Nested_Wait;
00261 
00262 typedef struct Context_Custodian_Hop {
00263   Scheme_Object so;
00264   MrEdContext *context;
00265 } Context_Custodian_Hop;
00266 
00267 #ifdef MZ_PRECISE_GC
00268 # define WEAKIFY(x) ((MrEdContext *)GC_malloc_weak_box(x, NULL, 0))
00269 # define WEAKIFIED(x) ((MrEdContext *)GC_weak_box_val(x))
00270 #else
00271 # define WEAKIFY(x) x
00272 # define WEAKIFIED(x) x
00273 # define HIDE_FROM_XFORM(x) x
00274 #endif
00275 
00276 static MrEdContext *check_q_callbacks(int hi, int (*test)(MrEdContext *, MrEdContext *),
00277                                   MrEdContext *tdata, int check_only);
00278 static void remove_q_callbacks(MrEdContext *c);
00279 
00280 #ifdef MZ_PRECISE_GC
00281 
00282 START_XFORM_SKIP;
00283 
00284 static int size_eventspace_val(void *)
00285 {
00286   return gcBYTES_TO_WORDS(sizeof(MrEdContext));
00287 }
00288 
00289 static int mark_eventspace_val(void *p)
00290 {
00291   MrEdContext *c = (MrEdContext *)p;
00292 
00293   gcMARK_TYPED(Scheme_Thread *, c->handler_running);
00294   gcMARK_TYPED(MrEdFinalizedContext *, c->finalized);
00295 
00296   gcMARK_TYPED(wxChildList *, c->topLevelWindowList);
00297   gcMARK_TYPED(wxWindow *, c->modal_window);
00298   gcMARK_TYPED(MrEd_Saved_Modal *, c->modal_stack);
00299 
00300   gcMARK_TYPED(Scheme_Config *, c->main_config);
00301   gcMARK_TYPED(Scheme_Thread_Cell_Table *, c->main_cells);
00302   gcMARK_TYPED(Scheme_Thread_Cell_Table *, c->main_break_cell);
00303 
00304   gcMARK_TYPED(wxTimer *, c->timer);
00305   gcMARK_TYPED(wxTimer **, c->timers);
00306 
00307   gcMARK_TYPED(void *, c->alt_data);
00308 
00309   gcMARK_TYPED(MrEdContext *, c->next);
00310 
00311 #ifdef wx_msw
00312   gcMARK_TYPED(LeaveEvent *, c->queued_leaves);
00313 #endif
00314 
00315   gcMARK_TYPED(Context_Custodian_Hop *, c->mr_hop);
00316   gcMARK_TYPED(Scheme_Custodian_Reference *, c->mref);
00317 
00318   return gcBYTES_TO_WORDS(sizeof(MrEdContext));
00319 }
00320 
00321 static int fixup_eventspace_val(void *p)
00322 {
00323   MrEdContext *c = (MrEdContext *)p;
00324 
00325   gcFIXUP_TYPED(Scheme_Thread *, c->handler_running);
00326   gcFIXUP_TYPED(MrEdFinalizedContext *, c->finalized);
00327 
00328   gcFIXUP_TYPED(wxChildList *, c->topLevelWindowList);
00329   gcFIXUP_TYPED(wxWindow *, c->modal_window);
00330   gcFIXUP_TYPED(MrEd_Saved_Modal *, c->modal_stack);
00331 
00332   gcFIXUP_TYPED(Scheme_Config *, c->main_config);
00333   gcFIXUP_TYPED(Scheme_Thread_Cell_Table *, c->main_cells);
00334   gcFIXUP_TYPED(Scheme_Thread_Cell_Table *, c->main_break_cell);
00335 
00336   gcFIXUP_TYPED(wxTimer *, c->timer);
00337   gcFIXUP_TYPED(wxTimer **, c->timers);
00338 
00339   gcFIXUP_TYPED(void *, c->alt_data);
00340 
00341   gcFIXUP_TYPED(MrEdContext *, c->next);
00342 
00343 #ifdef wx_msw
00344   gcFIXUP_TYPED(LeaveEvent *, c->queued_leaves);
00345 #endif
00346 
00347   gcFIXUP_TYPED(Context_Custodian_Hop *, c->mr_hop);
00348   gcFIXUP_TYPED(Scheme_Custodian_Reference *, c->mref);
00349 
00350   return gcBYTES_TO_WORDS(sizeof(MrEdContext));
00351 }
00352 
00353 static int size_nested_wait_val(void *)
00354 {
00355   return gcBYTES_TO_WORDS(sizeof(Nested_Wait));
00356 }
00357 
00358 static int mark_nested_wait_val(void *p)
00359 {
00360   Nested_Wait *c = (Nested_Wait *)p;
00361 
00362   gcMARK_TYPED(MrEdContext *, c->wait_on);
00363 
00364   return gcBYTES_TO_WORDS(sizeof(Nested_Wait));
00365 }
00366 
00367 static int fixup_nested_wait_val(void *p)
00368 {
00369   Nested_Wait *c = (Nested_Wait *)p;
00370 
00371   gcFIXUP_TYPED(MrEdContext *, c->wait_on);
00372 
00373   return gcBYTES_TO_WORDS(sizeof(Nested_Wait));
00374 }
00375 
00376 static int size_eventspace_hop_val(void *)
00377 {
00378   return gcBYTES_TO_WORDS(sizeof(Context_Custodian_Hop));
00379 }
00380 
00381 static int mark_eventspace_hop_val(void *p)
00382 {
00383   Context_Custodian_Hop *c = (Context_Custodian_Hop *)p;
00384 
00385   gcMARK_TYPED(MrEdContext *, c->context);
00386 
00387   return gcBYTES_TO_WORDS(sizeof(Context_Custodian_Hop));
00388 }
00389 
00390 static int fixup_eventspace_hop_val(void *p)
00391 {
00392   Context_Custodian_Hop *c = (Context_Custodian_Hop *)p;
00393 
00394   gcFIXUP_TYPED(MrEdContext *, c->context);
00395 
00396   return gcBYTES_TO_WORDS(sizeof(Context_Custodian_Hop));
00397 }
00398 
00399 END_XFORM_SKIP;
00400 
00401 #endif
00402 
00403 MrEdContext *MrEdGetContext(wxObject *w)
00404 {
00405   if (w) {
00406 #if !defined(wx_xt) && !defined(wx_mac)
00407     if (wxSubType(w->__type, wxTYPE_FRAME)) {
00408 #endif
00409       MrEdContext *c;
00410       c = (MrEdContext *)((wxFrame *)w)->context;
00411       if (c)
00412        return c;
00413 #if !defined(wx_xt) && !defined(wx_mac)
00414     } else {
00415       MrEdContext *c;
00416       c = (MrEdContext *)((wxDialogBox *)w)->context;
00417       if (c)
00418        return c;
00419     }
00420 #endif
00421   }
00422 
00423   if (mred_only_context) {
00424     if (only_context_just_once) {
00425       MrEdContext *c = mred_only_context;
00426       mred_only_context = NULL;
00427       only_context_just_once = 0;
00428       return c;
00429     } else
00430       return mred_only_context;
00431   } else
00432     return (MrEdContext *)scheme_get_param(scheme_current_config(), mred_eventspace_param);
00433 }
00434 
00435 void *MrEdGetWindowContext(wxWindow *w)
00436 {
00437   while (1) {
00438     if (wxSubType(w->__type, wxTYPE_FRAME))
00439       return MrEdGetContext(w);
00440 #if !defined(wx_xt) && !defined(wx_mac)
00441     if (wxSubType(w->__type, wxTYPE_DIALOG_BOX))
00442       return MrEdGetContext(w);
00443 #endif
00444 
00445     w = w->GetParent();
00446   }
00447 }
00448 
00449 void *wxGetContextForFrame()
00450 {
00451   if (!TheMrEdApp)
00452     return NULL;
00453   else
00454     return (void *)MrEdGetContext();
00455 }
00456 
00457 wxChildList *wxGetTopLevelWindowsList(wxObject *w)
00458 {
00459   MrEdContext *c;
00460   c = MrEdGetContext(w);
00461 
00462   return c->topLevelWindowList;
00463 }
00464 
00465 wxWindow *wxGetModalWindow(wxObject *w)
00466 {
00467   MrEdContext *c;
00468   c = MrEdGetContext(w);
00469 
00470   return c->modal_window;
00471 }
00472 
00473 class MrEd_Saved_Modal {
00474 public:
00475   wxWindow *win;
00476   MrEd_Saved_Modal *next;
00477 };
00478 
00479 void wxPushModalWindow(wxObject *w, wxWindow *win)
00480 {
00481   MrEdContext *c;
00482   c = MrEdGetContext(w);
00483 
00484   if (c->modal_window) {
00485     MrEd_Saved_Modal *save;
00486     save = new WXGC_PTRS MrEd_Saved_Modal;
00487 
00488     save->next = c->modal_stack;
00489     save->win = c->modal_window;
00490     c->modal_stack = save;
00491   }
00492 
00493   c->modal_window = win;
00494 }
00495 
00496 void wxPopModalWindow(wxObject *w, wxWindow *win)
00497 {
00498   MrEdContext *c;
00499   MrEd_Saved_Modal *save, *prev;
00500   c = MrEdGetContext(w);
00501 
00502   if (c->modal_window == win)
00503     c->modal_window = NULL;
00504 
00505   prev = NULL;
00506   for (save = c->modal_stack; save; save = save->next) {
00507     if ((save->win == win) || !c->modal_window) {
00508       if (prev)
00509        prev->next = save->next;
00510       else
00511        c->modal_stack = save->next;
00512 
00513       if (save->win != win)
00514        c->modal_window = save->win;
00515     } else
00516       prev = save;
00517   }
00518 }
00519 
00520 int wxGetBusyState(void)
00521 {
00522   MrEdContext *c;
00523   c = MrEdGetContext();
00524 
00525   return c->busyState;
00526 }
00527 
00528 void wxSetBusyState(int state)
00529 {
00530   MrEdContext *c;
00531   c = MrEdGetContext();
00532 
00533   c->busyState = state;
00534 }
00535 
00536 extern int MrEdGetDoubleTime(void);
00537 static int doubleClickThreshold = -1;
00538 
00539 int wxMrEdGetDoubleTime(void)
00540 {
00541   if (doubleClickThreshold < 0) {
00542     if (!wxGetPreference("doubleClickTime", &doubleClickThreshold)) {
00543       doubleClickThreshold = MrEdGetDoubleTime();
00544     }
00545   }
00546 
00547   return doubleClickThreshold;
00548 }
00549 
00550 #ifdef wx_xt
00551 /* For widgets: */
00552 extern "C" {
00553   int wxGetMultiClickTime(Display *d)
00554   {
00555     return wxMrEdGetDoubleTime();
00556   }
00557 }
00558 #endif
00559 
00560 Bool wxIsPrimEventspace()
00561 {
00562   return MrEdGetContext() == mred_main_context;
00563 }
00564 
00565 int wxIsUserMainEventspace(Scheme_Object *o)
00566 {
00567   return o == (Scheme_Object *)user_main_context;
00568 }
00569 
00570 int wxsIsContextShutdown(void *cx)
00571 {
00572   MrEdContext *c;
00573   c = (MrEdContext *)cx;
00574 
00575   return c->killed;
00576 }
00577 
00578 void *wxsCheckEventspace(char *who)
00579 {
00580   MrEdContext *c;
00581   c = (MrEdContext *)wxGetContextForFrame();
00582 
00583   if (c->killed)
00584     scheme_signal_error("%s: the current eventspace has been shutdown", who);
00585 
00586   return (void *)c;
00587 }
00588 
00589 static int ps_ready = 0;
00590 static wxPrintSetupData *orig_ps_setup;
00591 
00592 wxPrintSetupData *wxGetThePrintSetupData()
00593 {
00594   if (ps_ready) {
00595     Scheme_Object *o;
00596     o = scheme_get_param(scheme_current_config(), mred_ps_setup_param);
00597     if (o && SCHEME_TRUEP(o))
00598       return wxsUnbundlePSSetup(o);
00599   }
00600   return orig_ps_setup;
00601 }
00602 
00603 void wxSetThePrintSetupData(wxPrintSetupData *d)
00604 {
00605   if (ps_ready) {
00606     Scheme_Object *o;
00607     o = wxsBundlePSSetup(d);
00608     scheme_set_param(scheme_current_config(), mred_ps_setup_param, o);
00609   }
00610   orig_ps_setup = d;
00611 }
00612 
00613 
00614 /* Forward decl: */
00615 static int MrEdSameContext(MrEdContext *c, MrEdContext *testc);
00616 
00617 static void destroy_wxObject(wxWindow *w, void *)
00618 {
00619   if (w->__gc_external) {
00620     objscheme_destroy(w, (Scheme_Object *)w->__gc_external);
00621     ((Scheme_Class_Object *)w->__gc_external)->primflag = -2; /* -2 => shutdown */
00622     w->__gc_external = NULL;
00623   }
00624 }
00625 
00626 static void kill_eventspace(Scheme_Object *ec, void *)
00627 {
00628   MrEdContext *c;
00629   c = WEAKIFIED(((Context_Custodian_Hop *)ec)->context);
00630 
00631   if (!c)
00632     return; /* must not have had any frames, timers, etc. */
00633 
00634   {
00635     wxClipboardClient *clipOwner;
00636     clipOwner = wxTheClipboard->GetClipboardClient();
00637     if (clipOwner && (clipOwner->context == c))
00638       wxTheClipboard->SetClipboardString("", 0);
00639   }
00640 
00641   c->killed = 1;
00642 
00643   {
00644     wxChildNode *node, *next;
00645     for (node = c->topLevelWindowList->First(); node; node = next) {
00646       wxWindow *w;
00647       w = (wxWindow *)node->Data();
00648       next = node->Next();
00649       if (w) {
00650        w->ForEach(destroy_wxObject, NULL);
00651        if (node->IsShown())
00652          w->Show(FALSE);
00653       }
00654     }
00655   }
00656 
00657   {
00658     wxTimer *t;
00659     while (c->timers) {
00660       t = c->timers;
00661       t->Stop();
00662     }
00663   }
00664 
00665   remove_q_callbacks(c);
00666 }
00667 
00668 static Scheme_Object *extract_eventspace_from_hop(Scheme_Object *ec)
00669 {
00670   return (Scheme_Object *)WEAKIFIED(((Context_Custodian_Hop *)ec)->context);
00671 }
00672 
00673 static void CollectingContext(void *cfx, void *)
00674 {
00675   wxChildNode *cnode, *next;
00676   MrEdFinalizedContext *cf;
00677   cf = (MrEdFinalizedContext *)gcPTR_TO_OBJ(cfx);
00678 
00679   if (cf->frames->next)
00680     FRAMES_REF(cf->frames->next)->prev = cf->frames->prev;
00681   if (cf->frames->prev)
00682     FRAMES_REF(cf->frames->prev)->next = cf->frames->next;
00683   else
00684     mred_frames = cf->frames->next;
00685 
00686   cf->frames->next = NULL;
00687   cf->frames->prev = NULL;
00688 
00689   /* Must explicitly delete frames now because their context
00690      is going away. (The frame would certainly have been finalized
00691      later during this set of finalizations, but that would be
00692      too late.) */
00693   for (cnode = cf->frames->list->First(); cnode; cnode = next) {
00694     wxFrame *fr;
00695     next = cnode->Next();
00696     fr = (wxFrame *)cnode->Data();
00697     if (fr) {
00698       DELETE_OBJ fr;
00699     }
00700   }
00701 
00702   MrEdDestroyContext(cf);
00703 
00704   DELETE_OBJ cf->frames->list;
00705   cf->frames = NULL;
00706 }
00707 
00708 static MrEdContext *MakeContext(MrEdContext *c)
00709 {
00710   MrEdContextFrames *frames;
00711   Context_Custodian_Hop *mr_hop;
00712   Scheme_Object *break_cell;
00713   Scheme_Config *config;
00714   Scheme_Thread_Cell_Table *cells;
00715 
00716   scheme_custodian_check_available(NULL, "make-eventspace", "eventspace");
00717 
00718   if (!c) {
00719     wxChildList *tlwl;
00720     MrEdFinalizedContext *fc;
00721 
00722     c = (MrEdContext *)scheme_malloc_tagged(sizeof(MrEdContext));
00723     c->so.type = mred_eventspace_type;
00724 
00725     tlwl = new WXGC_PTRS wxChildList();
00726     c->topLevelWindowList = tlwl;
00727     fc = new WXGC_PTRS MrEdFinalizedContext;
00728     c->finalized = fc;
00729   }
00730 
00731   c->ready = 1;
00732 
00733   c->handler_running = NULL;
00734 
00735   c->busyState = 0;
00736   c->killed = 0;
00737 
00738   frames = new WXGC_PTRS MrEdContextFrames;
00739   c->finalized->frames = frames;
00740   frames->next = mred_frames;
00741   frames->prev = NULL;
00742   frames->list = c->topLevelWindowList;
00743   {
00744     MrEdContextFramesRef r;
00745     r = MAKE_FRAMES_REF(frames);
00746     if (mred_frames)
00747       FRAMES_REF(mred_frames)->prev = r;
00748     mred_frames = r;
00749   }
00750 
00751   c->modal_window = NULL;
00752 
00753   config = scheme_extend_config(scheme_current_config(), 
00754                             mred_eventspace_param, 
00755                             (Scheme_Object *)c);
00756 
00757   c->main_config = config;
00758   cells = scheme_inherit_cells(NULL);
00759   c->main_cells = cells;
00760   break_cell = scheme_current_break_cell();
00761   c->main_break_cell = break_cell;
00762 
00763 #ifdef MZ_PRECISE_GC
00764   /* Override destructor-based finalizer: */
00765   GC_set_finalizer(gcOBJ_TO_PTR(c->finalized),
00766                  0, 3,
00767                  CollectingContext, NULL,
00768                  NULL, NULL);
00769 #else
00770   scheme_register_finalizer(gcOBJ_TO_PTR(c->finalized),
00771                          CAST_GCP CollectingContext, NULL,
00772                          NULL, NULL);
00773 #endif
00774   WXGC_IGNORE(c, c->finalized);
00775 
00776 #ifdef MZ_PRECISE_GC
00777   mr_hop = (Context_Custodian_Hop *)GC_malloc_one_tagged(sizeof(Context_Custodian_Hop));
00778 #else
00779   mr_hop = (Context_Custodian_Hop *)scheme_malloc_atomic(sizeof(Context_Custodian_Hop));
00780 #endif
00781   mr_hop->so.type = mred_eventspace_hop_type;
00782   {
00783     MrEdContext *ctx;
00784     ctx = WEAKIFY(c);
00785     mr_hop->context = ctx;
00786   }
00787   c->mr_hop = mr_hop;
00788 #ifndef MZ_PRECISE_GC
00789   scheme_weak_reference((void **)(void *)&mr_hop->context);
00790 #endif
00791 
00792   {
00793     Scheme_Custodian_Reference *mr;
00794     mr = scheme_add_managed(NULL, (Scheme_Object *)mr_hop,
00795                          CAST_SCCC kill_eventspace,
00796                          NULL, 0);
00797     c->mref = mr;
00798   }
00799 
00800   return c;
00801 }
00802 
00803 static void ChainContextsList()
00804 {
00805   MrEdContextFrames *f;
00806   MrEdContextFramesRef fr = mred_frames;
00807   wxChildNode *first;
00808 
00809   mred_contexts = NULL;
00810 
00811   while (fr) {
00812     f = FRAMES_REF(fr);
00813     first = f->list->First();
00814 
00815 #if 0
00816     while (first && !first->IsShown())
00817       first = first->Next();
00818 #endif
00819 
00820     if (first) {
00821       wxObject *o;
00822       MrEdContext *c;
00823       o = first->Data();
00824       c = MrEdGetContext(o);
00825       c->next = mred_contexts;
00826       mred_contexts = c;
00827     }
00828     fr = f->next;
00829   }
00830 }
00831 
00832 static void UnchainContextsList()
00833 {
00834   while (mred_contexts) {
00835     MrEdContext *next = mred_contexts->next;
00836     mred_contexts->next = NULL;
00837     mred_contexts = next;
00838   }
00839 }
00840 
00841 static wxTimer *GlobalFirstTimer()
00842 {
00843   wxTimer *timer = NULL;
00844   int i;
00845   for (i = timer_contexts->size; i--; ) {
00846     if (timer_contexts->vals[i]) {
00847       MrEdContext *c = (MrEdContext *)timer_contexts->keys[i];
00848       if (c->ready && c->timers) {
00849         if (!timer)
00850           timer = c->timers;
00851         else if (c->timers->expiration < timer->expiration)
00852           timer = c->timers;
00853       }
00854     }
00855   }
00856   return timer;
00857 }
00858 
00859 #ifdef wx_xt
00860 void wxUnhideAllCursors()
00861 {
00862   MrEdContextFrames *f;
00863   MrEdContextFramesRef fr = mred_frames;
00864   wxChildNode *first;
00865   int v;
00866 
00867   if (wxCheckHiddenCursors()) {
00868     while (fr) {
00869       f = FRAMES_REF(fr);
00870       first = f->list->First();
00871       
00872       if (first) {
00873        wxObject *o;
00874        MrEdContext *c;
00875        o = first->Data();
00876        c = MrEdGetContext(o);
00877        v = wxUnhideCursorInFrame(o, c->busyState);
00878        c->busyState = v;
00879       }
00880       fr = f->next;
00881     }
00882   }
00883 }
00884 #endif
00885 
00886 Scheme_Object *MrEdMakeEventspace()
00887 {
00888   MrEdContext *c;
00889 
00890   c = MakeContext(NULL);
00891 
00892   MrEdInitNewContext(c);
00893 
00894   return (Scheme_Object *)c;
00895 }
00896 
00897 Scheme_Object *MrEdEventspaceThread(Scheme_Object *e)
00898 {
00899   return (Scheme_Object *)((MrEdContext *)e)->handler_running;
00900 }
00901 
00902 Scheme_Object *MrEdGetFrameList(void)
00903 {
00904   MrEdContext *c;
00905   Scheme_Object *l = scheme_null;
00906   c = MrEdGetContext();
00907 
00908   if (c) {
00909     wxChildNode *node;
00910     for (node = c->topLevelWindowList->First(); node; node = node->Next()) {
00911       wxObject *o;
00912       o = node->Data();
00913       if (node->IsShown()) {
00914 #ifdef wx_mac
00915        /* Mac: some frames really represent dialogs. Any modal frame is
00916           a dialog, so extract its only child. */
00917        if (((wxFrame *)o)->IsModal()) {
00918          wxChildNode *node2;
00919          wxChildList *cl;
00920          cl = ((wxFrame *)o)->GetChildren();
00921          node2 = cl->First();
00922          if (node2)
00923            o = node2->Data();
00924        }
00925 #endif
00926        l = scheme_make_pair(objscheme_bundle_wxObject(o), l);
00927       }
00928     }
00929   }
00930 
00931   return l;
00932 }
00933 
00934 void *MrEdForEachFrame(ForEachFrameProc fp, void *data)
00935 {
00936   MrEdContextFrames *f;
00937   MrEdContextFramesRef fr = mred_frames;
00938   wxChildNode *node;
00939 
00940   while (fr) {
00941     f = FRAMES_REF(fr);
00942     node = f->list->First();
00943 
00944     while (node) {
00945       if (node->IsShown()) {
00946        wxObject *o;
00947        o = node->Data();
00948 #ifdef wx_mac
00949        /* Mac: some frames really represent dialogs. Any modal frame is
00950           a dialog, so extract its only child. */
00951        if (((wxFrame *)o)->IsModal()) {
00952          wxChildNode *node2;
00953          wxChildList *cl;
00954          cl = ((wxFrame *)o)->GetChildren();
00955          node2 = cl->First();
00956          if (node2)
00957            o = node2->Data();
00958        }
00959 #endif
00960        data = fp(o, data);
00961       }
00962       node = node->Next();
00963     }
00964 
00965     fr = f->next;
00966   }
00967 
00968   return data;
00969 }
00970 
00971 static int check_eventspace_inactive(void *_c)
00972 {
00973   MrEdContext *c = (MrEdContext *)_c;
00974 
00975   if (c->nested_avail)
00976     return 0;
00977 
00978   /* Any callbacks prepared for this eventspace? */
00979   if (check_q_callbacks(0, MrEdSameContext, c, 1)
00980       || check_q_callbacks(1, MrEdSameContext, c, 1)
00981       || check_q_callbacks(2, MrEdSameContext, c, 1))
00982     return 0;
00983 
00984   /* Any running timers for the eventspace? */
00985   if (c->timers)
00986     return 0;
00987 
00988   /* Any top-level windows visible in this eventspace */
00989   {
00990     MrEdContextFrames *f = c->finalized->frames;
00991     wxChildNode *node;
00992 
00993     node = f->list->First();
00994 
00995     while (node) {
00996       if (node->IsShown()) {
00997        return 0;
00998       }
00999       node = node->Next();
01000     }
01001   }
01002 
01003   return 1;
01004 }
01005 
01006 void mred_wait_eventspace(void)
01007 {
01008   MrEdContext *c;
01009   Scheme_Thread *thread;
01010   c = MrEdGetContext();
01011   thread = scheme_get_current_thread();
01012   if (c && (c->handler_running == thread)) {
01013     wxDispatchEventsUntilWaitable(check_eventspace_inactive, c, NULL);
01014   }
01015 }
01016 
01017 int mred_current_thread_is_handler(void *ctx)
01018 {
01019   Scheme_Thread *thread;
01020   thread = scheme_get_current_thread();
01021 
01022   if (!ctx)
01023     ctx = MrEdGetContext();
01024 
01025   return (((MrEdContext *)ctx)->handler_running == thread);
01026 }
01027 
01028 int mred_in_restricted_context()
01029 {
01030 #ifdef NEED_HET_PARAM
01031   /* see wxHiEventTrampoline for info on mred_het_key: */
01032   Scheme_Object *v;
01033   if (!scheme_get_current_thread()) 
01034     return 1;
01035   
01036   if (mred_het_key)
01037     v = scheme_extract_one_cc_mark(NULL, mred_het_key);
01038   else
01039     v = NULL;
01040 
01041   if (v && SCHEME_BOX_VAL(v))
01042     return 1;
01043 #endif
01044   return 0;
01045 }
01046 
01047 /****************************************************************************/
01048 /*                               Events                                     */
01049 /****************************************************************************/
01050 
01051 static wxTimer *TimerReady(MrEdContext *c)
01052 {
01053   wxTimer *timer;
01054 
01055   if (c) {
01056     timer = c->timers;
01057   } else {
01058     timer = GlobalFirstTimer();
01059   }
01060 
01061   if (timer) {
01062     double now;
01063     double goal = timer->expiration;
01064 
01065     now = scheme_get_inexact_milliseconds();
01066 
01067     return ((now >= goal)
01068            ? timer
01069            : (wxTimer *)NULL);
01070   } else
01071     return NULL;
01072 }
01073 
01074 static void DoTimer(wxTimer *timer)
01075 {
01076   int once;
01077   mz_jmp_buf *save, newbuf;
01078   Scheme_Thread *thread;
01079   thread = scheme_get_current_thread();
01080 
01081   if (timer->interval == -1)
01082     return;
01083 
01084   once = timer->one_shot;
01085   timer->one_shot = -1;
01086 
01087   save = thread->error_buf;
01088   thread->error_buf = &newbuf;
01089   if (!scheme_setjmp(newbuf))
01090     timer->Notify();
01091   scheme_clear_escape();
01092   thread = scheme_get_current_thread();
01093   thread->error_buf = save;
01094   thread = NULL;
01095 
01096   if (!once && (timer->one_shot == -1) && (timer->interval != -1)
01097       && !((MrEdContext *)timer->context)->killed)
01098     timer->Start(timer->interval, FALSE);
01099 }
01100 
01101 static int do_check_for_nested_event(Scheme_Object *cx)
01102 {
01103   MrEdContext *c = (MrEdContext *)cx;
01104 
01105   if (!c->waiting_for_nested)
01106     return 1;
01107 
01108   if (c->alternate) {
01109     if (c->alternate(c->alt_data))
01110       return 1;
01111 
01112     return 0;
01113   } else
01114     return 0;
01115 }
01116 
01117 static int check_for_nested_event(Scheme_Object *cx)
01118 {
01119   return do_check_for_nested_event(((Nested_Wait *)cx)->wait_on);
01120 }
01121 
01122 static int MrEdSameContext(MrEdContext *c, MrEdContext *testc)
01123 {
01124   return (c == testc);
01125 }
01126 
01127 static void GoAhead(MrEdContext *c)
01128 {
01129   c->ready_to_go = 0;
01130 
01131   if (c->q_callback) {
01132     int hi = (c->q_callback - 1);
01133     c->q_callback = 0;
01134     (void)check_q_callbacks(hi, MrEdSameContext, c, 0);
01135   } else if (c->timer) {
01136     wxTimer *timer;
01137     timer = c->timer;
01138     c->timer = NULL;
01139     DoTimer(timer);
01140   } else {
01141     GC_CAN_IGNORE MrEdEvent e;
01142     mz_jmp_buf *save, newbuf;
01143     Scheme_Thread *thread;
01144     thread = scheme_get_current_thread();
01145 
01146     memcpy(&e, &c->event, sizeof(MrEdEvent));
01147 
01148     save = thread->error_buf;
01149     thread->error_buf = &newbuf;
01150     if (!scheme_setjmp(newbuf))
01151       MrEdDispatchEvent(&e);
01152     scheme_clear_escape();
01153     thread = scheme_get_current_thread();
01154     thread->error_buf = save;
01155     thread = NULL;
01156   }
01157 }
01158 
01159 static Scheme_Object *def_event_dispatch_handler(int argc, Scheme_Object *argv[])
01160 {
01161   MrEdContext *c;
01162 
01163   c = (MrEdContext *)argv[0];
01164   if (!SAME_TYPE(SCHEME_TYPE(argv[0]), mred_eventspace_type)
01165       || !c->ready_to_go) {
01166     scheme_wrong_type("default-event-dispatch-handler",
01167                     "eventspace (with ready event)",
01168                     0, argc, argv);
01169     return NULL;
01170   }
01171 
01172   GoAhead(c);
01173 
01174   return scheme_void;
01175 }
01176 
01177 static void DoTheEvent(MrEdContext *c)
01178 {
01179   Scheme_Object *p;
01180 
01181   c->ready_to_go = 1;
01182 
01183   p = scheme_get_param(scheme_current_config(), mred_event_dispatch_param);
01184   if (p != def_dispatch) {
01185     Scheme_Object *a[1];
01186     mz_jmp_buf *save, newbuf;
01187     Scheme_Thread *thread;
01188     thread = scheme_get_current_thread();
01189 
01190     a[0] = (Scheme_Object *)c;
01191 
01192     save = thread->error_buf;
01193     thread->error_buf = &newbuf;
01194     if (!scheme_setjmp(newbuf))
01195       scheme_apply_multi(p, 1, a);
01196     scheme_clear_escape();
01197     thread = scheme_get_current_thread();
01198     thread->error_buf = save;
01199     thread = NULL;
01200 
01201 #if 0
01202     if (c->ready_to_go)
01203       printf("Bad dispatcher\n");
01204 #endif
01205   }
01206 
01207   if (c->ready_to_go)
01208     GoAhead(c);
01209 }
01210 
01211 static void reset_nested_wait(MrEdContext *c)
01212 {
01213   c->ready = 0;
01214   c->waiting_for_nested = 0;
01215   c->alternate = NULL;
01216   c->alt_data = NULL;
01217 }
01218 
01219 static Scheme_Object *MrEdDoNextEvent(MrEdContext *c, wxDispatch_Check_Fun alt, void *altdata, Scheme_Object *alt_wait)
01220 {
01221   wxTimer *timer;
01222   GC_CAN_IGNORE MrEdEvent evt;
01223   int restricted = 0;
01224 
01225 #ifdef NEED_HET_PARAM
01226   /* see wxHiEventTrampoline for info on mred_het_key: */
01227   if (mred_in_restricted_context())
01228     restricted = 1;
01229 #endif
01230 
01231   if (alt) {
01232     if (alt(altdata)) {
01233       /* Do nothing, since alt fired. */
01234       return scheme_void;
01235     }
01236   }
01237   if (alt_wait) {
01238     Scheme_Object *a[2], *r;
01239     a[0] = scheme_make_integer(0);
01240     a[1] = alt_wait;
01241     r = scheme_sync_timeout(2, a);
01242 
01243     if (r) {
01244       /* Do nothing, since alt fired. */
01245       return r;
01246     }
01247   }
01248 
01249   if (c->nested_avail) {
01250     c->nested_avail = 0;
01251     DoTheEvent(c);
01252   } else if (check_q_callbacks(2, MrEdSameContext, c, 1)) {
01253     c->q_callback = 3;
01254     DoTheEvent(c);
01255   } else if ((timer = TimerReady(c))) {
01256     timer->Dequeue();
01257     c->timer = timer;
01258     DoTheEvent(c);
01259   } else if (check_q_callbacks(1, MrEdSameContext, c, 1)) {
01260     c->q_callback = 2;
01261     DoTheEvent(c);
01262   } else if (!restricted && MrEdGetNextEvent(0, 1, &evt, NULL)) {
01263     memcpy(&c->event, &evt, sizeof(MrEdEvent));
01264     DoTheEvent(c);
01265 #ifdef wx_mac
01266     /* MrEdGetNextEvent might enqueue */
01267   } else if (check_q_callbacks(1, MrEdSameContext, c, 1)) {
01268     c->q_callback = 2;
01269     DoTheEvent(c);
01270 #endif
01271   } else if (!restricted && check_q_callbacks(0, MrEdSameContext, c, 1)) {
01272     c->q_callback = 1;
01273     DoTheEvent(c);
01274   } else if (c != mred_main_context) {
01275     Scheme_Object *result = NULL;
01276 
01277     c->ready = 1;
01278     c->waiting_for_nested = 1;
01279 
01280     c->alternate = alt;
01281     c->alt_data = altdata;
01282 
01283     if (alt_wait) {
01284       Nested_Wait *nw;
01285       Scheme_Object *a[2], *v = NULL;
01286 
01287       nw = (Nested_Wait *)scheme_malloc_tagged(sizeof(Nested_Wait));
01288       nw->so.type = mred_nested_wait_type;
01289       nw->wait_on = (Scheme_Object *)c;
01290 
01291       a[0] = alt_wait;
01292       a[1] = (Scheme_Object *)nw;
01293 
01294       /* Running arbitrary Scheme code here. */
01295       BEGIN_ESCAPEABLE(reset_nested_wait, c);
01296       v = scheme_sync(2, a);
01297       END_ESCAPEABLE();
01298 
01299       if (!SAME_OBJ(v, a[1]))
01300        result = v;
01301     } else {
01302       scheme_block_until((Scheme_Ready_Fun)do_check_for_nested_event, NULL,
01303                       (Scheme_Object *)c, 0.0);
01304     }
01305 
01306     c->alternate = NULL;
01307     c->alt_data = NULL;
01308 
01309     if (c->waiting_for_nested) {
01310       /* Alternate condition fired. Clear waiting flag. */
01311       c->ready = 0;
01312       c->waiting_for_nested = 0;
01313       if (!result)
01314        result = scheme_void;
01315     }
01316 
01317     return result;
01318   }
01319 
01320   return NULL;
01321 }
01322 
01323 void wxDoNextEvent()
01324 {
01325   MrEdContext *c;
01326   Scheme_Thread *thread;
01327   c = MrEdGetContext();
01328   thread = scheme_get_current_thread();
01329 
01330   if (!c->ready_to_go)
01331     if (c->handler_running == thread)
01332       MrEdDoNextEvent(c, NULL, NULL, NULL);
01333 }
01334 
01335 int MrEdEventReady(MrEdContext *c)
01336 {
01337   int restricted = 0;
01338 
01339 #ifdef NEED_HET_PARAM
01340   /* see wxHiEventTrampoline for info on mred_het_key: */
01341   if (mred_in_restricted_context())
01342     restricted = 1;
01343 #endif
01344 
01345   return (c->nested_avail
01346          || TimerReady(c)
01347          || (!restricted && MrEdGetNextEvent(1, 1, NULL, NULL))
01348          || (!restricted && check_q_callbacks(2, MrEdSameContext, c, 1))
01349          || check_q_callbacks(1, MrEdSameContext, c, 1)
01350          || check_q_callbacks(0, MrEdSameContext, c, 1));
01351 }
01352 
01353 int wxEventReady()
01354 {
01355   MrEdContext *c;
01356   Scheme_Thread *thread;
01357   c = MrEdGetContext();
01358   thread = scheme_get_current_thread();
01359 
01360   return (!c->ready_to_go
01361          && (c->handler_running == thread)
01362          && MrEdEventReady(c));
01363 }
01364 
01365 static void WaitForAnEvent_OrDie(MrEdContext *c)
01366 {
01367   c->ready = 1;
01368   c->waiting_for_nested = 1;
01369   c->alternate = NULL;
01370   c->alt_data = NULL;
01371 
01372   /* Suspend the thread. If another event is found for the eventspace, the
01373      thread will be resumed. */
01374   c->suspended = 1;
01375   while (1) {
01376     scheme_weak_suspend_thread(c->handler_running); /* suspend self */
01377 
01378     if (c->waiting_for_nested) {
01379       /* we were resumed for a break signal, or some such: */
01380       c->suspended = 0;
01381       c->ready = 0;
01382       c->waiting_for_nested = 0;
01383 
01384       scheme_thread_block(0);
01385       scheme_set_current_thread_ran_some();
01386 
01387       /* Go back to sleep: */
01388       c->ready = 1;
01389       c->waiting_for_nested = 1;
01390       c->suspended = 1;
01391     } else
01392       break;
01393   }
01394 
01395   /* An event has been found. Do it. */
01396   c->nested_avail = 0;
01397   DoTheEvent(c);
01398 
01399   /* Return to loop and look for more events... */
01400 }
01401 
01402 static void on_handler_killed(Scheme_Thread *p)
01403 {
01404   MrEdContext *c = (MrEdContext *)p->kill_data;
01405 
01406   p->on_kill = NULL;
01407   p->kill_data = NULL;
01408 
01409   /* The thread is forever not ready: */
01410   c->handler_running = NULL;
01411   c->ready = 0;
01412   c->waiting_for_nested = 0;
01413   c->nested_avail = 0;
01414   c->q_callback = 0;
01415   c->timer = NULL;
01416   c->alternate = NULL;
01417   c->alt_data = NULL;
01418   c->ready_to_go = 0;
01419 }
01420 
01421 static Scheme_Object *handle_events(void *cx, int, Scheme_Object **)
01422 {
01423   MrEdContext *c = (MrEdContext *)cx;
01424   Scheme_Thread *this_thread;
01425   mz_jmp_buf newbuf;
01426 
01427 #if SGC_STD_DEBUGGING
01428   fprintf(stderr, "new thread\n");
01429 #endif
01430 
01431   this_thread = scheme_get_current_thread();
01432   if (!this_thread->name) {
01433     Scheme_Object *tn;
01434     tn = scheme_intern_symbol("handler");
01435     this_thread->name = tn;
01436   }
01437   c->handler_running = this_thread;
01438   this_thread->on_kill = CAST_TOK on_handler_killed;
01439   this_thread->kill_data = c;
01440   c->suspended = 0;
01441   c->ready = 0;
01442 
01443   this_thread->error_buf = &newbuf;
01444   if (!scheme_setjmp(newbuf)) {
01445     if (!TheMrEdApp->initialized)
01446       TheMrEdApp->RealInit();
01447     else {
01448       DoTheEvent(c);
01449 
01450       while(1) {
01451        while (MrEdEventReady(c)) {
01452          MrEdDoNextEvent(c, NULL, NULL, NULL);
01453        }
01454 
01455        WaitForAnEvent_OrDie(c);
01456       }
01457     }
01458   }
01459 
01460   /* We should never get here. */
01461 #if 0
01462   c->ready = 1;
01463   c->handler_running = NULL;
01464   this_thread->on_kill = NULL;
01465   this_thread->kill_data = NULL;
01466 #endif
01467 
01468   return scheme_void;
01469 }
01470 
01471 static int MrEdContextReady(MrEdContext *, MrEdContext *c)
01472 {
01473   return ((MrEdContext *)c)->ready;
01474 }
01475 
01476 static void event_found(MrEdContext *c)
01477 {
01478   if (c->killed)
01479     return;
01480 
01481   c->ready = 0;
01482 
01483   if (c->waiting_for_nested) {
01484     c->waiting_for_nested = 0;
01485     c->nested_avail = 1;
01486     if (c->suspended) {
01487       c->suspended = 0;
01488       scheme_weak_resume_thread(c->handler_running);
01489     }
01490   } else {
01491     Scheme_Object *cp, *cust;
01492 
01493     cp = scheme_make_closed_prim(CAST_SCP handle_events, c);
01494     cust = scheme_get_thread_param(c->main_config, c->main_cells, MZCONFIG_CUSTODIAN);
01495     scheme_thread_w_details(cp, c->main_config, c->main_cells, c->main_break_cell, (Scheme_Custodian *)cust, 0);
01496   }
01497 }
01498 
01499 static int try_q_callback(Scheme_Object *do_it, int hi)
01500 {
01501   MrEdContext *c;
01502 
01503   if ((c = check_q_callbacks(hi, MrEdContextReady, NULL, 1))) {
01504     if (!do_it)
01505       return 1;
01506 
01507     if (SCHEME_FALSEP(do_it))
01508       scheme_set_current_thread_ran_some();
01509 
01510     if (c == mred_main_context)
01511       check_q_callbacks(hi, MrEdSameContext, c, 0);
01512     else {
01513       c->q_callback = 1 + hi;
01514       event_found(c);
01515     }
01516 
01517     return 1;
01518   }
01519 
01520   return 0;
01521 }
01522 
01523 static int try_dispatch(Scheme_Object *do_it)
01524 {
01525   MrEdContext *c;
01526   GC_CAN_IGNORE MrEdEvent e;
01527   wxTimer *timer;
01528   int got_one;
01529 
01530   if (try_q_callback(do_it, 2))
01531     return 1;
01532 
01533   timer = TimerReady(NULL);
01534 
01535   if (timer) {
01536     if (!do_it)
01537       return 1;
01538     if (SCHEME_FALSEP(do_it))
01539       scheme_set_current_thread_ran_some();
01540 
01541     c = (MrEdContext *)timer->context;
01542 
01543     timer->Dequeue();
01544 
01545     if (c == mred_main_context)
01546       timer->Notify();
01547     else {
01548       c->timer = timer;
01549       event_found(c);
01550     }
01551 
01552     return 1;
01553   }
01554 
01555   if (try_q_callback(do_it, 1))
01556     return 1;
01557 
01558   ChainContextsList();
01559 
01560   got_one = MrEdGetNextEvent(!do_it, 0, &e, &c);
01561 
01562   UnchainContextsList();
01563 
01564 #ifdef wx_mac
01565   /* MrEdGetNextEvent might enqueue */
01566   if (try_q_callback(do_it, 1))
01567     return 1;
01568 #endif
01569 
01570   if (got_one) {
01571     if (!do_it)
01572       return 1;
01573 
01574     if (SCHEME_FALSEP(do_it))
01575       scheme_set_current_thread_ran_some();
01576 
01577     if (c) {
01578       memcpy(&c->event, &e, sizeof(MrEdEvent));
01579       event_found(c);
01580     } else {
01581       /* Event with unknown context: */
01582       MrEdDispatchEvent(&e);
01583     }
01584 
01585     return 1;
01586   }
01587 
01588   if (try_q_callback(do_it, 0))
01589     return 1;
01590 
01591   return 0;
01592 }
01593 
01594 static void wakeup_on_dispatch(Scheme_Object *, void *fds)
01595 {
01596 #ifdef wx_x
01597   Display *d = XtDisplay(mred_main_context->finalized->toplevel);
01598   int fd;
01599 
01600   fd = ConnectionNumber(d);
01601 
01602   MZ_FD_SET(fd, (fd_set *)fds);
01603 #endif
01604 }
01605 
01606 static int check_initialized(Scheme_Object *)
01607 {
01608   return TheMrEdApp->initialized;
01609 }
01610 
01611 # define KEEP_GOING wxTheApp->keep_going
01612 
01613 void wxDoEvents()
01614 {
01615   /* When we get here, we are in the main dispatcher thread */
01616   if (!TheMrEdApp->initialized) {
01617     MrEdContext *c;
01618 
01619     /* Create the user's main thread: */
01620 
01621     c = (MrEdContext *)MrEdMakeEventspace();
01622 
01623     wxREGGLOB(user_main_context);
01624     user_main_context = c;
01625 
01626     {
01627       Scheme_Object *cp;
01628       cp = scheme_make_closed_prim(CAST_SCP handle_events, c);
01629       wxREGGLOB(user_main_thread);
01630       user_main_thread = (Scheme_Thread *)scheme_thread_w_details(cp, 
01631                                                           c->main_config,
01632                                                           c->main_cells,
01633                                                           c->main_break_cell,
01634                                                           NULL, 0);
01635       scheme_set_break_main_target(user_main_thread);
01636       cp = scheme_intern_symbol("mred");
01637       user_main_thread->name = cp;
01638     }
01639 
01640     /* Block until the user's main thread is initialized: */
01641     scheme_block_until(CAST_BLKCHK check_initialized, NULL, NULL, 0.0);
01642   }
01643 
01644   if (!try_dispatch(scheme_true)) {
01645     do {
01646       Scheme_Thread *thread;
01647       thread = scheme_get_current_thread();
01648       thread->block_descriptor = -1;
01649       thread->blocker = NULL;
01650       thread->block_check = CAST_BLKCHK try_dispatch;
01651       thread->block_needs_wakeup = CAST_WU wakeup_on_dispatch;
01652 
01653       scheme_thread_block(0);
01654 
01655       thread = scheme_get_current_thread();
01656       thread->block_descriptor = 0;
01657       /* Sets ran_some if it succeeds: */
01658       if (try_dispatch(scheme_false))
01659        break;
01660     } while (KEEP_GOING);
01661   }
01662 }
01663 
01664 Scheme_Object *wxDispatchEventsUntilWaitable(wxDispatch_Check_Fun f, void *data, Scheme_Object *w)
01665 {
01666   MrEdContext *c;
01667   Scheme_Object *result = scheme_void;
01668   Scheme_Thread *thread;
01669 
01670   c = MrEdGetContext();
01671 #ifdef wx_mac
01672   wxMouseEventHandled();
01673 #endif
01674 
01675   thread = scheme_get_current_thread();
01676   if (c->ready_to_go
01677       || (c->handler_running != thread)) {
01678     /* This is not the handler thread or an event still hasn't been
01679        dispatched. Wait. */
01680     if (w) {
01681       Scheme_Object *a[1];
01682       a[0] = w;
01683       result = scheme_sync(1, a);
01684     } else {
01685       scheme_block_until((Scheme_Ready_Fun)f, NULL, (Scheme_Object *)data, 0.0);
01686     }
01687   } else {
01688     /* This is the main thread. Handle events */
01689     do {
01690       result = MrEdDoNextEvent(c, f, data, w);
01691       if (result)
01692        break;
01693     } while (1);
01694   }
01695 
01696   return result;
01697 }
01698 
01699 void wxDispatchEventsUntil(wxDispatch_Check_Fun f, void *data)
01700 {
01701   wxDispatchEventsUntilWaitable(f, data, NULL);
01702 }
01703 
01704 void wxBlockUntil(wxDispatch_Check_Fun f, void *data)
01705 {
01706   scheme_block_until((Scheme_Ready_Fun)f, NULL, (Scheme_Object *)data, 0.0);
01707 }
01708 
01709 void wxBlockUntilTimeout(wxDispatch_Check_Fun f, void *data, float timeout)
01710 {
01711   scheme_block_until((Scheme_Ready_Fun)f, NULL, (Scheme_Object *)data, timeout);
01712 }
01713 
01714 static SLEEP_PROC_PTR mzsleep;
01715 
01716 static void MrEdSleep(float secs, void *fds)
01717 {
01718   double now;
01719 
01720 #ifdef NEVER_EVER_SLEEP
01721   return;
01722 #endif
01723 
01724   if (!(KEEP_GOING))
01725     return;
01726 
01727   now = scheme_get_inexact_milliseconds();
01728   {
01729     wxTimer *timer;
01730 
01731     timer = GlobalFirstTimer();
01732 
01733     if (timer) {
01734       double done = timer->expiration;
01735       double diff = done - now;
01736 
01737       diff /= 1000;
01738       if (diff <= 0)
01739        secs = (float)0.00001;
01740       else if (!secs || (secs > diff))
01741        secs = (float)diff;
01742     }
01743   }
01744 
01745 #ifdef wx_msw
01746   MrEdMSWSleep(secs, fds, mzsleep);
01747 #else
01748 # ifdef wx_mac
01749   MrEdMacSleep(secs, fds, mzsleep);
01750 # else
01751   mzsleep(secs, fds);
01752 # endif
01753 #endif
01754 }
01755 
01756 #ifdef mred_BREAK_HANDLER
01757 static void user_break_hit(int ignore)
01758 {
01759   scheme_break_main_thread();
01760   scheme_signal_received();
01761 
01762 #  ifdef SIGSET_NEEDS_REINSTALL
01763   MZ_SIGSET(SIGINT, user_break_hit);
01764 #  endif
01765 #  ifdef MZ_PRECISE_GC
01766 #   ifndef GC_STACK_CALLEE_RESTORE
01767   /* Restore variable stack. */
01768   GC_variable_stack = (void **)__gc_var_stack__[0];
01769 #   endif
01770 #  endif
01771 }
01772 #endif
01773 
01774 /****************************************************************************/
01775 /*                                wxTimer                                   */
01776 /****************************************************************************/
01777 
01778 wxTimer::wxTimer(void *ctx)
01779 #ifdef wx_xt
01780  : wxObject(WXGC_NO_CLEANUP)
01781 #endif
01782 {
01783   __type = wxTYPE_TIMER;
01784 
01785   next = prev = NULL;
01786 
01787   if (!ctx)
01788     ctx = (void *)MrEdGetContext();
01789 
01790   context = ctx;
01791 }
01792 
01793 wxTimer::~wxTimer(void)
01794 {
01795 }
01796 
01797 void wxTimer::SetContext(void *ctx)
01798 {
01799   context = ctx;
01800 }
01801 
01802 Bool wxTimer::Start(int millisec, Bool _one_shot)
01803 {
01804   double now;
01805 
01806   if (prev || next || (((MrEdContext *)context)->timers == this))
01807     return FALSE;
01808 
01809   if (((MrEdContext *)context)->killed)
01810     scheme_signal_error("start in timer%%: the current eventspace has been shutdown");
01811   
01812   interval = millisec;
01813   if (interval <= 0)
01814     interval = 1;
01815   one_shot = !!_one_shot;
01816 
01817   now = scheme_get_inexact_milliseconds();
01818   expiration = now + interval;
01819 
01820   if (((MrEdContext *)context)->timers) {
01821     wxTimer *t = ((MrEdContext *)context)->timers;
01822 
01823     while (1) {
01824       int later;
01825 
01826       later = (expiration >= t->expiration);
01827 
01828       if (!later) {
01829        prev = t->prev;
01830        t->prev = this;
01831        next = t;
01832        if (prev)
01833          prev->next = this;
01834        else
01835          ((MrEdContext *)context)->timers = this;
01836        return TRUE;
01837       }
01838 
01839       if (!t->next) {
01840        t->next = this;
01841        prev = t;
01842 
01843        return TRUE;
01844       }
01845       t = t->next;
01846     }
01847   } else {
01848     ((MrEdContext *)context)->timers = this;
01849     scheme_hash_set(timer_contexts, (Scheme_Object *)context, scheme_true);
01850   }
01851 
01852   return TRUE;
01853 }
01854 
01855 void wxTimer::Dequeue(void)
01856 {
01857   if (!prev) {
01858     if (((MrEdContext *)context)->timers == this) {
01859       ((MrEdContext *)context)->timers = next;
01860       if (!next)
01861         scheme_hash_set(timer_contexts, (Scheme_Object *)context, NULL);
01862     }
01863   }
01864 
01865   if (prev)
01866     prev->next = next;
01867   if (next)
01868     next->prev = prev;
01869 
01870   next = prev = NULL;
01871 }
01872 
01873 void wxTimer::Stop(void)
01874 {
01875   Dequeue();
01876 
01877   interval = -1;
01878 }
01879 
01880 /****************************************************************************/
01881 /*                               Callbacks                                  */
01882 /****************************************************************************/
01883 
01884 typedef struct Q_Callback {
01885   /* MZ_PRECISE_GC: allocation relies on this struct as the same as
01886      array of pointers: */
01887   MrEdContext *context;
01888   Scheme_Object *callback;
01889   struct Q_Callback *prev;
01890   struct Q_Callback *next;
01891 } Q_Callback;
01892 
01893 typedef struct {
01894   /* Collection relies on this struct as the same as array of
01895      pointers: */
01896   Q_Callback *first;
01897   Q_Callback *last;
01898 } Q_Callback_Set;
01899 
01900 static Q_Callback_Set q_callbacks[3];
01901 
01902 static void insert_q_callback(Q_Callback_Set *cs, Q_Callback *cb)
01903 {
01904   /* This can happen under Windows, for example,
01905      due to an on-paint queue attempt: */
01906   if (cb->context->killed)
01907     return;
01908 
01909   cb->next = NULL;
01910   cb->prev = cs->last;
01911   cs->last = cb;
01912   if (cb->prev)
01913     cb->prev->next = cb;
01914   else
01915     cs->first = cb;
01916 }
01917 
01918 static void remove_q_callback(Q_Callback_Set *cs, Q_Callback *cb)
01919 {
01920   if (cb->prev)
01921     cb->prev->next = cb->next;
01922   else
01923     cs->first = cb->next;
01924   if (cb->next)
01925     cb->next->prev = cb->prev;
01926   else
01927     cs->last = cb->prev;
01928 
01929   cb->next = NULL;
01930   cb->prev = NULL;
01931 }
01932 
01933 static void call_one_callback(Q_Callback * volatile  cb)
01934 {
01935   mz_jmp_buf *save, newbuf;
01936   Scheme_Thread *thread;
01937   thread = scheme_get_current_thread();
01938 
01939   save = thread->error_buf;
01940   thread->error_buf = &newbuf;
01941   if (!scheme_setjmp(newbuf))
01942     scheme_apply_multi(cb->callback, 0, NULL);
01943   scheme_clear_escape();
01944   thread = scheme_get_current_thread();
01945   thread->error_buf = save;
01946 }
01947 
01948 static MrEdContext *check_q_callbacks(int hi, int (*test)(MrEdContext *, MrEdContext *),
01949                                   MrEdContext *tdata, int check_only)
01950 {
01951   Q_Callback_Set *cs = q_callbacks + hi;
01952   Q_Callback *cb;
01953 
01954   cb = cs->first;
01955   while (cb) {
01956     if (test(tdata, cb->context)) {
01957       if (check_only)
01958        return cb->context;
01959 
01960       remove_q_callback(cs, cb);
01961 
01962       call_one_callback(cb);
01963 
01964       return cb->context;
01965     }
01966     cb = cb->next;
01967   }
01968 
01969   return NULL;
01970 }
01971 
01972 static void remove_q_callbacks(MrEdContext *c)
01973 {
01974   Q_Callback_Set *cs;
01975   Q_Callback *cb, *next;
01976   int i;
01977 
01978   for (i = 0; i < 3; i++) {
01979     cs = q_callbacks + i;
01980     for (cb = cs->first; cb; cb = next) {
01981       next = cb->next;
01982       if (cb->context == c)
01983        remove_q_callback(cs, cb);
01984     }
01985   }
01986 }
01987 
01988 Scheme_Object *MrEd_mid_queue_key;
01989 
01990 void MrEd_add_q_callback(char *who, int argc, Scheme_Object **argv)
01991 {
01992   MrEdContext *c;
01993   Q_Callback_Set *cs;
01994   Q_Callback *cb;
01995   int hi;
01996 
01997   scheme_check_proc_arity(who, 0, 0, argc, argv);
01998   c = (MrEdContext *)wxsCheckEventspace("queue-callback");
01999 
02000   if (argc > 1) {
02001     if (argv[1] == MrEd_mid_queue_key)
02002       hi = 1;
02003     else
02004       hi = (SCHEME_TRUEP(argv[1]) ? 2 : 0);
02005   } else
02006     hi = 2;
02007 
02008   cs = q_callbacks + hi;
02009 
02010   cb = (Q_Callback*)scheme_malloc(sizeof(Q_Callback));
02011   cb->context = c;
02012   cb->callback = argv[0];
02013 
02014   insert_q_callback(cs, cb);
02015 }
02016 
02017 #if defined(wx_msw) || defined(wx_mac)
02018 
02019 static void MrEdQueueWindowCallback(wxWindow *wx_window, Scheme_Closed_Prim *scp, void *data)
02020 {
02021   MrEdContext *c;
02022   Q_Callback *cb;
02023   Scheme_Object *p;
02024 
02025   if (!scheme_get_current_thread()) {
02026     /* Scheme hasn't started yet, so call directly.
02027        We might get here for an update to the stdio
02028        window, for example. */
02029     scp(data, 0, NULL);
02030     return;
02031   }
02032 
02033 #ifdef wx_mac
02034   c = MrEdGetContext(wx_window->GetRootFrame());
02035 #else
02036   c = MrEdGetContext();
02037 #endif
02038 
02039   /* Search for existing queued on-paint: */
02040   cb = q_callbacks[1].last;
02041   while (cb) {
02042     if (cb->context == c) {
02043       if (SCHEME_CLSD_PRIMP(cb->callback)) {
02044        Scheme_Closed_Primitive_Proc *prim;
02045        prim = (Scheme_Closed_Primitive_Proc *)cb->callback;
02046        if ((prim->data == wx_window)
02047            && (prim->prim_val == scp)) {
02048          /* on-paint already queued */
02049          return;
02050        }
02051       }
02052     }
02053     cb = cb->prev;
02054   }
02055 
02056   p = scheme_make_closed_prim(scp, data);
02057 
02058   cb = (Q_Callback*)scheme_malloc(sizeof(Q_Callback));
02059   cb->context = c;
02060   cb->callback = p;
02061 
02062   insert_q_callback(q_callbacks + 1, cb);
02063 
02064 #ifdef wx_mac
02065   WakeUpMrEd();
02066 #endif
02067 }
02068 
02069 static Scheme_Object *call_on_paint(void *d, int, Scheme_Object **argv)
02070 {
02071   wxWindow *w = (wxWindow *)d;
02072 
02073   ((wxCanvas *)w)->DoPaint();
02074 
02075   return scheme_void;
02076 }
02077 
02078 void MrEdQueuePaint(wxWindow *wx_window)
02079 {
02080   MrEdQueueWindowCallback(wx_window, CAST_SCP call_on_paint, wx_window);
02081 }
02082 
02083 static Scheme_Object *call_close(void *d, int, Scheme_Object **argv)
02084 {
02085   wxFrame *w = (wxFrame *)d;
02086 
02087   if (w->OnClose())
02088     w->Show(FALSE);
02089 
02090   return scheme_void;
02091 }
02092 
02093 void MrEdQueueClose(wxWindow *wx_window)
02094 {
02095   MrEdQueueWindowCallback(wx_window, CAST_SCP call_close, wx_window);
02096 }
02097 
02098 static Scheme_Object *call_zoom(void *d, int, Scheme_Object **argv)
02099 {
02100   wxFrame *w = (wxFrame *)d;
02101 
02102   w->Maximize(2);
02103 
02104   return scheme_void;
02105 }
02106 
02107 void MrEdQueueZoom(wxWindow *wx_window)
02108 {
02109   MrEdQueueWindowCallback(wx_window, CAST_SCP call_zoom, wx_window);
02110 }
02111 
02112 static Scheme_Object *call_toolbar(void *d, int, Scheme_Object **argv)
02113 {
02114   wxFrame *w = (wxFrame *)d;
02115 
02116   w->OnToolbarButton();
02117 
02118   return scheme_void;
02119 }
02120 
02121 void MrEdQueueToolbar(wxWindow *wx_window)
02122 {
02123   MrEdQueueWindowCallback(wx_window, CAST_SCP call_toolbar, wx_window);
02124 }
02125 
02126 static Scheme_Object *call_on_size(void *d, int, Scheme_Object **argv)
02127 {
02128   wxWindow *w = (wxWindow *)d;
02129   w->OnSize(-1, -1);
02130   return scheme_void;
02131 }
02132 
02133 void MrEdQueueOnSize(wxWindow *wx_window)
02134 {
02135   MrEdQueueWindowCallback(wx_window, CAST_SCP call_on_size, wx_window);
02136 }
02137 
02138 # ifdef wx_mac
02139 static Scheme_Object *call_unfocus(void *d, int, Scheme_Object **argv)
02140 {
02141   wxFrame *w = (wxFrame *)d;
02142   w->Unfocus();
02143   return scheme_void;
02144 }
02145 
02146 void MrEdQueueUnfocus(wxWindow *wx_window)
02147 {
02148   MrEdQueueWindowCallback(wx_window, CAST_SCP call_unfocus, wx_window);
02149 }
02150 
02151 static Scheme_Object *call_drop(void *d, int, Scheme_Object **argv)
02152 {
02153   wxWindow *w = (wxWindow *)SCHEME_CAR((Scheme_Object *)d);
02154   char *s = (char *)SCHEME_CDR((Scheme_Object *)d);
02155   w->OnDropFile(s);
02156   return scheme_void;
02157 }
02158 
02159 void MrEdQueueDrop(wxWindow *wx_window, char *s)
02160 {
02161   MrEdQueueWindowCallback(wx_window, CAST_SCP call_drop, 
02162                        scheme_make_pair((Scheme_Object *)wx_window, (Scheme_Object *)s));
02163 }
02164 # endif
02165 
02166 #endif
02167 
02168 static Scheme_Object *call_being_replaced(void *d, int, Scheme_Object **argv)
02169 {
02170   wxClipboardClient *clipOwner = (wxClipboardClient *)d;
02171   clipOwner->BeingReplaced();
02172   return scheme_void;
02173 }
02174 
02175 void MrEdQueueBeingReplaced(wxClipboardClient *clipOwner)
02176 {
02177   Scheme_Object *p;
02178   MrEdContext *c = (MrEdContext *)clipOwner->context;
02179   Q_Callback *cb;
02180 
02181   if (c) {
02182     clipOwner->context = NULL;
02183 
02184     p = scheme_make_closed_prim(CAST_SCP call_being_replaced, clipOwner);
02185 
02186     cb = (Q_Callback*)scheme_malloc(sizeof(Q_Callback));
02187     cb->context = c;
02188     cb->callback = p;
02189 
02190     insert_q_callback(q_callbacks + 1, cb);
02191   }
02192 }
02193 
02194 void MrEdQueueInEventspace(void *context, Scheme_Object *thunk)
02195 {
02196   Q_Callback *cb;
02197 
02198   cb = (Q_Callback*)scheme_malloc(sizeof(Q_Callback));
02199   cb->context = (MrEdContext *)context;
02200   cb->callback = thunk;
02201 
02202   insert_q_callback(q_callbacks + 1, cb);
02203 }
02204 
02205 /****************************************************************************/
02206 /*                        Redirected Standard I/O                           */
02207 /****************************************************************************/
02208 
02209 #if REDIRECT_STDIO || WCONSOLE_STDIO
02210 static void MrEdSchemeMessages(char *, ...);
02211 static Scheme_Object *stdin_pipe;
02212 #endif
02213 
02214 #if WCONSOLE_STDIO
02215 
02216 static HANDLE console_out;
02217 static HANDLE console_in;
02218 static Scheme_Object *console_inport;
02219 static HWND console_hwnd;
02220 static int has_stdio, stdio_kills_prog;
02221 static HANDLE waiting_sema;
02222 
02223 typedef HWND (WINAPI* gcw_proc)();
02224 
02225 static void init_console_in()
02226 {
02227   if (!console_in) {
02228     console_in = GetStdHandle(STD_INPUT_HANDLE);
02229     wxREGGLOB(console_inport);
02230     console_inport = scheme_make_fd_input_port((int)console_in, scheme_intern_symbol("stdin"), 0, 0);
02231   }
02232 }
02233 
02234 static BOOL WINAPI ConsoleHandler(DWORD op)
02235 {
02236   if (stdio_kills_prog) {
02237     ReleaseSemaphore(waiting_sema, 1, NULL);
02238   } else {
02239     scheme_break_main_thread();
02240     scheme_signal_received();
02241   }
02242   return TRUE;
02243 }
02244 
02245 static void WaitOnConsole()
02246 {
02247   DWORD wrote;
02248 
02249   stdio_kills_prog = 1;
02250   if (console_hwnd) {
02251     AppendMenu(GetSystemMenu(console_hwnd, FALSE), 
02252               MF_STRING,
02253               SC_CLOSE,
02254               "Close");
02255     /* Un-gray the close box: */
02256     RedrawWindow(console_hwnd, NULL, NULL, 
02257                RDW_FRAME | RDW_INVALIDATE | RDW_UPDATENOW);
02258   }
02259 
02260   WriteConsole(console_out, "\n[Exited. Close box or Ctrl-C closes the console.]\n", 51, &wrote, NULL);
02261 
02262   WaitForSingleObject(waiting_sema, INFINITE);
02263 }
02264 
02265 #else  /* !WCONSOLE_STDIO */
02266 
02267 #if REDIRECT_STDIO
02268 static FILE *mrerr = NULL;
02269 #else
02270 #define mrerr stderr
02271 #endif
02272 
02273 #endif /* WCONSOLE_STDIO */
02274 
02275 #if REDIRECT_STDIO || WCONSOLE_STDIO
02276 static void MrEdSchemeMessages(char *msg, ...)
02277 {
02278   GC_CAN_IGNORE va_list args;
02279   
02280   scheme_start_atomic();
02281 
02282   HIDE_FROM_XFORM(va_start(args, msg));
02283 
02284 #if WCONSOLE_STDIO
02285   if (!console_out) {
02286     AllocConsole();
02287     console_out = GetStdHandle(STD_OUTPUT_HANDLE);
02288 
02289     if (!wx_in_terminal) {
02290       has_stdio = 1;
02291       waiting_sema = CreateSemaphore(NULL, 0, 1, NULL);
02292       SetConsoleCtrlHandler(ConsoleHandler, TRUE);      
02293 
02294       {
02295        HMODULE hm;
02296        gcw_proc gcw;
02297 
02298        hm = LoadLibrary("kernel32.dll");
02299        if (hm)
02300          gcw = (gcw_proc)GetProcAddress(hm, "GetConsoleWindow");
02301        else
02302          gcw = NULL;
02303     
02304        if (gcw)
02305          console_hwnd = gcw();
02306       }
02307 
02308       if (console_hwnd) {
02309        EnableMenuItem(GetSystemMenu(console_hwnd, FALSE), SC_CLOSE,
02310                      MF_BYCOMMAND | MF_GRAYED);
02311        RemoveMenu(GetSystemMenu(console_hwnd, FALSE), SC_CLOSE, MF_BYCOMMAND);
02312       }
02313     }
02314   }
02315 #endif
02316 #if REDIRECT_STDIO
02317   if (!mrerr)
02318     mrerr = fopen("mrstderr.txt", "w");
02319   if (!mrerr) {
02320     scheme_end_atomic_no_swap();
02321     HIDE_FROM_XFORM(va_end(args));
02322     return;
02323   }
02324 #endif
02325 
02326 #if WCONSOLE_STDIO
02327   if (!msg) {
02328     char *s;
02329     long l, d;
02330     DWORD wrote;
02331 
02332     s = va_arg(args, char*);
02333     d = va_arg(args, long);
02334     l = va_arg(args, long);
02335 
02336     WriteConsole(console_out, s XFORM_OK_PLUS d, l, &wrote, NULL);
02337   } else {
02338     char *buffer;
02339     DWORD wrote;
02340     buffer = (char *)malloc(5 * strlen(msg));
02341     vsprintf(buffer, msg, args);
02342     WriteConsole(console_out, buffer, strlen(buffer), &wrote, NULL);
02343     free(buffer);
02344   }
02345 #endif
02346 #if !WCONSOLE_STDIO
02347   vfprintf(mrerr, msg, args);
02348   fflush(mrerr);
02349 #endif
02350 
02351   scheme_end_atomic_no_swap();
02352 
02353   HIDE_FROM_XFORM(va_end(args));
02354 }
02355 
02356 static void MrEdSchemeMessagesOutput(char *s, long l)
02357 {
02358   if (l)
02359     MrEdSchemeMessages(NULL, s, 0, l);
02360 }
02361 #endif
02362 
02363 #if REDIRECT_STDIO || WCONSOLE_STDIO
02364 
02365 static Scheme_Object *console_reading;
02366 
02367 static void add_console_reading()
02368 {
02369   Scheme_Thread *thread;
02370   thread = scheme_get_current_thread();
02371 
02372   if (!console_reading) {
02373     wxREGGLOB(console_reading);
02374     console_reading = scheme_null;
02375   }
02376 
02377   console_reading = scheme_make_pair((Scheme_Object *)thread,
02378                                  console_reading);
02379 }
02380 
02381 static void remove_console_reading()
02382 {
02383   Scheme_Object *p, *prev = NULL;
02384   Scheme_Thread *thread;
02385   thread = scheme_get_current_thread();
02386 
02387   if (!console_reading)
02388     return;
02389 
02390   p = console_reading;
02391   while (SCHEME_PAIRP(p)) {
02392     if (SAME_OBJ(SCHEME_CAR(p), (Scheme_Object *)thread)) {
02393       if (prev)
02394        SCHEME_CDR(prev) = SCHEME_CDR(p);
02395       else
02396        console_reading = SCHEME_CDR(p);
02397       return;
02398     }
02399     prev = p;
02400     p = SCHEME_CDR(p);
02401   }
02402 }
02403 
02404 static void break_console_reading_threads()
02405 {
02406   Scheme_Object *p;
02407 
02408   if (!console_reading)
02409     return;
02410 
02411   for (p = console_reading; SCHEME_PAIRP(p); p = SCHEME_CDR(p)) {
02412     scheme_break_thread((Scheme_Thread *)SCHEME_CAR(p));
02413   }
02414 }
02415 
02416 static long mrconsole_get_string(Scheme_Input_Port *ip,
02417                              char *buffer, long offset, long size,
02418                              int nonblock, Scheme_Object *unless)
02419 {
02420   long result;
02421   Scheme_Object *pipe = (Scheme_Object *)ip->port_data;
02422   MrEdSchemeMessages("");
02423 
02424 #if WCONSOLE_STDIO
02425   init_console_in();
02426   pipe = console_inport;
02427 #endif
02428 
02429   add_console_reading();
02430   result = scheme_get_byte_string_unless("console get-string", pipe, 
02431                                     buffer, offset, size, 
02432                                     nonblock, 0, NULL,
02433                                     unless);
02434   remove_console_reading();
02435   return result;
02436 }
02437 
02438 static Scheme_Object *mrconsole_progress_evt(Scheme_Input_Port *ip)
02439 {
02440   Scheme_Object *pipe = (Scheme_Object *)ip->port_data;
02441   MrEdSchemeMessages("");
02442 
02443 #if WCONSOLE_STDIO
02444   init_console_in();
02445   pipe = console_inport;
02446 #endif
02447 
02448   return scheme_progress_evt(pipe);
02449 }
02450 
02451 static int mrconsole_peeked_read(Scheme_Input_Port *ip,
02452                                        long amount,
02453                                        Scheme_Object *unless,
02454                                        Scheme_Object *target_ch)
02455 {
02456   Scheme_Object *pipe = (Scheme_Object *)ip->port_data;
02457   MrEdSchemeMessages("");
02458 
02459 #if WCONSOLE_STDIO
02460   init_console_in();
02461   pipe = console_inport;
02462 #endif
02463 
02464   return scheme_peeked_read(pipe, amount, unless, target_ch);
02465 }
02466 
02467 static int mrconsole_char_ready(Scheme_Input_Port *ip)
02468 {
02469   Scheme_Object *pipe = (Scheme_Object *)ip->port_data;
02470   MrEdSchemeMessages("");
02471 
02472 #if WCONSOLE_STDIO
02473   init_console_in();
02474   pipe = console_inport;
02475 #endif
02476 
02477   return scheme_char_ready(pipe);
02478 }
02479 
02480 static void mrconsole_close(Scheme_Input_Port *ip)
02481 {
02482   Scheme_Object *pipe = (Scheme_Object *)ip->port_data;
02483 #if WCONSOLE_STDIO
02484   init_console_in();
02485   pipe = console_inport;
02486 #endif
02487   scheme_close_input_port(pipe);
02488 }
02489 
02490 static Scheme_Object *MrEdMakeStdIn(void)
02491 {
02492   Scheme_Object *readp;
02493   Scheme_Input_Port *ip;
02494 
02495   wxREGGLOB(stdin_pipe);
02496 
02497   scheme_pipe(&readp, &stdin_pipe);
02498 
02499   ip = scheme_make_input_port(scheme_make_port_type("mred-console-input-port"),
02500                            readp,
02501                            scheme_intern_symbol("mred-console"),
02502                            CAST_GS mrconsole_get_string,
02503                            NULL,
02504                            mrconsole_progress_evt,
02505                            mrconsole_peeked_read,
02506                            CAST_IREADY mrconsole_char_ready,
02507                            CAST_ICLOSE mrconsole_close,
02508                            NULL,
02509                            0);
02510 
02511   return (Scheme_Object *)ip;
02512 }
02513 
02514 static long stdout_write(Scheme_Output_Port*, const char *s, long d, long l, 
02515                       int rarely_block, int enable_break)
02516 {
02517 #if WCONSOLE_STDIO
02518   if (l)
02519     MrEdSchemeMessages(NULL, s, d, l);
02520 #else
02521   static FILE *out = NULL;
02522 
02523   if (!out)
02524     out = fopen("mrstdout.txt", "w");
02525 
02526   if (out)
02527     fwrite(s + d, l, 1, out);
02528 #endif
02529   return l;
02530 }
02531 
02532 static Scheme_Object *MrEdMakeStdOut(void)
02533 {
02534   Scheme_Object *outtype;
02535 
02536   outtype = scheme_make_port_type("stdout");
02537 
02538   return (Scheme_Object *)scheme_make_output_port(outtype, NULL,
02539                                             scheme_intern_symbol("mred-console"),
02540                                             scheme_write_evt_via_write,
02541                                             CAST_WS stdout_write,
02542                                             NULL, NULL, NULL, NULL, NULL, 0);
02543 }
02544 
02545 static long stderr_write(Scheme_Output_Port*, const char *s, long d, long l, 
02546                       int rarely_block, int enable_break)
02547 {
02548 #if WCONSOLE_STDIO
02549   if (l)
02550     MrEdSchemeMessages(NULL, s, d, l);
02551 #else
02552   if (!mrerr)
02553     mrerr = fopen("mrstderr.txt", "w");
02554 
02555   if (mrerr)
02556     fwrite(s + d, l, 1, mrerr);
02557 #endif
02558   return l;
02559 }
02560 
02561 static Scheme_Object *MrEdMakeStdErr(void)
02562 {
02563   Scheme_Object *errtype;
02564 
02565   errtype = scheme_make_port_type("stderr");
02566 
02567   return (Scheme_Object *)scheme_make_output_port(errtype, NULL,
02568                                             scheme_intern_symbol("mred-console"),
02569                                             scheme_write_evt_via_write,
02570                                             CAST_WS stderr_write,
02571                                             NULL, NULL, NULL, NULL, NULL, 0);
02572 }
02573 #endif
02574 
02575 void wxmeError(const char *e)
02576 {
02577   scheme_signal_error("%s", e);
02578 }
02579 
02580 /****************************************************************************/
02581 /*                               Debugging                                  */
02582 /****************************************************************************/
02583 
02584 #if ADD_OBJ_DUMP
02585 extern int wx_object_count;
02586 
02587 # ifndef USE_SENORA_GC
02588 extern "C" GC_PTR GC_changing_list_start, GC_changing_list_current;
02589 # else
02590 # define GC_word int
02591 # endif
02592 extern "C" GC_word GC_dl_entries;
02593 extern "C" GC_word GC_fo_entries;
02594 
02595 Scheme_Object *OBJDump(int, Scheme_Object *[])
02596 {
02597 # if REDIRECT_STDIO || WCONSOLE_STDIO
02598 # define PRINT_IT MrEdSchemeMessages
02599 # else
02600 # define PRINT_IT scheme_console_printf
02601 # endif
02602   int c;
02603 
02604   PRINT_IT("Objects: %d\n", wx_object_count);
02605 # ifndef USE_SENORA_GC
02606   PRINT_IT("Memory: %d\n", GC_get_heap_size());
02607 # endif
02608   PRINT_IT("FO: %d\n", GC_fo_entries);
02609   PRINT_IT("DL: %d\n", GC_dl_entries);
02610 # ifndef USE_SENORA_GC
02611   PRINT_IT("Changing: %d\n",
02612         (long)GC_changing_list_current - (long)GC_changing_list_start);
02613 # endif
02614 
02615   Scheme_Thread *p;
02616   for (c = 0, p = scheme_first_thread; p; p = p->next)
02617     c++;
02618 
02619   PRINT_IT("Threads: %d\n", c);
02620 
02621   return scheme_make_integer(wx_object_count);
02622 }
02623 #endif
02624 
02625 #ifdef SGC_STD_DEBUGGING
02626 extern "C" {
02627   extern void (*scheme_external_dump_info)(void);
02628   extern void (*scheme_external_dump_arg)(Scheme_Object *);
02629   extern char *(*scheme_external_dump_type)(void *);
02630 };
02631 extern void GC_cpp_for_each(void (*f)(void *, int, void *), void *data);
02632 extern int GC_is_wx_object(void *v);
02633 
02634 #define NUM_OBJ_KIND (wxTYPE_SNIP_CLASS_LIST + 1)
02635 static int cpp_count[NUM_OBJ_KIND], cpp_sch_count[NUM_OBJ_KIND], cpp_size[NUM_OBJ_KIND];
02636 static int cpp_actual_count[NUM_OBJ_KIND], cpp_actual_size[NUM_OBJ_KIND];
02637 static unsigned long cpp_lo[NUM_OBJ_KIND], cpp_hi[NUM_OBJ_KIND];
02638 
02639 static int trace_path_type;
02640 
02641 #if SGC_STD_DEBUGGING
02642 # define USE_WXOBJECT_TRACE_COUNTER
02643 #endif
02644 
02645 #ifdef USE_WXOBJECT_TRACE_COUNTER
02646 
02647 void wxTraceCount(void *o, int size)
02648 {
02649   wxObject *obj = (wxObject *)o;
02650   int type = obj->__type;
02651 
02652   if ((type >= 0) && (type < NUM_OBJ_KIND)) {
02653     cpp_actual_count[type]++;
02654     cpp_actual_size[type] += size;
02655 
02656     unsigned long s = (unsigned long)o;
02657     if (!cpp_lo[type] || (s < cpp_lo[type]))
02658       cpp_lo[type] = s;
02659     if (!cpp_hi[type] || (s > cpp_hi[type]))
02660       cpp_hi[type] = s;
02661   }
02662 }
02663 
02664 void wxTracePath(void *o, unsigned long src, void *pd)
02665 {
02666   if (trace_path_type > 0) {
02667     wxObject *obj = (wxObject *)o;
02668     int type = obj->__type;
02669 
02670     if (type == trace_path_type)
02671       GC_store_path(o, src, pd);
02672   }
02673 }
02674 
02675 void wxTraceInit(void)
02676 {
02677   int i;
02678 
02679   for (i = 0; i < NUM_OBJ_KIND; i++) {
02680     cpp_actual_count[i] = cpp_actual_size[i] = 0;
02681     cpp_lo[i] = cpp_hi[i] = 0;
02682   }
02683 }
02684 
02685 void wxTraceDone(void)
02686 {
02687   /* nothing */
02688 }
02689 
02690 void wxObjectFinalize(void *o)
02691 {
02692 #if 0
02693   /* Not every gc instance is a wxObject instance, now: */
02694   if (((wxObject *)o)->__type != -1) {
02695 # if 0
02696     /* New non-cleanup flag makes this incorrect: */
02697     fprintf(stderr, "ERROR: free wxObject had non-deleted type value!");
02698 # else
02699     ((wxObject *)o)->__type = -1;
02700 # endif
02701   }
02702 #endif
02703 }
02704 
02705 static void set_trace_arg(Scheme_Object *a)
02706 {
02707   trace_path_type = -1;
02708   if (a && SCHEME_SYMBOLP(a)) {
02709     char *s = SCHEME_SYM_VAL(a);
02710     int i;
02711 
02712     for (i = 0; i < NUM_OBJ_KIND; i++) {
02713       char *tn = wxGetTypeName(i);
02714       if (tn && !strcmp(tn, s)) {
02715        trace_path_type = i;
02716        return;
02717       }
02718     }
02719   }
02720 }
02721 
02722 static char *object_type_name(void *v)
02723 {
02724   if (GC_is_wx_object(v)) {
02725     int t = ((wxObject *)v)->__type;
02726     if ((t >= 0) && (t < NUM_OBJ_KIND)) {
02727       char *c;
02728       c = wxGetTypeName(t);
02729       if (c) {
02730        if (wxSubType(t, wxTYPE_WINDOW)) {
02731          char *lbl;
02732          lbl = ((wxWindow *)v)->GetLabel();
02733          if (!lbl)
02734            lbl = ((wxWindow *)v)->GetTitle();
02735          if (!lbl)
02736            lbl = ((wxWindow *)v)->GetName();
02737 
02738          if (lbl) {
02739            int l1, l2;
02740            char *r;
02741            l1 = strlen(c);
02742            l2 = strlen(lbl);
02743            r = new WXGC_ATOMIC char[l1+l2+2];
02744            memcpy(r, c, l1);
02745            r[l1] = '=';
02746            memcpy(r + l1 + 1, lbl, l2 + 1);
02747 
02748            return r;
02749          }
02750        }
02751        return c;
02752       } else
02753        return "wxUNKNOWN";
02754     } else
02755       return "wxBAD";
02756   } else
02757     return "";
02758 }
02759 
02760 #endif
02761 
02762 static void count_obj(void *o, int s, void *)
02763 {
02764   wxObject *obj = (wxObject *)o;
02765   int type = obj->__type;
02766 
02767   if ((type >= 0) && (type < NUM_OBJ_KIND)) {
02768     cpp_count[type]++;
02769     if (obj->__gc_external)
02770       cpp_sch_count[type]++;
02771 #ifdef MEMORY_USE_METHOD
02772     cpp_size[type] += s + (obj->MemoryUse());
02773 #endif
02774   }
02775 }
02776 
02777 static void dump_cpp_info()
02778 {
02779   int i, total_count = 0, total_size = 0, total_actual_size = 0;
02780 
02781   for (i = 0; i < NUM_OBJ_KIND; i++)
02782     cpp_count[i] = cpp_sch_count[i] = cpp_size[i] = 0;
02783 
02784   GC_cpp_for_each(count_obj, NULL);
02785 
02786   scheme_console_printf("\nBegin wxWindows\n");
02787 
02788   for (i = 0; i < NUM_OBJ_KIND; i++) {
02789     if (cpp_count[i] || cpp_actual_count[i]) {
02790       char buffer[50];
02791       char *name = wxGetTypeName(i);
02792 
02793       if (!name) {
02794        sprintf(buffer, "#%d", i);
02795        name = buffer;
02796       }
02797 
02798       scheme_console_printf("%30.30s %4ld %5ld %10ld %10ld %8lx - %8lx\n",
02799                          name,
02800                          cpp_sch_count[i],
02801                          cpp_count[i],
02802                          cpp_size[i],
02803                          cpp_actual_size[i],
02804                          cpp_lo[i],
02805                          cpp_hi[i]);
02806 #ifdef USE_WXOBJECT_TRACE_COUNTER
02807       if (cpp_count[i] != cpp_actual_count[i])
02808        scheme_console_printf("%30.30s actual count: %10ld\n",
02809                            "", cpp_actual_count[i]);
02810 #endif
02811       total_count += cpp_count[i];
02812       total_size += cpp_size[i];
02813       total_actual_size += cpp_actual_size[i];
02814     }
02815   }
02816 
02817   scheme_console_printf("%30.30s %10ld %10ld %10ld\n",
02818                      "total", total_count, total_size, total_actual_size);
02819 
02820   scheme_console_printf("End wxWindows\n");
02821 
02822 #if ADD_OBJ_DUMP
02823   scheme_console_printf("\n");
02824   OBJDump(0, NULL);
02825 #endif
02826 }
02827 
02828 #endif
02829 
02830 /****************************************************************************/
02831 /*                           AIX DANGER signal                              */
02832 /****************************************************************************/
02833 
02834 #if defined(_IBMR2)
02835 #define DANGER_ALARM
02836 #endif
02837 
02838 #ifdef DANGER_ALARM
02839 
02840 static int danger_signal_received = 0;
02841 static wxDialogBox *dangerFrame = NULL;
02842 
02843 class DangerThreadTimer : public wxTimer
02844 {
02845  public:
02846   void Notify(void);
02847 };
02848 
02849 void DismissDanger(wxObject &o, wxEvent &e)
02850 {
02851   dangerFrame->Show(FALSE);
02852   dangerFrame = NULL;
02853   danger_signal_received = 0;
02854 }
02855 
02856 void DangerThreadTimer::Notify(void)
02857 {
02858   if (danger_signal_received) {
02859     if (!dangerFrame) {
02860       wxREGGLOB(dangerFrame);
02861       dangerFrame = new WXGC_PTRS wxDialogBox((wxWindow *)NULL, "Danger", FALSE, 0, 0, 300, 200);
02862 
02863       (void) new WXGC_PTRS wxMessage(dangerFrame, "Warning: Paging space is low.");
02864 
02865       dangerFrame->NewLine();
02866 
02867       wxButton *b = new WXGC_PTRS wxButton(dangerFrame, (wxFunction)DismissDanger, "Ok");
02868 
02869       dangerFrame->Fit();
02870       b->Centre(wxHORIZONTAL);
02871 
02872       dangerFrame->Centre(wxBOTH);
02873       dangerFrame->Show(TRUE);
02874     }
02875   }
02876 }
02877 
02878 #endif
02879 
02880 /****************************************************************************/
02881 /*                             Application                                  */
02882 /****************************************************************************/
02883 
02884 MrEdApp::MrEdApp()
02885 {
02886 #ifndef wx_xt
02887   if (!wx_class)
02888     wx_class = "mred";
02889 #endif
02890 }
02891 
02892 extern "C" {
02893   MZ_EXTERN void (*GC_out_of_memory)(void);
02894 };
02895 
02896 static void MrEdOutOfMemory(void)
02897 {
02898   /* Hopefully we have enough memory for a message dialog under
02899      Windows and Mac OS X: */
02900 #ifdef wx_mac
02901   Alert(101, NULL);
02902 #endif
02903 #ifdef wx_msw
02904   wxNoMoreCallbacks();
02905   MessageBox(NULL, 
02906              "PLT Scheme virtual machine is out of memory. Aborting.",
02907              "Out of Memory",
02908              MB_OK);
02909 #endif
02910   /* For X, mzscheme already writes to stderr (and maybe syslog). */
02911 }
02912 
02913 void *wxOutOfMemory()
02914 {
02915   scheme_out_of_memory_abort();
02916   return NULL;
02917 }
02918 
02919 extern "C" {
02920   typedef void (*OOM_ptr)(void);
02921 }
02922 
02923 static OOM_ptr mr_save_oom;
02924 static mz_jmp_buf oom_buf;
02925 
02926 static void not_so_much_memory(void)
02927 {
02928   scheme_longjmp(oom_buf, 1);
02929 }
02930 
02931 void *wxMallocAtomicIfPossible(size_t s)
02932 {
02933   void *v;
02934 
02935   if (s < 5000)
02936     return scheme_malloc_atomic(s);
02937 
02938   mr_save_oom = GC_out_of_memory;
02939   if (!scheme_setjmp(oom_buf)) {
02940     GC_out_of_memory = (OOM_ptr)not_so_much_memory;
02941     v = scheme_malloc_atomic(s);
02942   } else {
02943     v = NULL;
02944   }
02945   GC_out_of_memory = mr_save_oom;
02946 
02947   return v;
02948 }
02949 
02950 #if !defined(USE_SENORA_GC) && !defined(MZ_PRECISE_GC)
02951 static void MrEdIgnoreWarnings(char *, GC_word)
02952 {
02953 }
02954 #endif
02955 
02956 void wxDoMainLoop()
02957 {
02958   TheMrEdApp->MainLoop();
02959 }
02960 
02961 static Scheme_Env *setup_basic_env()
02962 {
02963   wxREGGLOB(global_env);
02964   global_env = scheme_basic_env();
02965 
02966   scheme_set_banner(BANNER);
02967 
02968 #ifdef DANGER_ALARM
02969   {
02970     DangerThreadTimer *t = new WXGC_PTRS DangerThreadTimer();
02971     t->Start(10000);
02972   }
02973 #endif
02974 
02975   scheme_add_evt(mred_eventspace_type,
02976                (Scheme_Ready_Fun)check_eventspace_inactive,
02977                NULL,
02978                NULL, 0);
02979   scheme_add_evt(mred_nested_wait_type,
02980                CAST_BLKCHK check_for_nested_event,
02981                NULL,
02982                NULL, 0);
02983 
02984   scheme_add_custodian_extractor(mred_eventspace_hop_type,
02985                              CAST_EXT extract_eventspace_from_hop);
02986 
02987   wxsScheme_setup(global_env);
02988 
02989   scheme_set_param(scheme_current_config(), mred_eventspace_param, (Scheme_Object *)mred_main_context);
02990 
02991   wxREGGLOB(def_dispatch);
02992   def_dispatch = scheme_make_prim_w_arity(CAST_SP def_event_dispatch_handler,
02993                                      "default-event-dispatch-handler",
02994                                      1, 1);
02995   scheme_set_param(scheme_current_config(), mred_event_dispatch_param, def_dispatch);
02996 
02997   /* Make sure ps-setup is installed in the parameterization */
02998   ps_ready = 1;
02999   /* wxSetThePrintSetupData(wxGetThePrintSetupData()); */
03000 
03001   MakeContext(mred_main_context);
03002 
03003   mred_only_context = NULL;
03004 
03005   /* This handler_running pointer gets reset later. Do
03006      we really need to set it now? */
03007   {
03008     Scheme_Thread *thread;
03009     thread = scheme_get_current_thread();
03010     mred_main_context->handler_running = thread;
03011   }
03012 
03013   mzsleep = scheme_sleep;
03014   scheme_sleep = CAST_SLEEP MrEdSleep;
03015 
03016 #if ADD_OBJ_DUMP
03017   scheme_add_global("dump-object-stats",
03018                   scheme_make_prim(OBJDump), global_env);
03019 #endif
03020 
03021   return global_env;
03022 }
03023 
03024 #if WCONSOLE_STDIO
03025 static void MrEdExit(int v)
03026 {
03027   if (has_stdio) {
03028     WaitOnConsole();
03029   }
03030 
03031 #ifdef wx_msw
03032   mred_clean_up_gdi_objects();
03033 #endif
03034   scheme_immediate_exit(v);
03035 }
03036 #endif
03037 
03038 wxFrame *MrEdApp::OnInit(void)
03039 {
03040   MrEdContext *mmc;
03041 
03042   initialized = 0;
03043 
03044 #ifdef wx_mac
03045   {
03046     TSMDocumentID doc;
03047     OSType itfs[1];
03048     itfs[0] = kUnicodeDocumentInterfaceType;
03049     NewTSMDocument(1, itfs, &doc, 0);
03050     UseInputWindow(NULL, TRUE);
03051     ActivateTSMDocument(doc);
03052   }
03053 #endif
03054 
03055   wxREGGLOB(mred_frames);
03056   wxREGGLOB(timer_contexts);
03057   timer_contexts = scheme_make_hash_table(SCHEME_hash_ptr);
03058 
03059 #ifdef LIBGPP_REGEX_HACK
03060   new WXGC_PTRS Regex("a", 0);
03061 #endif
03062 
03063 #if REDIRECT_STDIO || WCONSOLE_STDIO
03064   if (!wx_in_terminal) {
03065     scheme_make_stdin = CAST_MK MrEdMakeStdIn;
03066     scheme_make_stdout = CAST_MK MrEdMakeStdOut;
03067     scheme_make_stderr = CAST_MK MrEdMakeStdErr;
03068   }
03069 #endif
03070 
03071 #if !defined(USE_SENORA_GC) && !defined(MZ_PRECISE_GC)
03072   GC_set_warn_proc(CAST_IGNORE MrEdIgnoreWarnings);
03073 #endif
03074   scheme_set_report_out_of_memory(MrEdOutOfMemory);
03075 
03076 #ifdef SGC_STD_DEBUGGING
03077   scheme_external_dump_info = dump_cpp_info;
03078 # ifdef USE_WXOBJECT_TRACE_COUNTER
03079   scheme_external_dump_type = object_type_name;
03080   scheme_external_dump_arg = set_trace_arg;
03081 # endif
03082 #endif
03083 
03084 #if REDIRECT_STDIO || WCONSOLE_STDIO
03085   scheme_console_printf = CAST_PRINTF MrEdSchemeMessages;
03086   if (!wx_in_terminal) {
03087     scheme_console_output = CAST_OUTPUT MrEdSchemeMessagesOutput;
03088   }
03089 #endif
03090 
03091   mred_eventspace_param = scheme_new_param();
03092   mred_event_dispatch_param = scheme_new_param();
03093   mred_ps_setup_param = scheme_new_param();
03094 
03095   mred_eventspace_type = scheme_make_type("<eventspace>");
03096   mred_nested_wait_type = scheme_make_type("<eventspace-nested-wait>");
03097   mred_eventspace_hop_type = scheme_make_type("<internal:eventspace-hop>");
03098 #ifdef MZ_PRECISE_GC
03099   GC_register_traversers(mred_eventspace_type,
03100                       size_eventspace_val,
03101                       mark_eventspace_val,
03102                       fixup_eventspace_val,
03103                       1, 0);
03104   GC_register_traversers(mred_nested_wait_type,
03105                       size_nested_wait_val,
03106                       mark_nested_wait_val,
03107                       fixup_nested_wait_val,
03108                       1, 0);
03109   GC_register_traversers(mred_eventspace_hop_type,
03110                       size_eventspace_hop_val,
03111                       mark_eventspace_hop_val,
03112                       fixup_eventspace_hop_val,
03113                       1, 0);
03114 #endif
03115 
03116 #ifdef NEED_HET_PARAM
03117   wxREGGLOB(mred_het_key);
03118   mred_het_key = scheme_make_symbol("het"); /* uninterned */
03119 #endif
03120 
03121 #ifdef MZ_PRECISE_GC
03122   mmc = (MrEdContext *)GC_malloc_one_tagged(sizeof(MrEdContext));
03123 #else
03124   mmc = new WXGC_PTRS MrEdContext;
03125 #endif
03126   mmc->so.type = mred_eventspace_type;
03127   wxREGGLOB(mred_main_context);
03128   mred_main_context = mmc;
03129   {
03130     wxChildList *cl;
03131     cl = new WXGC_PTRS wxChildList();
03132     mmc->topLevelWindowList = cl;
03133   }
03134   {
03135     MrEdFinalizedContext *fc;
03136     fc = new WXGC_PTRS MrEdFinalizedContext;
03137     mmc->finalized = fc;
03138   }
03139 
03140   wxREGGLOB(mred_only_context);
03141   mred_only_context = mred_main_context;
03142 
03143   MrEdInitFirstContext(mred_main_context);
03144 
03145   /* Just in case wxWindows needs an initial frame: */
03146   /* (Windows needs it for the clipboard.) */
03147   wxREGGLOB(mred_real_main_frame);
03148   mred_real_main_frame = new WXGC_PTRS wxFrame(NULL, "MrEd");
03149 #ifdef wx_msw
03150   TheMrEdApp->wx_frame = mred_real_main_frame;
03151 #endif
03152 
03153   wxInitClipboard();
03154 
03155   wxscheme_early_gl_init();
03156 
03157 #ifdef mred_BREAK_HANDLER
03158 # ifdef OS_X
03159   _signal_nobind(SIGINT, user_break_hit);
03160 # else
03161   MZ_SIGSET(SIGINT, user_break_hit);
03162 # endif
03163 #endif
03164 
03165 #ifdef wx_mac
03166 # ifdef OS_X
03167   /* Hack to make sure it's referenced, so that xform doesn't throw it away. */
03168   wx_in_terminal = wx_in_terminal;
03169 # endif
03170 #endif
03171 
03172   mred_run_from_cmd_line(argc, argv, setup_basic_env);
03173 
03174 #if WCONSOLE_STDIO
03175   if (!wx_in_terminal) {
03176     /* The only reason we get here is that a command-line error or
03177        -h occured. In either case, stick around for the sake of the
03178        console. */
03179     MrEdExit(1);
03180   }
03181 #endif
03182 
03183   return NULL;
03184 }
03185 
03186 static void on_main_killed(Scheme_Thread *p)
03187 {
03188   on_handler_killed(p);
03189 
03190   if (scheme_exit)
03191     scheme_exit(exit_val);
03192   else {
03193 #ifdef wx_msw
03194     mred_clean_up_gdi_objects();
03195 #endif
03196     scheme_immediate_exit(exit_val);
03197   }
03198 }
03199 
03200 void MrEdApp::RealInit(void)
03201 {
03202   Scheme_Thread *thread;
03203   thread = scheme_get_current_thread();
03204 
03205   initialized = 1;
03206 
03207   thread->on_kill = CAST_TOK on_main_killed;
03208 #if WCONSOLE_STDIO
03209   if (!wx_in_terminal)
03210     scheme_exit = CAST_EXIT MrEdExit;
03211 #endif
03212 
03213 #ifdef wx_xt
03214   if (wx_single_instance) {
03215     exit_val = wxCheckSingleInstance(global_env);
03216   }
03217 #endif
03218 
03219   if (!exit_val)
03220     exit_val = mred_finish_cmd_line_run();
03221 
03222   scheme_kill_thread(thread);
03223 }
03224 
03225 #ifdef wx_mac
03226 char *wx_original_argv_zero;
03227 static char *about_label;
03228 extern "C" char *scheme_get_exec_path();
03229 char *MrEdApp::GetDefaultAboutItemName()
03230 {
03231 # ifdef OS_X
03232   if (!about_label) {
03233     char *p;
03234     int i, len;
03235 
03236     p = wx_original_argv_zero;
03237     len = strlen(p);
03238     for (i = len - 1; i; i--) {
03239       if (p[i] == '/') {
03240        i++;
03241        break;
03242       }
03243     }
03244 
03245     wxREGGLOB(about_label);
03246     about_label = new WXGC_ATOMIC char[len - i + 20];
03247     sprintf(about_label, "About %s...", p + i);
03248   }
03249 
03250   return about_label;
03251 # else
03252   return "About...";
03253 # endif
03254 }
03255 
03256 void MrEdApp::DoDefaultAboutItem()
03257 {
03258   DialogPtr dial;
03259   short hit;
03260   CGrafPtr port;
03261   GDHandle device;
03262 
03263   dial = GetNewDialog(129, NULL, (WindowRef)-1);
03264   GetGWorld(&port,&device);
03265 
03266   SetGWorld(GetDialogPort(dial),GetGDevice());
03267 
03268   TextFont(kFontIDGeneva);
03269   TextSize(10);
03270   SetGWorld(port,device);
03271 
03272   ModalDialog(NULL, &hit);
03273 
03274   DisposeDialog(dial);
03275 }
03276 
03277 #ifdef OS_X
03278 extern int scheme_mac_path_to_spec(const char *filename, FSSpec *spec);
03279 #endif
03280 
03281 int wxGetOriginalAppFSSpec(FSSpec *spec)
03282 {
03283   char *s = wx_original_argv_zero;
03284 
03285 #ifdef OS_X
03286   /* Need the folder of the exe, three levels up: */
03287   {
03288     char *p;
03289     int i, len, c = 0;
03290 
03291     p = s;
03292     len = strlen(s);
03293     for (i = len - 1; i; i--) {
03294       if (p[i] == '/') {
03295        c++;
03296        if (c == 3) {
03297          i++;
03298          break;
03299        }
03300       }
03301     }
03302 
03303     if (i) {
03304       char *s2;
03305       s2 = new WXGC_ATOMIC char[i + 1];
03306       memcpy(s2, s, i);
03307       s2[i] = 0;
03308       s = s2;
03309     }
03310   }
03311 #endif
03312 
03313   return scheme_mac_path_to_spec(s, spec);
03314 }
03315 
03316 #endif
03317 
03318 int MrEdApp::OnExit(void)
03319 {
03320   return 0;
03321 }
03322 
03323 void wxCreateApp(void)
03324 {
03325   if (!TheMrEdApp) {
03326 #ifdef wx_mac
03327     wxmac_reg_globs();
03328 #endif
03329 #ifdef wx_msw
03330   {
03331     HANDLE h;
03332     h = GetStdHandle(STD_OUTPUT_HANDLE);
03333     if (h && (h != INVALID_HANDLE_VALUE)
03334         && (GetFileType(h) != FILE_TYPE_UNKNOWN)) {
03335       wx_in_terminal = 1;
03336     }
03337   }
03338 #endif
03339 
03340     wxREGGLOB(orig_ps_setup);
03341     wxREGGLOB(q_callbacks);
03342 
03343     wxREGGLOB(TheMrEdApp);
03344     TheMrEdApp = new WXGC_PTRS MrEdApp;
03345   }
03346 }
03347 
03348 /****************************************************************************/
03349 /*                              wxFlushDisplay                              */
03350 /****************************************************************************/
03351 
03352 void wxFlushDisplay(void)
03353 {
03354 #ifdef wx_x
03355   Display *d;
03356 
03357   d = XtDisplay(wxAPP_TOPLEVEL);
03358 
03359   XFlush(d);
03360   XSync(d, FALSE);
03361   XFlush(d);
03362   XSync(d, FALSE);
03363 #endif
03364 #ifdef wx_mac
03365   wxFlushMacDisplay();
03366 #endif
03367 }
03368 
03369 #ifdef DEFINE_DUMMY_PURE_VIRTUAL
03370 /* Weird hack to avoid linking to libg++ */
03371 extern "C" {
03372  void __pure_virtual(void) {  }
03373 }
03374 #endif
03375 
03376 /****************************************************************************/
03377 /*                            wxHiEventTrampoline                           */
03378 /****************************************************************************/
03379 
03380 #ifdef NEED_HET_PARAM
03381 
03382 /* In certain Windows and Mac OS modes (e.g., to implement scrolling),
03383    we run Scheme code atomically to avoid copying part of the stack
03384    that belongs to the system. We run arbitrary code, however, the
03385    code does not run to completion. Instead, we suspend the
03386    continuation after a while, and then try to continue on the next OS
03387    stop point (e.g., an WM_XSCROLL message). Hopefully, a timer
03388    ensures that a suspended continuation gets to continue soon when
03389    nothing else is going on.  During this special mode, other messages
03390    that can call into Scheme are ignored (e.g., WM_ACTIVATE). After
03391    the OS mode ends (e.g., the scroller returns), any pending
03392    continuation is finished, but in non-atomic mode, and things are
03393    generally back to normal.
03394 
03395    The call process is
03396     wxHiEventTrampoline(f, data)
03397      -> f(data) in ht mode
03398          -> ... mred_het_run_some(g, data2)        \
03399              -> Scheme code, may finish or may not  | maybe loop
03400          het->in_progress inicates whether done    /
03401      -> continue scheme if not finished
03402 
03403    In this process, it's the call stack between f(data)
03404    and the call to mred_het_run_some() that won't be copied
03405    in or out until f(data) returns. 
03406 
03407    Nesting wxHiEventTrampoline() calls should be safe, but it won't
03408    achieve the goal, which is to limit the amount of work done before
03409    returning (because the inner wxHiEventTrampoline will have to run
03410    to completion). */
03411 
03412 static unsigned long get_deeper_base();
03413 
03414 int wxHiEventTrampoline(int (*_wha_f)(void *), void *wha_data)
03415 {
03416   HiEventTramp *het;
03417   HiEventTrampProc wha_f = (HiEventTrampProc)_wha_f;
03418   Scheme_Cont_Frame_Data cframe;
03419   Scheme_Object *bx;
03420 
03421   het = new WXGC_PTRS HiEventTramp;
03422 
03423   bx = scheme_make_raw_pair((Scheme_Object *)het, NULL);
03424 
03425   scheme_push_continuation_frame(&cframe);
03426   scheme_set_cont_mark(mred_het_key, bx);
03427 
03428   het->progress_cont = scheme_new_jmpupbuf_holder();
03429 
03430   scheme_init_jmpup_buf(&het->progress_cont->buf);
03431 
03432   scheme_start_atomic();
03433   het->val = wha_f(wha_data);
03434 
03435   if (het->timer_on) {
03436     het->timer_on = 0;
03437 # ifdef wx_msw
03438     KillTimer(NULL, het->timer_id);
03439 # endif
03440   }
03441 
03442   if (het->in_progress) {
03443     /* We have leftover work; jump and finish it (non-atomically).
03444        But don't swap until we've jumped back in, because the jump-in
03445        point might be trying to suspend the thread (and that should
03446        complete before any swap). */
03447     scheme_end_atomic_no_swap();
03448     SCHEME_CAR(bx) = NULL;
03449     het->in_progress = 0;
03450     het->progress_is_resumed = 1;
03451     if (!scheme_setjmp(het->progress_base)) {
03452 #ifdef MZ_PRECISE_GC
03453       het->fixup_var_stack_chain = &__gc_var_stack__;
03454 #endif
03455       scheme_longjmpup(&het->progress_cont->buf);
03456     }
03457   } else {
03458     scheme_end_atomic();
03459   }
03460 
03461   scheme_pop_continuation_frame(&cframe);
03462 
03463   het->old_param = NULL;
03464   het->progress_cont = NULL;
03465   het->do_data = NULL;
03466 
03467   return het->val;
03468 }
03469 
03470 static void suspend_het_progress(void)
03471 {
03472   HiEventTramp * volatile het;
03473   double msecs;
03474 
03475   {
03476     Scheme_Object *v;
03477     v = scheme_extract_one_cc_mark(NULL, mred_het_key);
03478     het = (HiEventTramp *)SCHEME_CAR(v);
03479   }
03480 
03481   msecs = scheme_get_inexact_milliseconds();
03482   if (msecs < het->continue_until)
03483     return;
03484 
03485   scheme_on_atomic_timeout = NULL;
03486 
03487   het->yielding = 0;
03488   het->in_progress = 1;
03489   if (scheme_setjmpup(&het->progress_cont->buf, (void*)het->progress_cont, het->progress_base_addr)) {
03490     /* we're back */
03491     scheme_reset_jmpup_buf(&het->progress_cont->buf);
03492     het->yielding = 0;
03493 #ifdef MZ_PRECISE_GC
03494     /* Base addr points to the last valid gc_var_stack address.
03495        Fixup that link to skip over the part of the stack we're
03496        not using right now. */
03497     ((void **)het->progress_base_addr)[0] = het->fixup_var_stack_chain;
03498     ((void **)het->progress_base_addr)[1] = NULL;
03499 #endif
03500   } else {
03501     /* we're leaving */
03502     scheme_longjmp(het->progress_base, 1);
03503   }
03504 }
03505 
03506 #define HET_RUN_MSECS 200
03507 
03508 static void het_run_new(HiEventTramp * volatile het)
03509 {
03510   double msecs;
03511 
03512   /* We're willing to start new work that is specific to this thread */
03513   het->progress_is_resumed = 0;
03514 
03515   msecs = scheme_get_inexact_milliseconds();
03516   het->continue_until = msecs + HET_RUN_MSECS;
03517   
03518   if (!scheme_setjmp(het->progress_base)) {
03519     scheme_start_atomic();
03520     scheme_on_atomic_timeout = CAST_SUSPEND suspend_het_progress;
03521     /* Due to het param, yield work will be restricted: */
03522     het->yielding = 1;
03523     if (het->do_f) {
03524       HiEventTrampProc do_f = het->do_f;
03525       do_f(het->do_data);
03526     } else
03527       wxYield();
03528     het->yielding = 0;
03529   }
03530 
03531   if (het->progress_is_resumed) {
03532     /* we've already returned once; jump out to new progress base */
03533     scheme_longjmp(het->progress_base, 1);
03534   } else {
03535     scheme_on_atomic_timeout = NULL;
03536     scheme_end_atomic_no_swap();
03537   }
03538 }
03539 
03540 static void het_do_run_new(HiEventTramp * volatile het, int *iteration)
03541 {
03542   /* This function just makes room on the stack, eventually calling
03543      het_run_new(). */
03544   int new_iter[32];
03545 
03546   if (iteration[0] == 3) {
03547 #ifdef MZ_PRECISE_GC
03548     het->progress_base_addr = (void *)&__gc_var_stack__;
03549 #else
03550     het->progress_base_addr = (void *)new_iter;
03551 #endif
03552     het_run_new(het);
03553   } else {
03554     new_iter[0] = iteration[0] + 1;
03555     het_do_run_new(het, new_iter);
03556   }
03557 }
03558 
03559 int mred_het_run_some(HiEventTrampProc do_f, void *do_data)
03560 {
03561   HiEventTramp * volatile het;
03562   int more = 0;
03563 
03564   {
03565     Scheme_Object *v;
03566     v = scheme_extract_one_cc_mark(NULL, mred_het_key);
03567     if (v)
03568       het = (HiEventTramp *)SCHEME_CAR(v);
03569     else
03570       het = NULL;
03571   }
03572 
03573   if (het) {
03574     if (het->in_progress) {
03575       /* We have work in progress. */
03576       if ((unsigned long)het->progress_base_addr < get_deeper_base()) {
03577        /* We have stack space to resume the old work: */
03578         double msecs;
03579        het->in_progress = 0;
03580        het->progress_is_resumed = 1;
03581         msecs = scheme_get_inexact_milliseconds();
03582         het->continue_until = msecs + HET_RUN_MSECS;
03583        scheme_start_atomic();
03584        scheme_on_atomic_timeout = CAST_SUSPEND suspend_het_progress;
03585        if (!scheme_setjmp(het->progress_base)) {
03586 #ifdef MZ_PRECISE_GC
03587          het->fixup_var_stack_chain = &__gc_var_stack__;
03588 #endif
03589          scheme_longjmpup(&het->progress_cont->buf);
03590        } else {
03591          scheme_on_atomic_timeout = NULL;
03592          scheme_end_atomic_no_swap();
03593        }
03594       }
03595     } else {
03596       int iter[1];
03597       iter[0] = 0;
03598       het->do_f = do_f;
03599       het->do_data = do_data;
03600       het_do_run_new(het, iter);
03601     }
03602 
03603     more = het->in_progress;
03604   }
03605 
03606   return more;
03607 }
03608 
03609 // Disable warning for returning address of local variable.
03610 #ifdef _MSC_VER
03611 #pragma warning (disable:4172)
03612 #endif
03613 
03614 static unsigned long get_deeper_base()
03615 {
03616   long here;
03617   return (unsigned long)&here;
03618 }
03619 
03620 // re-enable warning
03621 #ifdef _MSC_VER
03622 #pragma warning (default:4172)
03623 #endif
03624 
03625 #endif
03626 
03627 /****************************************************************************/
03628 /*                              AE-like support                             */
03629 /****************************************************************************/
03630 
03631 static void wxDo(Scheme_Object *proc, int argc, Scheme_Object **argv)
03632 {
03633   mz_jmp_buf * volatile save, newbuf;
03634   volatile int block_descriptor;
03635   Scheme_Thread *thread;
03636   thread = scheme_get_current_thread();
03637 
03638   if (!proc) {
03639     /* Oops --- too early. */
03640     return;
03641   }
03642 
03643   /* wxDo might be called when MrEd is sleeping (i.e.,
03644      blocked on WNE in OS X). Since we're hijacking the
03645      thread, save an restore block information. */
03646   block_descriptor = thread->block_descriptor;
03647   thread->block_descriptor = 0;
03648 
03649   scheme_start_atomic();
03650 
03651   save = thread->error_buf;
03652   thread->error_buf = &newbuf;
03653 
03654   if (scheme_setjmp(newbuf)) {
03655     scheme_clear_escape();
03656   } else {
03657     scheme_apply(proc, argc, argv);
03658   }
03659 
03660   thread = scheme_get_current_thread();
03661   thread->error_buf = save;
03662   thread->block_descriptor = block_descriptor;
03663 
03664   scheme_end_atomic_no_swap();
03665 }
03666 
03667 void wxDrop_Runtime(char **argv, int argc)
03668 {
03669   int i;
03670 
03671   for (i = 0; i < argc; i++) {
03672     Scheme_Object *p[1];
03673 #ifdef wx_xt
03674     p[0] = scheme_char_string_to_path(scheme_make_utf8_string(argv[i]));
03675 #else
03676     p[0] = scheme_make_path(argv[i]);
03677 #endif
03678     wxDo(wxs_app_file_proc, 1, p);
03679   }
03680 }
03681 
03682 #if defined(wx_mac) || defined(wx_msw)
03683 void wxDrop_Quit()
03684 {
03685   wxDo(wxs_app_quit_proc, 0, NULL);
03686 }
03687 #endif
03688 
03689 #ifdef wx_mac
03690 void wxDo_About()
03691 {
03692   wxDo(wxs_app_about_proc, 0, NULL);
03693 }
03694 
03695 void wxDo_Pref()
03696 {
03697   if (!SCHEME_FALSEP(wxs_app_pref_proc))
03698     wxDo(wxs_app_pref_proc, 0, NULL);
03699 }
03700 
03701 int wxCan_Do_Pref()
03702 {
03703   return SCHEME_TRUEP(wxs_app_pref_proc);
03704 }
03705 #endif