diff options
Diffstat (limited to 'win32caml/startocaml.c')
| -rw-r--r-- | win32caml/startocaml.c | 533 |
1 files changed, 270 insertions, 263 deletions
diff --git a/win32caml/startocaml.c b/win32caml/startocaml.c index 37ebde1c2..578d407cb 100644 --- a/win32caml/startocaml.c +++ b/win32caml/startocaml.c @@ -10,49 +10,55 @@ /* */ /***********************************************************************/ +/***********************************************************************/ +/* Changes made by Chris Watford to enhance the source editor */ +/* Began 14 Sept 2003 - watford@uiuc.edu */ +/***********************************************************************/ + /* $Id$ */ #include <windows.h> #include <stdio.h> -#include <direct.h> #include <io.h> +#include <direct.h> #include "inria.h" +extern int _get_osfhandle(int); PROCESS_INFORMATION pi; #define BUFSIZE 4096 STARTUPINFO startInfo; /*------------------------------------------------------------------------ - Procedure: ShowDbgMsg ID:1 - Purpose: Puts up a dialog box with a message, forcing it to - the foreground. - Input: - Output: - Errors: +Procedure: ShowDbgMsg ID:1 +Purpose: Puts up a dialog box with a message, forcing it to +the foreground. +Input: +Output: +Errors: ------------------------------------------------------------------------*/ void ShowDbgMsg(char *str) { - HWND hWnd; - char p[20], message[255]; - hWnd = hwndMain; - if (IsIconic(hWnd)){ - ShowWindow(hWnd,SW_RESTORE); - } - strncpy(message, str, 254); - message[254] = 0; - strcpy(p, "Error"); - MessageBox(hWnd, message, p, MB_OK | MB_ICONHAND|MB_TASKMODAL|MB_SETFOREGROUND); + HWND hWnd; + char p[20], message[255]; + hWnd = hwndMain; + if (IsIconic(hWnd)){ + ShowWindow(hWnd,SW_RESTORE); + } + strncpy(message, str, 254); + message[254] = 0; + strcpy(p, "Error"); + MessageBox(hWnd, message, p, MB_OK | MB_ICONHAND|MB_TASKMODAL|MB_SETFOREGROUND); } int AskYesOrNo(char *msg) { - HWND hwnd; - int r; - - hwnd = hwndMain; - r = MessageBox(hwnd, msg, "Ocaml", MB_YESNO | MB_SETFOREGROUND); - if (r == IDYES) - return (TRUE); - return (FALSE); + HWND hwnd; + int r; + + hwnd = hwndMain; + r = MessageBox(hwnd, msg, "Ocaml", MB_YESNO | MB_SETFOREGROUND); + if (r == IDYES) + return (TRUE); + return (FALSE); } @@ -60,305 +66,306 @@ static DWORD OcamlStatus; static int RegistryError(void) { - char buf[512]; + char buf[512]; - wsprintf(buf,"Error %d writing to the registry",GetLastError()); - ShowDbgMsg(buf); - return 0; + wsprintf(buf,"Error %d writing to the registry",GetLastError()); + ShowDbgMsg(buf); + return 0; } static int ReadRegistry(HKEY hroot, - char * p1, char * p2, char * p3, - char dest[1024]) + char * p1, char * p2, char * p3, + char dest[1024]) { - HKEY h1, h2; - DWORD dwType; - unsigned long size; - LONG ret; - - if (RegOpenKeyExA(hroot, p1, 0, KEY_QUERY_VALUE, &h1) != ERROR_SUCCESS) - return 0; - if (RegOpenKeyExA(h1, p2, 0, KEY_QUERY_VALUE, &h2) != ERROR_SUCCESS) { - RegCloseKey(h1); - return 0; - } - dwType = REG_SZ; - size = 1024; - ret = RegQueryValueExA(h2, p3, 0, &dwType, dest, &size); - RegCloseKey(h2); - RegCloseKey(h1); - return ret == ERROR_SUCCESS; + HKEY h1, h2; + DWORD dwType; + unsigned long size; + LONG ret; + + if (RegOpenKeyExA(hroot, p1, 0, KEY_QUERY_VALUE, &h1) != ERROR_SUCCESS) + return 0; + if (RegOpenKeyExA(h1, p2, 0, KEY_QUERY_VALUE, &h2) != ERROR_SUCCESS) { + RegCloseKey(h1); + return 0; + } + dwType = REG_SZ; + size = 1024; + ret = RegQueryValueExA(h2, p3, 0, &dwType, dest, &size); + RegCloseKey(h2); + RegCloseKey(h1); + return ret == ERROR_SUCCESS; } static int WriteRegistry(HKEY hroot, - char * p1, char * p2, char * p3, - char data[1024]) + char * p1, char * p2, char * p3, + char data[1024]) { - HKEY h1, h2; - DWORD disp; - LONG ret; - - if (RegOpenKeyExA(hroot, p1, 0, KEY_QUERY_VALUE, &h1) != ERROR_SUCCESS) - return 0; - if (RegCreateKeyExA(h1, p2, 0, NULL, 0, KEY_ALL_ACCESS, NULL, &h2, &disp) - != ERROR_SUCCESS) { - RegCloseKey(h1); - return 0; - } - ret = RegSetValueEx(h2, p3, 0, REG_SZ, data, strlen(data) + 1); - RegCloseKey(h2); - RegCloseKey(h1); - return ret == ERROR_SUCCESS; + HKEY h1, h2; + DWORD disp; + LONG ret; + + if (RegOpenKeyExA(hroot, p1, 0, KEY_QUERY_VALUE, &h1) != ERROR_SUCCESS) + return 0; + if (RegCreateKeyExA(h1, p2, 0, NULL, 0, KEY_ALL_ACCESS, NULL, &h2, &disp) + != ERROR_SUCCESS) { + RegCloseKey(h1); + return 0; + } + ret = RegSetValueEx(h2, p3, 0, REG_SZ, data, strlen(data) + 1); + RegCloseKey(h2); + RegCloseKey(h1); + return ret == ERROR_SUCCESS; } /*------------------------------------------------------------------------ - Procedure: GetOcamlPath ID:1 - Purpose: Read the registry key - HKEY_LOCAL_MACHINE\Software\Objective Caml - or - HKEY_CURRENT_USER\Software\Objective Caml, - and creates it if it doesn't exists. - If any error occurs, i.e. the - given path doesn't exist, or the key didn't exist, it - will put up a browse dialog box to allow the user to - enter the path. The path will be verified that it - points to a file that exists. If that file is in a - directory called 'bin', it will look for another - directory in the same level called lib' and set the - Lib path to that. - Input: None explicit - Output: 1 means sucess, zero failure - Errors: Almost all system calls will be verified +Procedure: GetOcamlPath ID:1 +Purpose: Read the registry key +HKEY_LOCAL_MACHINE\Software\Objective Caml +or +HKEY_CURRENT_USER\Software\Objective Caml, +and creates it if it doesn't exists. +If any error occurs, i.e. the +given path doesn't exist, or the key didn't exist, it +will put up a browse dialog box to allow the user to +enter the path. The path will be verified that it +points to a file that exists. If that file is in a +directory called 'bin', it will look for another +directory in the same level called lib' and set the +Lib path to that. +Input: None explicit +Output: 1 means sucess, zero failure +Errors: Almost all system calls will be verified ------------------------------------------------------------------------*/ int GetOcamlPath(void) { - char path[1024], *p; - - again: - if (! ReadRegistry(HKEY_CURRENT_USER, - "Software", "Objective Caml", - "InterpreterPath", path) - && - ! ReadRegistry(HKEY_LOCAL_MACHINE, - "Software", "Objective Caml", - "InterpreterPath", path)) { - /* Key doesn't exist? Ask user */ - path[0] = '\0'; - if (!BrowseForFile("Ocaml interpreter|ocaml.exe", path)) { - ShowDbgMsg("Impossible to find ocaml.exe. I quit"); - exit(0); - } - WriteRegistry(HKEY_CURRENT_USER, - "Software", "Objective Caml", - "InterpreterPath", path); - } - /* Check if file exists */ - if (_access(path, 0) != 0) { - char *errormsg = malloc(1024); - wsprintf(errormsg,"Incorrect path for ocaml.exe:\n%s", path); - ShowDbgMsg(errormsg); - free(errormsg); - path[0] = 0; - WriteRegistry(HKEY_CURRENT_USER, - "Software", "Objective Caml", - "InterpreterPath", path); - goto again; - } - strcpy(OcamlPath, path); - p = strrchr(OcamlPath,'\\'); - if (p) { - *p = 0; - strcpy(LibDir,OcamlPath); - *p = '\\'; - p = strrchr(LibDir,'\\'); - if (p && !stricmp(p,"\\bin")) { - *p = 0; - strcat(LibDir,"\\lib"); - } - } - return 1; + char path[1024], *p; + +again: + if (! ReadRegistry(HKEY_CURRENT_USER, + "Software", "Objective Caml", + "InterpreterPath", path) + && + ! ReadRegistry(HKEY_LOCAL_MACHINE, + "Software", "Objective Caml", + "InterpreterPath", path)) { + /* Key doesn't exist? Ask user */ + if (!BrowseForFile("Ocaml interpreter|ocaml.exe", path)) { + ShowDbgMsg("Impossible to find ocaml.exe. I quit"); + exit(0); + } + WriteRegistry(HKEY_CURRENT_USER, + "Software", "Objective Caml", + "InterpreterPath", path); + } + /* Check if file exists */ + if (_access(path, 0) != 0) { + char *errormsg = malloc(1024); + wsprintf(errormsg,"Incorrect path for ocaml.exe:\n%s", path); + ShowDbgMsg(errormsg); + free(errormsg); + path[0] = 0; + WriteRegistry(HKEY_CURRENT_USER, + "Software", "Objective Caml", + "InterpreterPath", path); + goto again; + } + strcpy(OcamlPath, path); + p = strrchr(OcamlPath,'\\'); + if (p) { + *p = 0; + strcpy(LibDir,OcamlPath); + *p = '\\'; + p = strrchr(LibDir,'\\'); + if (p && !stricmp(p,"\\bin")) { + *p = 0; + strcat(LibDir,"\\lib"); + } + } + return 1; } static HANDLE hChildStdinRd, hChildStdinWr,hChildStdoutRd, hChildStdoutWr; /*------------------------------------------------------------------------ - Procedure: IsWindowsNT ID:1 - Purpose: Returns 1 if we are running under windows NT, zero - otherwise. - Input: None - Output: 1 or zero - Errors: +Procedure: IsWindowsNT ID:1 +Purpose: Returns 1 if we are running under windows NT, zero +otherwise. +Input: None +Output: 1 or zero +Errors: ------------------------------------------------------------------------*/ int IsWindowsNT(void) { - OSVERSIONINFO osv; + OSVERSIONINFO osv; - osv.dwOSVersionInfoSize = sizeof(osv); - GetVersionEx(&osv); - return(osv.dwPlatformId == VER_PLATFORM_WIN32_NT); + osv.dwOSVersionInfoSize = sizeof(osv); + GetVersionEx(&osv); + return(osv.dwPlatformId == VER_PLATFORM_WIN32_NT); } /*------------------------------------------------------------------------ - Procedure: DoStartOcaml ID:1 - Purpose: Starts the ocaml interpreter ocaml.exe. The standard - input of the interpreter will be connected to a pipe, - and the standard output and standard error to another - pipe. The interpreter starts as a hidden process, - showing only in the task list. Since this is in an - own thread, its workings are independent of the rest - of the program. After starting the interpreter, the - thread waits in case the interpreter exits, for - instance if the user or some program types #quit;;. - In this case, the waiting thread awakens and exits - the user interface. - Input: Not used. It uses the OcamlPath global variable, that - is supposed to be correct, no test for its validity - are done here. - Output: None visible - Errors: If any system call for whatever reason fails, the - thread will exit. No error message is shown. +Procedure: DoStartOcaml ID:1 +Purpose: Starts the ocaml interpreter ocaml.exe. The standard +input of the interpreter will be connected to a pipe, +and the standard output and standard error to another +pipe. The interpreter starts as a hidden process, +showing only in the task list. Since this is in an +own thread, its workings are independent of the rest +of the program. After starting the interpreter, the +thread waits in case the interpreter exits, for +instance if the user or some program types #quit;;. +In this case, the waiting thread awakens and exits +the user interface. +Input: Not used. It uses the OcamlPath global variable, that +is supposed to be correct, no test for its validity +are done here. +Output: None visible +Errors: If any system call for whatever reason fails, the +thread will exit. No error message is shown. ------------------------------------------------------------------------*/ -DWORD _stdcall DoStartOcaml(LPVOID param) +int _stdcall DoStartOcaml(HWND hwndParent) { - char *cmdline; - int processStarted; - LPSECURITY_ATTRIBUTES lpsa=NULL; - SECURITY_ATTRIBUTES sa; - SECURITY_DESCRIPTOR sd; - HWND hwndParent = (HWND) param; - - sa.nLength = sizeof(SECURITY_ATTRIBUTES); - // Under windows NT/2000/Whistler we have to initialize the security descriptors - // This is not necessary under windows 98/95. - if (IsWindowsNT()) { - InitializeSecurityDescriptor(&sd,SECURITY_DESCRIPTOR_REVISION); - SetSecurityDescriptorDacl(&sd,TRUE,NULL,FALSE); - sa.bInheritHandle = TRUE; - sa.lpSecurityDescriptor = &sd; - lpsa = &sa; - } - memset(&startInfo,0,sizeof(STARTUPINFO)); - startInfo.cb = sizeof(STARTUPINFO); - // Create a pipe for the child process's STDOUT. - if (! CreatePipe(&hChildStdoutRd, &hChildStdoutWr, &sa, 0)) - return 0; - // Create a pipe for the child process's STDIN. - if (! CreatePipe(&hChildStdinRd, &hChildStdinWr, &sa, 0)) - return 0; - // Setup the start info structure - startInfo.dwFlags = STARTF_USESTDHANDLES|STARTF_USESHOWWINDOW; - startInfo.wShowWindow = SW_HIDE; - startInfo.hStdOutput = hChildStdoutWr; - startInfo.hStdError = hChildStdoutWr; - startInfo.hStdInput = hChildStdinRd; - cmdline = OcamlPath; - // Set the OCAMLLIB environment variable - SetEnvironmentVariable("OCAMLLIB", LibDir); - // Let's go: start the ocaml interpreter - processStarted = CreateProcess(NULL,cmdline,lpsa,lpsa,1, - CREATE_NEW_PROCESS_GROUP|NORMAL_PRIORITY_CLASS, - NULL,ProgramParams.CurrentWorkingDir,&startInfo,&pi); - if (processStarted) { - WaitForSingleObject(pi.hProcess,INFINITE); - GetExitCodeProcess(pi.hProcess,(unsigned long *)&OcamlStatus); - CloseHandle(pi.hProcess); - PostMessage(hwndMain,WM_QUITOCAML,0,0); - } - else { - char *msg = malloc(1024); - wsprintf(msg,"Impossible to start ocaml.exe in:\n%s",cmdline); - ShowDbgMsg(msg); - free(msg); - } - return 0; + char *cmdline; + int processStarted; + LPSECURITY_ATTRIBUTES lpsa=NULL; + SECURITY_ATTRIBUTES sa; + SECURITY_DESCRIPTOR sd; + + sa.nLength = sizeof(SECURITY_ATTRIBUTES); + // Under windows NT/2000/Whistler we have to initialize the security descriptors + // This is not necessary under windows 98/95. + if (IsWindowsNT()) { + InitializeSecurityDescriptor(&sd,SECURITY_DESCRIPTOR_REVISION); + SetSecurityDescriptorDacl(&sd,TRUE,NULL,FALSE); + sa.bInheritHandle = TRUE; + sa.lpSecurityDescriptor = &sd; + lpsa = &sa; + } + memset(&startInfo,0,sizeof(STARTUPINFO)); + startInfo.cb = sizeof(STARTUPINFO); + // Create a pipe for the child process's STDOUT. + if (! CreatePipe(&hChildStdoutRd, &hChildStdoutWr, &sa, 0)) + return 0; + // Create a pipe for the child process's STDIN. + if (! CreatePipe(&hChildStdinRd, &hChildStdinWr, &sa, 0)) + return 0; + // Setup the start info structure + startInfo.dwFlags = STARTF_USESTDHANDLES|STARTF_USESHOWWINDOW; + startInfo.wShowWindow = SW_HIDE; + startInfo.hStdOutput = hChildStdoutWr; + startInfo.hStdError = hChildStdoutWr; + startInfo.hStdInput = hChildStdinRd; + cmdline = OcamlPath; + // Set the OCAMLLIB environment variable + SetEnvironmentVariable("OCAMLLIB", LibDir); + // Let's go: start the ocaml interpreter + processStarted = CreateProcess(NULL,cmdline,lpsa,lpsa,1, + CREATE_NEW_PROCESS_GROUP|NORMAL_PRIORITY_CLASS, + NULL,ProgramParams.CurrentWorkingDir,&startInfo,&pi); + if (processStarted) { + WaitForSingleObject(pi.hProcess,INFINITE); + GetExitCodeProcess(pi.hProcess,(unsigned long *)&OcamlStatus); + CloseHandle(pi.hProcess); + PostMessage(hwndMain,WM_QUITOCAML,0,0); + } + else { + char *msg = malloc(1024); + wsprintf(msg,"Impossible to start ocaml.exe in:\n%s",cmdline); + ShowDbgMsg(msg); + free(msg); + } + return 0; } /*------------------------------------------------------------------------ - Procedure: WriteToPipe ID:1 - Purpose: Writes the given character string to the standard - input of the interpreter - Input: The character string (zero terminated) to be written - Output: The number of characters written or zero if an error - occurs - Errors: None +Procedure: WriteToPipe ID:1 +Purpose: Writes the given character string to the standard +input of the interpreter +Input: The character string (zero terminated) to be written +Output: The number of characters written or zero if an error +occurs +Errors: None ------------------------------------------------------------------------*/ int WriteToPipe(char *data) { - DWORD dwWritten; - if (! WriteFile(hChildStdinWr, data, strlen(data), - &dwWritten, NULL)) - return 0; - return dwWritten; + DWORD dwWritten; + + if (! WriteFile(hChildStdinWr, data, strlen(data), &dwWritten, NULL)) + return 0; + + return dwWritten; } /*------------------------------------------------------------------------ - Procedure: ReadFromPipe ID:1 - Purpose: Reads from the standard output of the interpreter and - stores the data in the given buffer up to the given - length. This is done in a non-blocking manner, i.e. - it is safe to call this even if there is no data - available. - Input: The buffer to be used and its length. - Output: Returns the number of characters read from the pipe. - Errors: None explicit +Procedure: ReadFromPipe ID:1 +Purpose: Reads from the standard output of the interpreter and +stores the data in the given buffer up to the given +length. This is done in a non-blocking manner, i.e. +it is safe to call this even if there is no data +available. +Input: The buffer to be used and its length. +Output: Returns the number of characters read from the pipe. +Errors: None explicit ------------------------------------------------------------------------*/ int ReadFromPipe(char *data,int len) { - DWORD dwRead; + DWORD dwRead; - PeekNamedPipe(hChildStdoutRd,data,len,NULL,&dwRead,NULL); - if (dwRead == 0) - return 0; + PeekNamedPipe(hChildStdoutRd,data,len,NULL,&dwRead,NULL); + if (dwRead == 0) + return 0; - // Read output from the child process, and write to parent's STDOUT. - if( !ReadFile( hChildStdoutRd, data, len, &dwRead, - NULL) || dwRead == 0) - return 0; - return dwRead; + // Read output from the child process, and write to parent's STDOUT. + if( !ReadFile( hChildStdoutRd, data, len, &dwRead, NULL) || dwRead == 0) + return 0; + + return dwRead; } static DWORD tid; /*------------------------------------------------------------------------ - Procedure: StartOcaml ID:1 - Purpose: Starts the thread that will call the ocaml.exe - program. - Input: - Output: - Errors: +Procedure: StartOcaml ID:1 +Purpose: Starts the thread that will call the ocaml.exe +program. +Input: +Output: +Errors: ------------------------------------------------------------------------*/ int StartOcaml(void) { - getcwd(ProgramParams.CurrentWorkingDir,sizeof(ProgramParams.CurrentWorkingDir)); - CreateThread(NULL,0,DoStartOcaml,hwndMain,0,&tid); - return 1; + getcwd(ProgramParams.CurrentWorkingDir,sizeof(ProgramParams.CurrentWorkingDir)); + CreateThread(NULL,0,DoStartOcaml,hwndMain,0,&tid); + return 1; } void *SafeMalloc(int size) { - void *result; + void *result; - if (size < 0) { - char message[1024]; + if (size < 0) { + char message[1024]; error: - sprintf(message,"Can't allocate %d bytes",size); - MessageBox(NULL,message,"Ocaml",MB_OK); - exit(-1); - } - result = malloc(size); - if (result == NULL) - goto error; - return result; + sprintf(message,"Can't allocate %d bytes",size); + MessageBox(NULL, message, "Ocaml", MB_OK); + exit(-1); + } + result = malloc(size); + + if (result == NULL) + goto error; + + return result; } void InterruptOcaml(void) { - if (! GenerateConsoleCtrlEvent(CTRL_BREAK_EVENT, pi.dwProcessId)) { - char message[1024]; - sprintf(message, "GenerateConsole failed: %ld\n", GetLastError()); - MessageBox(NULL, message, "Ocaml", MB_OK); - } - WriteToPipe(" "); + if (!GenerateConsoleCtrlEvent(CTRL_BREAK_EVENT, pi.dwProcessId)) { + char message[1024]; + sprintf(message, "GenerateConsole failed: %d\n", GetLastError()); + MessageBox(NULL, message, "Ocaml", MB_OK); + } + WriteToPipe(" "); } |