Back to index

plt-scheme  4.2.1
mrmain.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 /* #define STANDALONE_WITH_EMBEDDED_EXTENSION */
00011 /*    STANDALONE_WITH_EMBEDDED_EXTENSION builds an executable with
00012       built-in extensions. The extension is initialized by calling
00013       scheme_initialize(env), where `env' is the initial environment.
00014       By default, command-line parsing, the REP, and initilization
00015       file loading are turned off. */
00016 
00017 #ifdef STANDALONE_WITH_EMBEDDED_EXTENSION
00018 # define DONT_PARSE_COMMAND_LINE
00019 # define DONT_RUN_REP
00020 # define DONT_LOAD_INIT_FILE
00021 #endif
00022 
00023 /* wx_xt: */
00024 #define Uses_XtIntrinsic
00025 #define Uses_XtIntrinsicP
00026 #define Uses_XLib
00027 #define Uses_wxApp
00028 
00029 #define IS_MRMAIN
00030 
00031 #include "wx.h"
00032 
00033 class wxStandardSnipClassList;
00034 class wxBufferDataClassList;
00035 
00036 #include "wxs/wxscheme.h"
00037 #include "wxs/wxsmred.h"
00038 
00039 #include "mred.h"
00040 
00041 #ifdef wx_mac
00042 extern char *wx_original_argv_zero;
00043 extern short wxMacDisableMods;
00044 extern long wxMediaCreatorId;
00045 # include "simpledrop.h"
00046 # ifdef OS_X
00047 extern int wx_in_terminal;
00048 # else
00049 int wx_in_terminal; /* dummy */
00050 # endif
00051 #endif
00052 
00053 #ifdef wx_msw
00054 /* Hack: overwrite "y" with "n" in binary to disable checking for another
00055    instance of the same app. */
00056 char *check_for_another = "yes, please check for another";
00057 #endif
00058 
00059 static void yield_indefinitely()
00060 {
00061 #ifdef MZ_PRECISE_GC
00062   void *dummy;
00063 #endif
00064   mz_jmp_buf * volatile save, newbuf;
00065   Scheme_Thread * volatile p;
00066 
00067   p = scheme_get_current_thread();
00068   save = p->error_buf;
00069   p->error_buf = &newbuf;
00070 
00071   if (!scheme_setjmp(newbuf)) {
00072     mred_wait_eventspace();
00073   }
00074 
00075   p->error_buf = save;
00076 
00077 #ifdef MZ_PRECISE_GC
00078   dummy = NULL; /* makes xform think that dummy is live, so we get a __gc_var_stack__ */
00079 #endif
00080 }
00081 
00082 #ifndef DONT_LOAD_INIT_FILE
00083 static char *get_init_filename(Scheme_Env *env)
00084 {
00085   Scheme_Object *type;
00086   Scheme_Object *path;
00087 
00088   type = scheme_intern_symbol("init-file");
00089   
00090   path = wxSchemeFindDirectory(1, &type);
00091 
00092   return SCHEME_BYTE_STR_VAL(path);
00093 }
00094 #endif
00095 
00096 #ifdef STANDALONE_WITH_EMBEDDED_EXTENSION
00097 extern "C" Scheme_Object *scheme_initialize(Scheme_Env *env);
00098 #endif
00099 
00100 #ifdef wx_x
00101 # define INIT_FILENAME "~/.mredrc"
00102 #else
00103 # ifdef wx_msw
00104 #  define INIT_FILENAME "%%HOMEDIRVE%%\\%%HOMEPATH%%\\mredrc.ss"
00105 # else
00106 #  ifdef OS_X
00107 #   define INIT_FILENAME "~/.mredrc"
00108 #  else
00109 #   define INIT_FILENAME "PREFERENCES:mredrc.ss"
00110 #  endif
00111 # endif
00112 #endif
00113 #define GET_INIT_FILENAME get_init_filename
00114 #if REDIRECT_STDIO || WINDOW_STDIO || WCONSOLE_STDIO
00115 # define PRINTF mred_console_printf
00116 static void (*mred_console_printf)(char *str, ...);
00117 # define NEED_MRED_CONSOLE_PRINTF
00118 #else
00119 # define PRINTF printf
00120 #endif
00121 #define PROGRAM "MrEd"
00122 #define PROGRAM_LC "mred"
00123 #define INITIAL_BIN_TYPE "ri"
00124 
00125 #ifdef wx_mac
00126 # ifndef OS_X
00127 #  define GET_PLTCOLLECTS_VIA_RESOURCES
00128 # endif
00129 #endif
00130 
00131 #ifdef GET_PLTCOLLECTS_VIA_RESOURCES
00132 extern char *scheme_getenv_hack;
00133 extern char *scheme_getenv_hack_value;
00134 static char *pltcollects_from_resource;
00135 #define SETUP_GETENV_HACK (scheme_getenv_hack = "PLTCOLLECTS", scheme_getenv_hack_value = pltcollects_from_resource);
00136 #define TAKEDOWN_GETENV_HACK (scheme_getenv_hack = NULL, scheme_getenv_hack_value = NULL);
00137 #else
00138 #define SETUP_GETENV_HACK /* empty */
00139 #define TAKEDOWN_GETENV_HACK /* empty */
00140 #endif
00141 
00142 #define CMDLINE_STDIO_FLAG
00143 #define YIELD_BEFORE_EXIT
00144 #define INITIAL_NAMESPACE_MODULE "scheme/gui/init"
00145 
00146 # include "../mzscheme/cmdline.inc"
00147 
00148 #ifdef wx_x
00149 #if INTERRUPT_CHECK_ON
00150 static int interrupt_signal_received;
00151 
00152 static void interrupt(int)
00153 {
00154   interrupt_signal_received = 1;
00155 
00156   signal(SIGINT, interrupt);
00157 }
00158 #endif
00159 #endif
00160 
00161 static FinishArgs *xfa;
00162 
00163 static void do_graph_repl(Scheme_Env *env)
00164 {
00165   mz_jmp_buf * volatile save, newbuf;
00166   Scheme_Thread * volatile p;
00167   Scheme_Object *a[2], *v;
00168 
00169   p = scheme_get_current_thread();
00170   save = p->error_buf;
00171   p->error_buf = &newbuf;
00172 
00173   if (!scheme_setjmp(newbuf)) {
00174     if (xfa->a->alternate_rep) {
00175       a[0] = scheme_intern_symbol("mred/mred");
00176       a[1] = scheme_intern_symbol("textual-read-eval-print-loop");
00177     } else {
00178       a[0] = scheme_intern_symbol("mred/mred");
00179       a[1] = scheme_intern_symbol("graphical-read-eval-print-loop");
00180     }
00181     v = scheme_dynamic_require(2, a);
00182     scheme_apply(v, 0, NULL);
00183   }
00184 
00185   p->error_buf = save;
00186 
00187 #ifdef MZ_PRECISE_GC
00188   env = NULL; /* makes xform think that env is live, so we get a __gc_var_stack__ */
00189 #endif
00190 }
00191 
00192 static int finish_cmd_line_run(void)
00193 {
00194   return finish_cmd_line_run(xfa, do_graph_repl);
00195 }
00196 
00197 static int do_main_loop(FinishArgs *fa)
00198 {
00199   wxREGGLOB(xfa);
00200   xfa = fa;
00201 
00202 #ifdef wx_mac
00203   if (!fa->a->no_front) {
00204     ProcessSerialNumber psn;
00205     GetCurrentProcess(&psn);    
00206     SetFrontProcess(&psn); /* kCurrentProcess doesn't work */
00207   }
00208 #endif
00209 
00210  {
00211    mz_jmp_buf * volatile save, newbuf;
00212    Scheme_Thread * volatile p;
00213 
00214    p = scheme_get_current_thread();
00215    save = p->error_buf;
00216    p->error_buf = &newbuf;
00217    if (!scheme_setjmp(newbuf))
00218      wxDoMainLoop();
00219    p->error_buf = save;
00220  }
00221 
00222   return 0;
00223 }
00224 
00225 static void run_from_cmd_line(int argc, char **argv, Scheme_Env *(*mk_basic_env)(void))
00226 {
00227 #ifdef NEED_MRED_CONSOLE_PRINTF
00228   mred_console_printf = scheme_get_console_printf();
00229 #endif
00230   run_from_cmd_line(argc, argv, mk_basic_env, do_main_loop);
00231 }
00232 
00233 static int main_after_stack(int argc, char *argv[])
00234 {
00235   int rval;
00236 
00237 #ifdef wx_x
00238 # if INTERRUPT_CHECK_ON
00239   signal(SIGINT, interrupt);
00240 # endif
00241 #endif
00242 
00243 #ifdef SGC_STD_DEBUGGING
00244   fprintf(stderr, "Starting MrEd with sgc for debugging\n");
00245 #endif
00246 
00247 #ifdef wx_mac
00248   wxMacDisableMods = controlKey;
00249 # ifndef OS_X
00250   scheme_creator_id = 'mReD';
00251   wxMediaCreatorId = 'mReD';
00252 # endif
00253 #endif
00254 
00255 #ifdef wx_mac
00256   /* initialize Mac stuff */
00257   wx_original_argv_zero = argv[0];
00258   wxDrop_GetArgs(&argc, &argv, &wx_in_terminal);
00259 #endif
00260 
00261   mred_set_run_from_cmd_line(run_from_cmd_line);
00262   mred_set_finish_cmd_line_run(finish_cmd_line_run);
00263 
00264   wxCreateApp();
00265   
00266   rval = wxEntry(argc, argv);
00267 
00268 #ifdef wx_msw
00269   mred_clean_up_gdi_objects();
00270 #endif 
00271   
00272   return rval;
00273 }
00274 
00275 /* **************************************************************** */
00276 /*   Main for Unix and Mac OS X                                     */
00277 /* **************************************************************** */
00278 
00279 /* Just jumps to generic main. */
00280 
00281 #ifndef wx_msw 
00282 
00283 typedef struct {
00284   int argc;
00285   char **argv;
00286 } Main_Args;
00287 
00288 static int call_main_after_stack(void *data)
00289 {
00290   Main_Args *ma = (Main_Args *)data;
00291   return main_after_stack(ma->argc, ma->argv);
00292 }
00293 
00294 int main(int argc, char *argv[])
00295 {
00296   Main_Args ma;
00297   ma.argc = argc;
00298   ma.argv = argv;
00299   return scheme_main_stack_setup(1, call_main_after_stack, &ma);
00300 }
00301 #endif
00302 
00303 /* **************************************************************** */
00304 /*   Main for Windows                                               */
00305 /* **************************************************************** */
00306 
00307 /* Implements single-instance mode and otherwise initializes Windows. */
00308 
00309 #ifdef wx_msw 
00310 
00311 /* Some of the code to avoid multiple application instances is taken from
00312     http://www.codeproject.com/cpp/avoidmultinstance.asp */
00313 
00314 static int wm_is_mred;
00315 
00316 static BOOL CALLBACK CheckWindow(HWND wnd, LPARAM param)
00317 {
00318   int i, len, gl;
00319   DWORD w;
00320   char **argv, *v;
00321   COPYDATASTRUCT cd;
00322   DWORD result;
00323   LRESULT ok;
00324 
00325   ok = SendMessageTimeout(wnd, wm_is_mred,
00326                        0, 0, 
00327                        SMTO_BLOCK |
00328                        SMTO_ABORTIFHUNG,
00329                        200,
00330                        &result);
00331 
00332   if (ok == 0)
00333     return TRUE; /* ignore and continue */
00334   if (result == 79) {
00335     /* found it */
00336   } else
00337     return TRUE; /* continue search */
00338 
00339   /* wnd is owned by another instance of this application. */
00340 
00341   SetForegroundWindow(wnd);
00342   if (IsIconic(wnd)) 
00343     ShowWindow(wnd, SW_RESTORE);
00344 
00345   argv = (char **)param;
00346   
00347   len = gl = strlen(MRED_GUID);
00348   len += 4 + sizeof(DWORD);
00349   for (i = 1; argv[i]; i++) {
00350     len += sizeof(DWORD) + strlen(argv[i]);
00351   }
00352   w = i - 1;
00353 
00354   v = (char *)malloc(len);
00355   memcpy(v, MRED_GUID, gl);
00356   memcpy(v + gl, "OPEN", 4);
00357   memcpy(v + gl + 4, &w, sizeof(DWORD));
00358   len = gl + 4 + sizeof(DWORD);
00359   for (i = 1; argv[i]; i++) {
00360     w = strlen(argv[i]);
00361     memcpy(v + len, &w, sizeof(DWORD));
00362     len += sizeof(DWORD);
00363     memcpy(v + len, argv[i], w);
00364     len += w;
00365   }
00366 
00367   cd.dwData = 79;
00368   cd.cbData = len;
00369   cd.lpData = v;
00370 
00371   SendMessage(wnd, WM_COPYDATA, (WPARAM)wnd, (LPARAM)&cd);
00372 
00373   free(v);
00374 
00375   return FALSE;
00376 }
00377 
00378 char *wchar_to_char(wchar_t *wa, int len)
00379 {
00380   char *a;
00381   int l;
00382 
00383   l = scheme_utf8_encode((unsigned int *)wa, 0, len, 
00384                       NULL, 0,
00385                       1 /* UTF-16 */);
00386   a = (char *)malloc(l + 1);
00387   scheme_utf8_encode((unsigned int *)wa, 0, len, 
00388                    (unsigned char *)a, 0,
00389                    1 /* UTF-16 */);
00390   a[l] = 0;
00391 
00392   return a;
00393 }
00394 
00395 static int parse_command_line(char ***_command, char *buf)
00396 {
00397   GC_CAN_IGNORE unsigned char *parse, *created, *write;
00398   int maxargs;
00399   int findquote = 0;
00400   char **command;
00401   int count = 0;
00402 
00403   maxargs = 49;
00404   command = (char **)malloc((maxargs + 1) * sizeof(char *));
00405   
00406   parse = created = write = (unsigned char *)buf;
00407   while (*parse) {
00408     while (*parse && isspace(*parse)) { parse++; }
00409     while (*parse && (!isspace(*parse) || findquote))   {
00410       if (*parse== '"') {
00411        findquote = !findquote;
00412       } else if (*parse== '\\') {
00413        GC_CAN_IGNORE unsigned char *next;
00414        for (next = parse; *next == '\\'; next++) { }
00415        if (*next == '"') {
00416          /* Special handling: */
00417          int count = (next - parse), i;
00418          for (i = 1; i < count; i += 2) {
00419            *(write++) = '\\';
00420          }
00421          parse += (count - 1);
00422          if (count & 0x1) {
00423            *(write++) = '\"';
00424            parse++;
00425          }
00426        }      else
00427          *(write++) = *parse;
00428       } else
00429        *(write++) = *parse;
00430       parse++;
00431     }
00432     if (*parse)
00433       parse++;
00434     *(write++) = 0;
00435     
00436     if (*created)    {
00437       command[count++] = (char *)created;
00438       if (count == maxargs) {
00439        char **c2;
00440        c2 = (char **)malloc(((2 * maxargs) + 1) * sizeof(char *));
00441        memcpy(c2, command, maxargs * sizeof(char *));
00442        maxargs *= 2;
00443       }
00444     }
00445     created = write;
00446   }
00447 
00448   command[count] = NULL;
00449   *_command = command;
00450 
00451   return count;
00452 }
00453 
00454 static char *CreateUniqueName()
00455 {
00456   char desktop[MAX_PATH], session[32], *together;
00457   int dlen, slen;
00458 
00459   {
00460     // Name should be desktop unique, so add current desktop name
00461     HDESK hDesk;
00462     ULONG cchDesk = MAX_PATH - 1;
00463 
00464     hDesk = GetThreadDesktop(GetCurrentThreadId());
00465     
00466     if (!GetUserObjectInformation( hDesk, UOI_NAME, desktop, cchDesk, &cchDesk))
00467       desktop[0] = 0;
00468     else
00469       desktop[MAX_PATH - 1]  = 0;
00470   }
00471 
00472   {
00473     // Name should be session unique, so add current session id
00474     HANDLE hToken = NULL;
00475     // Try to open the token (fails on Win9x) and check necessary buffer size
00476     if (OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, &hToken)) {
00477       DWORD cbBytes = 0;
00478       
00479       if(!GetTokenInformation( hToken, TokenStatistics, NULL, cbBytes, &cbBytes ) 
00480         && GetLastError() == ERROR_INSUFFICIENT_BUFFER) {
00481          PTOKEN_STATISTICS pTS;
00482 
00483          pTS = (PTOKEN_STATISTICS)malloc(cbBytes);
00484          
00485          if(GetTokenInformation(hToken, TokenStatistics, (LPVOID)pTS, cbBytes, &cbBytes)) {
00486            sprintf(session, "-%08x%08x-",
00487                   pTS->AuthenticationId.HighPart, 
00488                   pTS->AuthenticationId.LowPart);
00489          } else
00490            session[0] = 0;
00491          free(pTS);
00492       } else {
00493        session[0] = 0;
00494       }
00495     } else
00496       session[0] = 0;
00497   }
00498 
00499   dlen = strlen(desktop);
00500   slen =  strlen(session);
00501   together = (char *)malloc(slen + dlen + 1);
00502   memcpy(together, desktop, dlen);
00503   memcpy(together + dlen, session, slen);
00504   together[dlen + slen] = 0;
00505   
00506   return together;
00507 }
00508 
00509 /* To propagate args from WinMain to wxWinMain via
00510    scheme_main_stack_setup: */
00511 typedef struct {
00512   int wm_is_mred;
00513   HINSTANCE hInstance;
00514   HINSTANCE hPrevInstance;
00515   int argc;
00516   char **argv;
00517   int nCmdShow;
00518 } WinMain_Args;
00519 
00520 static int WinMain_after_stack(void *_wma)
00521 {
00522   WinMain_Args *wma = (WinMain_Args *)_wma;
00523 
00524   return wxWinMain(wma->wm_is_mred, wma->hInstance, wma->hPrevInstance, 
00525                    wma->argc, wma->argv, 
00526                    wma->nCmdShow, 
00527                    main_after_stack);
00528 }
00529 
00530 int APIENTRY WinMain_dlls_ready(HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR ignored, int nCmdShow)
00531 {
00532   LPWSTR m_lpCmdLine;
00533   long argc, j, l;
00534   char *a, **argv, *b, *normalized_path = NULL;
00535   WinMain_Args wma;
00536 
00537   /* Get command line: */
00538   m_lpCmdLine = GetCommandLineW();
00539   for (j = 0; m_lpCmdLine[j]; j++) {
00540   }
00541   a = wchar_to_char(m_lpCmdLine, j);
00542 
00543   argc = parse_command_line(&argv, a);
00544 
00545   /* argv[0] should be the name of the executable, but Windows doesn't
00546      specify really where this name comes from, so we get it from
00547      GetModuleFileName, just in case */
00548   {
00549     int name_len = 1024;
00550     while (1) {
00551       wchar_t *my_name;
00552       my_name = (wchar_t *)malloc(sizeof(wchar_t) * name_len);
00553       l = GetModuleFileNameW(NULL, my_name, name_len);
00554       if (!l) {
00555        name_len = GetLastError();
00556        free(my_name);
00557        my_name = NULL;
00558        break;
00559       } else if (l < name_len) {
00560        a = wchar_to_char(my_name, l);
00561        argv[0] = a;
00562        {
00563          /* CharLowerBuff doesn't work with unicows.dll -- strange. 
00564             So we use CharLower, instead. */
00565          int i;
00566          for (i = 0; i < l; i++) {
00567            CharLowerW(my_name XFORM_OK_PLUS i);
00568          }
00569        }
00570        normalized_path = wchar_to_char(my_name, l);
00571        free(my_name);
00572        break;
00573       } else {
00574        free(my_name);
00575        name_len = name_len * 2;
00576       }
00577     }
00578   }
00579   if (!normalized_path) {
00580     normalized_path = "???";
00581   } else {
00582     for (j = 0; normalized_path[j]; j++) {
00583       if (normalized_path[j] == '\\') {   
00584        normalized_path[j] = '/';
00585       }
00586     }
00587   }
00588 
00589   /* Check for an existing instance: */
00590   if (check_for_another[0] != 'n') {
00591     int alreadyrunning;
00592     HANDLE mutex;
00593 
00594     /* This mutex creation synchronizes multiple instances of
00595        the application that may have been started. */
00596     j = strlen(normalized_path);
00597     b = CreateUniqueName();
00598     l = strlen(b);
00599     a = (char *)malloc(j + l + 50);
00600     memcpy(a, normalized_path, j);
00601     memcpy(a + j, b, l);
00602     memcpy(a + j + l, "MrEd-" MRED_GUID, strlen(MRED_GUID) + 6);
00603     mutex = CreateMutex(NULL, FALSE, a);
00604     alreadyrunning = (GetLastError() == ERROR_ALREADY_EXISTS || 
00605                     GetLastError() == ERROR_ACCESS_DENIED);
00606     // The call fails with ERROR_ACCESS_DENIED if the Mutex was 
00607     // created in a different users session because of passing
00608     // NULL for the SECURITY_ATTRIBUTES on Mutex creation);
00609     wm_is_mred = RegisterWindowMessage(a);
00610     free(a);
00611     
00612     if (alreadyrunning) {
00613       /* If another instance has been started, try to find it. */
00614       if (!EnumWindows((WNDENUMPROC)CheckWindow, (LPARAM)argv)) {
00615        return 0;
00616       }
00617     }
00618   }
00619 
00620   wma.wm_is_mred = wm_is_mred;
00621   wma.hInstance = hInstance;
00622   wma.hPrevInstance = hPrevInstance;
00623   wma.argc = argc;
00624   wma.argv = argv;
00625   wma.nCmdShow = nCmdShow;
00626 
00627   return scheme_main_stack_setup(1, WinMain_after_stack, &wma);
00628 }
00629 
00630 # ifdef MZ_PRECISE_GC
00631 START_XFORM_SKIP;
00632 # endif
00633 
00634 int APIENTRY WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR ignored, int nCmdShow)
00635 {
00636   /* Order matters: load dependencies first */
00637 # ifndef MZ_PRECISE_GC
00638   load_delayed_dll(NULL, "libmzgcxxxxxxx.dll");
00639 # endif
00640   load_delayed_dll(NULL, "libmzsch" DLL_3M_SUFFIX "xxxxxxx.dll");
00641   load_delayed_dll(NULL, "libmred" DLL_3M_SUFFIX "xxxxxxx.dll");
00642   record_dll_path();
00643 
00644   return WinMain_dlls_ready(hInstance, hPrevInstance, ignored, nCmdShow);
00645 }
00646 
00647 # ifdef MZ_PRECISE_GC
00648 END_XFORM_SKIP;
00649 # endif
00650 
00651 #if _MSC_VER >= 1400
00652 #pragma comment(linker,"/manifestdependency:\"type='win32' name='Microsoft.Windows.Common-Controls' version='6.0.0.0' processorArchitecture='*' publicKeyToken='6595b64144ccf1df' language='*'\"")
00653 #endif
00654 
00655 #endif