diff options
| -rw-r--r-- | win32caml/Makefile | 5 | ||||
| -rw-r--r-- | win32caml/inria.h | 33 | ||||
| -rw-r--r-- | win32caml/menu.c | 292 | ||||
| -rw-r--r-- | win32caml/ocaml.c | 1955 | ||||
| -rw-r--r-- | win32caml/ocaml.rc | 323 | ||||
| -rw-r--r-- | win32caml/startocaml.c | 533 |
6 files changed, 2129 insertions, 1012 deletions
diff --git a/win32caml/Makefile b/win32caml/Makefile index 397448c42..498e4dc5f 100644 --- a/win32caml/Makefile +++ b/win32caml/Makefile @@ -18,7 +18,8 @@ include ../config/Makefile CC=$(BYTECC) CFLAGS=$(BYTECCCOMPOPTS) -OBJS=startocaml.$(O) ocamlres.$(O) ocaml.$(O) menu.$(O) +OBJS=startocaml.$(O) ocamlres.$(O) ocaml.$(O) menu.$(O) \ + history.$(O) editbuffer.$(O) LIBS=$(call SYSLIB,kernel32) $(call SYSLIB,advapi32) $(call SYSLIB,gdi32) \ $(call SYSLIB,user32) $(call SYSLIB,comdlg32) $(call SYSLIB,comctl32) @@ -38,7 +39,7 @@ ifeq ($(TOOLCHAIN),mingw) windres -i ocaml.rc -o $@ endif -$(OBJS): inria.h inriares.h +$(OBJS): inria.h inriares.h history.h editbuffer.h clean: rm -f ocamlwin.exe *.$(O) *.pdb ocamlwin.ilk diff --git a/win32caml/inria.h b/win32caml/inria.h index afa252404..13949d52d 100644 --- a/win32caml/inria.h +++ b/win32caml/inria.h @@ -56,8 +56,12 @@ something in the pipe. This is enough for most applications. ------------------------------------------------------------------------*/ +#ifndef _INRIA_H_ +#define _INRIA_H_ #include <windows.h> +#include "editbuffer.h" +#include "history.h" // In this structure should go eventually all global variables scattered // through the program. @@ -90,26 +94,33 @@ void HandleCommand(HWND hwnd, WPARAM wParam,LPARAM lParam); int GetOcamlPath(void); // Finds where ocaml.exe is void ForceRepaint(void); // Ditto. void AddLineToControl(char *buf); +void AddStringToControl(char* buf); char *GetHistoryLine(int n); // Gets the nth history line base 1. int StartOcaml(void); +void InterruptOcaml(void); +int ResetText(void); +BOOL SendingFullCommand(void); +void RewriteCurrentEditBuffer(void); +void RefreshCurrentEditBuffer(void); + // **************** User defined window messages ************* -#define WM_NEWLINE (WM_USER+6000) -#define WM_TIMERTICK (WM_USER+6001) -#define WM_QUITOCAML (WM_USER+6002) +#define WM_NEWLINE (WM_USER+6000) +#define WM_TIMERTICK (WM_USER+6001) +#define WM_QUITOCAML (WM_USER+6002) +#define WM_SYNTAXERROR (WM_USER+6003) +#define WM_UNBOUNDVAL (WM_USER+6004) +#define WM_ILLEGALCHAR (WM_USER+6005) + // ********************** Structures *********************** typedef struct tagPosition { int line; int col; } POSITION; -// Simple linked list for holding the history lines -typedef struct tagHistory { - struct tagHistory *Next; - char *Text; -} HISTORYLINE; - extern void *SafeMalloc(int); -extern HISTORYLINE *History; // The root of the history lines +extern StatementHistory *History; // The root of the history lines +extern StatementHistory *HistoryTail; // The tail of the history lines +extern EditBuffer *CurrentEditBuffer; // current edit buffer #define IDEDITCONTROL 15432 - +#endif diff --git a/win32caml/menu.c b/win32caml/menu.c index 34815d89f..6ed736f73 100644 --- a/win32caml/menu.c +++ b/win32caml/menu.c @@ -10,6 +10,11 @@ /* */ /***********************************************************************/ +/***********************************************************************/ +/* Changes made by Chris Watford to enhance the source editor */ +/* Began 14 Sept 2003 - watford@uiuc.edu */ +/***********************************************************************/ + /* $Id$ */ #include <stdio.h> @@ -17,12 +22,13 @@ #include <Richedit.h> #include "inria.h" #include "inriares.h" +#include "history.h" -void InterruptOcaml(void); LOGFONT CurrentFont; int CurrentFontFamily = (FIXED_PITCH | FF_MODERN); int CurrentFontStyle; char CurrentFontName[64] = "Courier"; + /*------------------------------------------------------------------------ Procedure: OpenMlFile ID:1 Purpose: Opens a file, either a source file (*.ml) or an *.cmo @@ -68,6 +74,7 @@ int OpenMlFile(char *fname,int lenbuf) } return r; } + /*------------------------------------------------------------------------ Procedure: GetSaveName ID:1 Purpose: Get a name to save the current session (Save as menu @@ -111,6 +118,51 @@ int GetSaveName(char *fname,int lenbuf) return 0; else return 1; } + +/*------------------------------------------------------------------------ + Procedure: GetSaveMLName ID:1 + Purpose: Get a name to save the current OCaml code to (Save as menu + item) + Input: A buffer where the name of the file will be stored, + and its length + Output: The name of the file choosen by the user will be + stored in the buffer + Errors: none +------------------------------------------------------------------------*/ +int GetSaveMLName(char *fname, int lenbuf) +{ + OPENFILENAME ofn; + int r; + char *p,defext[5],tmp[512]; + + memset(&ofn,0,sizeof(OPENFILENAME)); + memset(tmp,0,sizeof(tmp)); + fname[0] = 0; + strcpy(tmp,"OCaml Source Files|*.ml"); + p = tmp; + while (*p) { + if (*p == '|') + *p = 0; + p++; + } + strcpy(defext,"ml"); + ofn.lStructSize = sizeof(OPENFILENAME); + ofn.hwndOwner = hwndMain; + ofn.lpstrFilter = tmp; + ofn.nFilterIndex = 1; + ofn.hInstance = hInst; + ofn.lpstrFile = fname; + ofn.lpstrTitle = "Save as"; + ofn.lpstrInitialDir = LibDir; + ofn.nMaxFile = lenbuf; + ofn.Flags = OFN_NOCHANGEDIR | OFN_LONGNAMES | + OFN_HIDEREADONLY |OFN_EXPLORER; + r = GetSaveFileName(&ofn); + if (r == 0) + return 0; + else return 1; +} + /*------------------------------------------------------------------------ Procedure: BrowseForFile ID:1 Purpose: Let's the user browse for a certain kind of file. @@ -304,6 +356,13 @@ void ForceRepaint(void) InvalidateRect(hwndEdit,NULL,1); } +/*------------------------------------------------------------------------ + Procedure: Add_Char_To_Queue ID:1 + Purpose: Puts a character onto the buffer + Input: The char to be added + Output: None + Errors: +------------------------------------------------------------------------*/ static void Add_Char_To_Queue(int c) { HWND hwndEdit = (HWND)GetWindowLong(hwndSession,DWL_USER); @@ -326,13 +385,47 @@ void AddLineToControl(char *buf) if (*buf == 0) return; + hEditCtrl = (HWND)GetWindowLong(hwndSession,DWL_USER); + GotoEOF(); + SendMessage(hEditCtrl,EM_REPLACESEL,0,(LPARAM)buf); SendMessage(hEditCtrl,WM_CHAR,'\r',0); } /*------------------------------------------------------------------------ + Procedure: AddStringToControl ID:1 + Author: Chris Watford watford@uiuc.edu + Purpose: It will ad the given text at the end of the edit + control. This simulates user input. The history will not + be modified by this procedure. + Input: The text to be added + Output: None + Errors: If the line is empty, nothing will be done +-------------------------------------------------------------------------- +Edit History: + 16 Sept 2003 - Chris Watford watford@uiuc.edu + - Basically this is AddLineToControl, but without appending a + newline +------------------------------------------------------------------------*/ +void AddStringToControl(char* buf) +{ + HWND hEditCtrl; + + if(buf == NULL) + return; + + if((*buf) == 0) + return; + + hEditCtrl = (HWND)GetWindowLong(hwndSession, DWL_USER); + GotoEOF(); + + SendMessage(hEditCtrl ,EM_REPLACESEL, (WPARAM)FALSE, (LPARAM)buf); +} + +/*------------------------------------------------------------------------ Procedure: AboutDlgProc ID:1 Purpose: Shows the "About" dialog box Input: @@ -345,6 +438,7 @@ static BOOL CALLBACK AboutDlgProc(HWND hDlg, UINT message, WPARAM wParam, LPARAM EndDialog(hDlg,1); return 0; } + /*------------------------------------------------------------------------ Procedure: HistoryDlgProc ID:1 Purpose: Shows the history of the session. Only input lines @@ -355,24 +449,33 @@ static BOOL CALLBACK AboutDlgProc(HWND hDlg, UINT message, WPARAM wParam, LPARAM Input: Normal windows callback Output: Errors: +-------------------------------------------------------------------------- +Edit History: + 15 Sept 2003 - Chris Watford watford@uiuc.edu + - Added support for my StatementHistory structure + - Added the ability to export it as its exact entry, rather than + just a 1 liner ------------------------------------------------------------------------*/ static BOOL CALLBACK HistoryDlgProc(HWND hDlg, UINT message, WPARAM wParam, LPARAM lParam) { - HISTORYLINE *rvp; + StatementHistory *histentry; int idx; RECT rc; switch (message) { case WM_INITDIALOG: SendDlgItemMessage(hDlg,IDLIST,WM_SETFONT,(WPARAM)ProgramParams.hFont,0); - rvp = History; + histentry = History; // get our statement history object idx = 0; - while (rvp) { - SendDlgItemMessage(hDlg,IDLIST,LB_INSERTSTRING,0,(LPARAM)rvp->Text); + + // loop through each history entry adding it to the dialog + while (histentry != NULL) { + SendDlgItemMessage(hDlg,IDLIST,LB_INSERTSTRING,0,(LPARAM)editbuffer_getasline(histentry->Statement)); SendDlgItemMessage(hDlg,IDLIST,LB_SETITEMDATA,0,(LPARAM)idx); - rvp = rvp->Next; + histentry = histentry->Next; idx++; } + SendDlgItemMessage(hDlg,IDLIST,LB_SETCURSEL,(LPARAM)idx-1,0); return 1; case WM_COMMAND: @@ -401,6 +504,7 @@ static BOOL CALLBACK HistoryDlgProc(HWND hDlg, UINT message, WPARAM wParam, LPAR } return 0; } + /*------------------------------------------------------------------------ Procedure: SaveText ID:1 Purpose: Saves the contents of the session transcript. It will @@ -409,6 +513,10 @@ static BOOL CALLBACK HistoryDlgProc(HWND hDlg, UINT message, WPARAM wParam, LPAR Output: The session is saved Errors: If it can't open the file for writing it will show an error box +-------------------------------------------------------------------------- + Edit History: + 06 Oct 2003 - Chris Watford watford@uiuc.edu + - Corrected wsprintf error ------------------------------------------------------------------------*/ static void SaveText(char *fname) { @@ -419,54 +527,155 @@ static void SaveText(char *fname) char *buf = SafeMalloc(8192); f = fopen(fname,"wb"); - if (f == NULL) { - wsprintf("Impossible to open %s for writing",fname); - ShowDbgMsg(buf); - return; + if (f == NULL) + { + // corrected error using wsprintf + wsprintf(buf, "Impossible to open %s for writing", fname); + + ShowDbgMsg(buf); + return; } - for (i=0; i<linesCount;i++) { + + for (i = 0; i < linesCount; i++) + { *(unsigned short *)buf = 8100; - len = SendMessage(hEdit,EM_GETLINE,i,(LPARAM)buf); - buf[len] = 0; - strcat(buf,"\r\n"); - fwrite(buf,1,len+2,f); + len = SendMessage(hEdit, EM_GETLINE, i, (LPARAM)buf); + buf[len] = '\0'; + fprintf(f, "%s\r\n", buf+1); + //fwrite(buf,1,len+2,f); } + fclose(f); free(buf); } +/*------------------------------------------------------------------------ + Procedure: SaveML ID:1 + Author: Chris Watford watford@uiuc.edu + Purpose: Saves the ML source to a file, commenting out functions + that contained errors + Input: The name of the file where the session will be saved + Output: The session is saved + Errors: If it can't open the file for writing it will show an + error box +------------------------------------------------------------------------*/ +static void SaveML(char *fname) +{ + FILE *f; + char *buf = SafeMalloc(8192); + + f = fopen(fname, "wb"); + + if(f == NULL) + { + wsprintf(buf, "Impossible to open %s for writing", fname); + ShowDbgMsg(buf); + return; + } + + fprintf(f, "(* %s *)\r\n\r\n", fname); + + if(History != NULL) + { + StatementHistory *h = NULL; + EditBuffer *stmt = NULL; + + // get to the end + for(h = History; h->Next != NULL; h = h->Next); + + // go back :( + // this is NOT the fastest method, BUT this is the easiest + // on the subsystem + for(; h != NULL; h = h->Prev) + { + stmt = h->Statement; + + if(stmt != NULL) + { + // comment out incorrect lines + if(stmt->isCorrect) + { + char *buff = editbuffer_getasbuffer(stmt); + fprintf(f, "%s\r\n", buff); + free(buff); + } else { + char *buff = editbuffer_getasbuffer(stmt); + fprintf(f, "(* Syntax Error or Unbound Value\r\n%s\r\n *)\r\n", buff); + free(buff); + } + } + + fprintf(f, "\r\n"); + } + } + + fclose(f); + free(buf); +} +/*------------------------------------------------------------------------ + Procedure: Add_Clipboard_To_Queue ID:1 + Author: Chris Watford watford@uiuc.edu + Purpose: Adds the clipboard text to the control + Input: + Output: + Errors: +-------------------------------------------------------------------------- + Edit History: + 16 Sept 2003 - Chris Watford watford@uiuc.edu + - Added method to update edit buffer with paste contents +------------------------------------------------------------------------*/ static void Add_Clipboard_To_Queue(void) { - if (IsClipboardFormatAvailable(CF_TEXT) && - OpenClipboard(hwndMain)) + if (IsClipboardFormatAvailable(CF_TEXT) && OpenClipboard(hwndMain)) { HANDLE hClipData = GetClipboardData(CF_TEXT); - if (hClipData) + if (hClipData != NULL) { char *str = GlobalLock(hClipData); - if (str) - while (*str) + if (str != NULL) + { + while ((*str) != 0) { if (*str != '\r') Add_Char_To_Queue(*str); + str++; } + + // added to fix odd errors + RefreshCurrentEditBuffer(); + } + GlobalUnlock(hClipData); } + CloseClipboard(); } - } +/*------------------------------------------------------------------------ + Procedure: CopyToClipboard ID:1 + Purpose: Copies text to the clipboard + Input: Window with the edit control + Output: + Errors: +------------------------------------------------------------------------*/ static void CopyToClipboard(HWND hwnd) { HWND hwndEdit = (HWND)GetWindowLong(hwndSession,DWL_USER); SendMessage(hwndEdit,WM_COPY,0,0); } +/*------------------------------------------------------------------------ + Procedure: ResetText ID:1 + Purpose: Resets the text? I'm not really sure + Input: + Output: Always returns 0 + Errors: +------------------------------------------------------------------------*/ int ResetText(void) { HWND hwndEdit = (HWND) GetWindowLong(hwndSession,DWL_USER); @@ -495,6 +704,12 @@ int ResetText(void) Input: Output: Errors: +-------------------------------------------------------------------------- + Edit History: + 06 Oct 2003 - Chris Watford watford@uiuc.edu + - Removed entries that crashed OCaml + - Removed useless entries + - Added Save ML and Save Transcript ------------------------------------------------------------------------*/ void HandleCommand(HWND hwnd, WPARAM wParam,LPARAM lParam) { @@ -508,11 +723,11 @@ void HandleCommand(HWND hwnd, WPARAM wParam,LPARAM lParam) char *buf = SafeMalloc(512); char *p = strrchr(fname,'.'); if (p && !stricmp(p,".ml")) { - wsprintf(buf,"#use \"%s\";;",fname); + wsprintf(buf, "#use \"%s\";;", fname); AddLineToControl(buf); } else if (p && !stricmp(p,".cmo")) { - wsprintf(buf,"#load \"%s\";;",fname); + wsprintf(buf, "#load \"%s\";;", fname); AddLineToControl(buf); } free(buf); @@ -531,22 +746,42 @@ void HandleCommand(HWND hwnd, WPARAM wParam,LPARAM lParam) case IDM_EDITCOPY: CopyToClipboard(hwnd); break; - case IDM_SAVE: + + // updated to save a transcript + case IDM_SAVEAS: fname = SafeMalloc(512); if (GetSaveName(fname,512)) { SaveText(fname); } free(fname); break; + + // updated to save an ML file + case IDM_SAVE: + fname = SafeMalloc(512); + if (GetSaveMLName(fname,512)) + { + SaveML(fname); + } + free(fname); + break; + + // updated to work with new history system case IDM_HISTORY: r = CallDlgProc(HistoryDlgProc,IDD_HISTORY); - if (r) { + + if (r) + { AddLineToControl(GetHistoryLine(r-1)); } break; + case IDM_PRINTSU: - CallPrintSetup(); + // Removed by Chris Watford + // seems to die + // CallPrintSetup(); break; + case IDM_FONT: CallChangeFont(hwndMain); break; @@ -563,6 +798,8 @@ void HandleCommand(HWND hwnd, WPARAM wParam,LPARAM lParam) case IDM_EDITUNDO: Undo(hwnd); break; + + /* Removed, really not very useful in this IDE case IDM_WINDOWTILE: SendMessage(hwndMDIClient,WM_MDITILE,0,0); break; @@ -572,6 +809,8 @@ void HandleCommand(HWND hwnd, WPARAM wParam,LPARAM lParam) case IDM_WINDOWICONS: SendMessage(hwndMDIClient,WM_MDIICONARRANGE,0,0); break; + */ + case IDM_EXIT: PostMessage(hwnd,WM_CLOSE,0,0); break; @@ -589,4 +828,3 @@ void HandleCommand(HWND hwnd, WPARAM wParam,LPARAM lParam) break; } } - diff --git a/win32caml/ocaml.c b/win32caml/ocaml.c index 1172b2bd8..0a4e5b481 100644 --- a/win32caml/ocaml.c +++ b/win32caml/ocaml.c @@ -1,4 +1,3 @@ -/***********************************************************************/ /* */ /* Objective Caml */ /* */ @@ -10,14 +9,20 @@ /* */ /***********************************************************************/ +/***********************************************************************/ +/* Changes made by Chris Watford to enhance the source editor */ +/* Began 14 Sept 2003 - watford@uiuc.edu */ +/***********************************************************************/ + /* $Id$ */ /*@@ Wedit generated application. Written Sat Jun 02 18:22:38 2001 - @@header: D:\lcc\inria\inriares.h - @@resources: D:\lcc\inria\inria.rc - Do not edit outside the indicated areas */ -/*<---------------------------------------------------------------------->*/ +@@header: D:\lcc\inria\inriares.h +@@resources: D:\lcc\inria\inria.rc +Do not edit outside the indicated areas */ /*<---------------------------------------------------------------------->*/ + +#include <stdio.h> #include <windows.h> #include <windowsx.h> #include <commctrl.h> @@ -26,10 +31,13 @@ #include <Richedit.h> #include "inriares.h" #include "inria.h" + +#define VK_BACKSPACE 0x108 + +/*<---------------------------------------------------------------------->*/ int EditControls = IDEDITCONTROL; static WNDPROC lpEProc; static char lineBuffer[1024*32]; -int ResetText(void); int ReadToLineBuffer(void); int AddLineBuffer(void); static int busy; @@ -40,7 +48,11 @@ char OcamlPath[512]; HBRUSH BackgroundBrush; COLORREF BackColor = RGB(255,255,255); PROGRAM_PARAMS ProgramParams; -HISTORYLINE *History; +StatementHistory *History = NULL; +StatementHistory *HistoryTail = NULL; +StatementHistory *historyEntry = NULL; +EditBuffer *CurrentEditBuffer = NULL; // current edit buffer + /*<----------------- global variables --------------------------------------->*/ HANDLE hInst; // Instance handle HWND hwndMain; //Main window handle @@ -52,765 +64,1472 @@ PROCESS_INFORMATION pi; HWND hWndStatusbar; /*------------------------------------------------------------------------ - Procedure: UpdateStatusBar ID:1 - Purpose: Updates the statusbar control with the appropiate - text - Input: lpszStatusString: Charactar string that will be shown - partNumber: index of the status bar part number. - displayFlags: Decoration flags - Output: none - Errors: none +Procedure: UpdateStatusBar ID:1 +Purpose: Updates the statusbar control with the appropiate +text +Input: lpszStatusString: Charactar string that will be shown +partNumber: index of the status bar part number. +displayFlags: Decoration flags +Output: none +Errors: none ------------------------------------------------------------------------*/ void UpdateStatusBar(LPSTR lpszStatusString, WORD partNumber, WORD displayFlags) { - SendMessage(hWndStatusbar, - SB_SETTEXT, - partNumber | displayFlags, - (LPARAM)lpszStatusString); + SendMessage(hWndStatusbar, + SB_SETTEXT, + partNumber | displayFlags, + (LPARAM)lpszStatusString); } /*------------------------------------------------------------------------ - Procedure: MsgMenuSelect ID:1 - Purpose: Shows in the status bar a descriptive explaation of - the purpose of each menu item.The message - WM_MENUSELECT is sent when the user starts browsing - the menu for each menu item where the mouse passes. - Input: Standard windows. - Output: The string from the resources string table is shown - Errors: If the string is not found nothing will be shown. +Procedure: MsgMenuSelect ID:1 +Purpose: Shows in the status bar a descriptive explaation of +the purpose of each menu item.The message +WM_MENUSELECT is sent when the user starts browsing +the menu for each menu item where the mouse passes. +Input: Standard windows. +Output: The string from the resources string table is shown +Errors: If the string is not found nothing will be shown. ------------------------------------------------------------------------*/ LRESULT MsgMenuSelect(HWND hwnd, UINT uMessage, WPARAM wparam, LPARAM lparam) { - static char szBuffer[256]; - UINT nStringID = 0; - UINT fuFlags = GET_WM_MENUSELECT_FLAGS(wparam, lparam) & 0xffff; - UINT uCmd = GET_WM_MENUSELECT_CMD(wparam, lparam); - HMENU hMenu = GET_WM_MENUSELECT_HMENU(wparam, lparam); - - szBuffer[0] = 0; // First reset the buffer - if (fuFlags == 0xffff && hMenu == NULL) // Menu has been closed - nStringID = 0; - - else if (fuFlags & MFT_SEPARATOR) // Ignore separators - nStringID = 0; - - else if (fuFlags & MF_POPUP) // Popup menu - { - if (fuFlags & MF_SYSMENU) // System menu - nStringID = IDS_SYSMENU; - else - // Get string ID for popup menu from idPopup array. - nStringID = 0; - } // for MF_POPUP - else // Must be a command item - nStringID = uCmd; // String ID == Command ID - - // Load the string if we have an ID - if (0 != nStringID) - LoadString(hInst, nStringID, szBuffer, sizeof(szBuffer)); - // Finally... send the string to the status bar - UpdateStatusBar(szBuffer, 0, 0); - return 0; + static char szBuffer[256]; + UINT nStringID = 0; + UINT fuFlags = GET_WM_MENUSELECT_FLAGS(wparam, lparam) & 0xffff; + UINT uCmd = GET_WM_MENUSELECT_CMD(wparam, lparam); + HMENU hMenu = GET_WM_MENUSELECT_HMENU(wparam, lparam); + + szBuffer[0] = 0; // First reset the buffer + if (fuFlags == 0xffff && hMenu == NULL) // Menu has been closed + nStringID = 0; + + else if (fuFlags & MFT_SEPARATOR) // Ignore separators + nStringID = 0; + + else if (fuFlags & MF_POPUP) // Popup menu + { + if (fuFlags & MF_SYSMENU) // System menu + nStringID = IDS_SYSMENU; + else + // Get string ID for popup menu from idPopup array. + nStringID = 0; + } // for MF_POPUP + else // Must be a command item + nStringID = uCmd; // String ID == Command ID + + // Load the string if we have an ID + if (0 != nStringID) + LoadString(hInst, nStringID, szBuffer, sizeof(szBuffer)); + // Finally... send the string to the status bar + UpdateStatusBar(szBuffer, 0, 0); + return 0; } /*------------------------------------------------------------------------ - Procedure: TimerProc ID:1 - Purpose: This procedure will be called by windows about 4 - times a second. It will just send a message to the - mdi child window to look at the pipe. - Input: - Output: - Errors: +Procedure: TimerProc ID:1 +Purpose: This procedure will be called by windows about 4 +times a second. It will just send a message to the +mdi child window to look at the pipe. +Input: +Output: +Errors: ------------------------------------------------------------------------*/ static VOID CALLBACK TimerProc(HWND hwnd, UINT uMsg, UINT idEvent, DWORD dwTime) { - SendMessage(hwndSession, WM_TIMERTICK, 0, 0); + SendMessage(hwndSession, WM_TIMERTICK, 0, 0); } /*------------------------------------------------------------------------ - Procedure: InitializeStatusBar ID:1 - Purpose: Initialize the status bar - Input: hwndParent: the parent window - nrOfParts: The status bar can contain more than one - part. What is difficult, is to figure out how this - should be drawn. So, for the time being only one is - being used... - Output: The status bar is created - Errors: +Procedure: InitializeStatusBar ID:1 +Purpose: Initialize the status bar +Input: hwndParent: the parent window +nrOfParts: The status bar can contain more than one +part. What is difficult, is to figure out how this +should be drawn. So, for the time being only one is +being used... +Output: The status bar is created +Errors: ------------------------------------------------------------------------*/ void InitializeStatusBar(HWND hwndParent,int nrOfParts) { - const int cSpaceInBetween = 8; - int ptArray[40]; // Array defining the number of parts/sections - RECT rect; - HDC hDC; + const int cSpaceInBetween = 8; + int ptArray[40]; // Array defining the number of parts/sections + RECT rect; + HDC hDC; - /* * Fill in the ptArray... */ + /* * Fill in the ptArray... */ - hDC = GetDC(hwndParent); - GetClientRect(hwndParent, &rect); + hDC = GetDC(hwndParent); + GetClientRect(hwndParent, &rect); - ptArray[nrOfParts-1] = rect.right; - //---TODO--- Add code to calculate the size of each part of the status - // bar here. + ptArray[nrOfParts-1] = rect.right; + //---TODO--- Add code to calculate the size of each part of the status + // bar here. - ReleaseDC(hwndParent, hDC); - SendMessage(hWndStatusbar, - SB_SETPARTS, - nrOfParts, - (LPARAM)(LPINT)ptArray); + ReleaseDC(hwndParent, hDC); + SendMessage(hWndStatusbar, + SB_SETPARTS, + nrOfParts, + (LPARAM)(LPINT)ptArray); - UpdateStatusBar("Ready", 0, 0); + UpdateStatusBar("Ready", 0, 0); } /*------------------------------------------------------------------------ - Procedure: CreateSBar ID:1 - Purpose: Calls CreateStatusWindow to create the status bar - Input: hwndParent: the parent window - initial text: the initial contents of the status bar - Output: - Errors: +Procedure: CreateSBar ID:1 +Purpose: Calls CreateStatusWindow to create the status bar +Input: hwndParent: the parent window +initial text: the initial contents of the status bar +Output: +Errors: ------------------------------------------------------------------------*/ static BOOL CreateSBar(HWND hwndParent,char *initialText,int nrOfParts) { - hWndStatusbar = CreateStatusWindow(WS_CHILD | WS_VISIBLE | WS_BORDER|SBARS_SIZEGRIP, - initialText, - hwndParent, - IDM_STATUSBAR); - if(hWndStatusbar) - { - InitializeStatusBar(hwndParent,nrOfParts); - return TRUE; - } - - return FALSE; + hWndStatusbar = CreateStatusWindow(WS_CHILD | WS_VISIBLE | WS_BORDER|SBARS_SIZEGRIP, + initialText, + hwndParent, + IDM_STATUSBAR); + if(hWndStatusbar) + { + InitializeStatusBar(hwndParent,nrOfParts); + return TRUE; + } + + return FALSE; } /*------------------------------------------------------------------------ - Procedure: InitApplication ID:1 - Purpose: Registers two window classes: the "inria" window - class with the main window, and the mdi child - window's window class. - Input: - Output: - Errors: +Procedure: InitApplication ID:1 +Purpose: Registers two window classes: the "inria" window +class with the main window, and the mdi child +window's window class. +Input: +Output: +Errors: ------------------------------------------------------------------------*/ static BOOL InitApplication(void) { - WNDCLASS wc; - - memset(&wc,0,sizeof(WNDCLASS)); - wc.style = CS_HREDRAW|CS_VREDRAW |CS_DBLCLKS ; - wc.lpfnWndProc = (WNDPROC)MainWndProc; - wc.hInstance = hInst; - wc.hbrBackground = (HBRUSH)(COLOR_WINDOW+1); - wc.lpszClassName = "inriaWndClass"; - wc.lpszMenuName = MAKEINTRESOURCE(IDMAINMENU); - wc.hCursor = LoadCursor(NULL,IDC_ARROW); - wc.hIcon = LoadIcon(hInst,MAKEINTRESOURCE(OCAML_ICON)); - if (!RegisterClass(&wc)) - return 0; - wc.style = 0; - wc.lpfnWndProc = (WNDPROC)MdiChildWndProc; - wc.cbClsExtra = 0; - wc.cbWndExtra = 20; - wc.hInstance = hInst; // Owner of this class - wc.hIcon = LoadIcon(hInst, MAKEINTRESOURCE(OCAML_ICON)); - wc.hCursor = LoadCursor(NULL, IDC_ARROW); - wc.hbrBackground = (HBRUSH)(COLOR_WINDOW + 1); // Default color - wc.lpszMenuName = NULL; - wc.lpszClassName = "MdiChildWndClass"; - if (!RegisterClass((LPWNDCLASS)&wc)) - return FALSE; - return 1; + WNDCLASS wc; + + memset(&wc,0,sizeof(WNDCLASS)); + wc.style = CS_HREDRAW|CS_VREDRAW |CS_DBLCLKS ; + wc.lpfnWndProc = (WNDPROC)MainWndProc; + wc.hInstance = hInst; + wc.hbrBackground = (HBRUSH)(COLOR_WINDOW+1); + wc.lpszClassName = "inriaWndClass"; + wc.lpszMenuName = MAKEINTRESOURCE(IDMAINMENU); + wc.hCursor = LoadCursor(NULL,IDC_ARROW); + wc.hIcon = LoadIcon(hInst,MAKEINTRESOURCE(OCAML_ICON)); + if (!RegisterClass(&wc)) + return 0; + wc.style = 0; + wc.lpfnWndProc = (WNDPROC)MdiChildWndProc; + wc.cbClsExtra = 0; + wc.cbWndExtra = 20; + wc.hInstance = hInst; // Owner of this class + wc.hIcon = LoadIcon(hInst, MAKEINTRESOURCE(OCAML_ICON)); + wc.hCursor = LoadCursor(NULL, IDC_ARROW); + wc.hbrBackground = (HBRUSH)(COLOR_WINDOW + 1); // Default color + wc.lpszMenuName = NULL; + wc.lpszClassName = "MdiChildWndClass"; + if (!RegisterClass((LPWNDCLASS)&wc)) + return FALSE; + return 1; } /*------------------------------------------------------------------------ - Procedure: CreateinriaWndClassWnd ID:1 - Purpose: Creates the main window - Input: - Output: - Errors: +Procedure: CreateinriaWndClassWnd ID:1 +Purpose: Creates the main window +Input: +Output: +Errors: ------------------------------------------------------------------------*/ HWND CreateinriaWndClassWnd(void) { - return CreateWindow("inriaWndClass","Ocaml", - WS_MINIMIZEBOX|WS_VISIBLE|WS_CLIPSIBLINGS|WS_CLIPCHILDREN|WS_MAXIMIZEBOX|WS_CAPTION|WS_BORDER|WS_SYSMENU|WS_THICKFRAME, - CW_USEDEFAULT,0,CW_USEDEFAULT,0, - NULL, - NULL, - hInst, - NULL); + return CreateWindow("inriaWndClass","OCamlWinPlus v1.9RC4", + WS_MINIMIZEBOX|WS_VISIBLE|WS_CLIPSIBLINGS|WS_CLIPCHILDREN|WS_MAXIMIZEBOX|WS_CAPTION|WS_BORDER|WS_SYSMENU|WS_THICKFRAME, + CW_USEDEFAULT,0,CW_USEDEFAULT,0, + NULL, + NULL, + hInst, + NULL); } /*------------------------------------------------------------------------ - Procedure: MDICmdFileNew ID:1 - Purpose: Creates a new session window. Note that multiple - windows with multiple sessions are possible. - Input: - Output: - Errors: +Procedure: MDICmdFileNew ID:1 +Purpose: Creates a new session window. Note that multiple +windows with multiple sessions are possible. +Input: +Output: +Errors: ------------------------------------------------------------------------*/ static HWND MDICmdFileNew(char *title, int show) { - HWND hwndChild; - char rgch[150]; - static int cUntitled; - MDICREATESTRUCT mcs; + HWND hwndChild; + char rgch[150]; + static int cUntitled; + MDICREATESTRUCT mcs; + + if (title == NULL) + wsprintf(rgch,"Session%d", cUntitled++); + else { + strncpy(rgch,title,149); + rgch[149] = 0; + } + + // Create the MDI child window + + mcs.szClass = "MdiChildWndClass"; // window class name + mcs.szTitle = rgch; // window title + mcs.hOwner = hInst; // owner + mcs.x = CW_USEDEFAULT; // x position + mcs.y = CW_USEDEFAULT; // y position + mcs.cx = CW_USEDEFAULT; // width + mcs.cy = CW_USEDEFAULT; // height + mcs.style = 0; // window style + mcs.lParam = 0; // lparam + + hwndChild = (HWND) SendMessage(hwndMDIClient, + WM_MDICREATE, + 0, + (LPARAM)(LPMDICREATESTRUCT) &mcs); + + if (hwndChild != NULL && show) + ShowWindow(hwndChild, SW_SHOW); + + return hwndChild; +} +static HWND CreateMdiClient(HWND hwndparent) +{ + CLIENTCREATESTRUCT ccs = {0}; + HWND hwndMDIClient; + int icount = GetMenuItemCount(GetMenu(hwndparent)); + + // Find window menu where children will be listed + ccs.hWindowMenu = GetSubMenu(GetMenu(hwndparent), icount-2); + ccs.idFirstChild = IDM_WINDOWCHILD; + + // Create the MDI client filling the client area + hwndMDIClient = CreateWindow("mdiclient", + NULL, + WS_CHILD | WS_CLIPCHILDREN | WS_VSCROLL | + WS_HSCROLL, + 0, 0, 0, 0, + hwndparent, + (HMENU)0xCAC, + hInst, + (LPVOID)&ccs); + + ShowWindow(hwndMDIClient, SW_SHOW); + + return hwndMDIClient; +} - if (title == NULL) - wsprintf(rgch,"Session%d", cUntitled++); - else { - strncpy(rgch,title,149); - rgch[149] = 0; - } +void GotoEOF(void) +{ + HWND hEdit = (HWND)GetWindowLong(hwndSession,DWL_USER); + int linesCount = SendMessage(hEdit,EM_GETLINECOUNT,0,0); + int lineindex = SendMessage(hEdit,EM_LINEINDEX,linesCount-1,0); + int lastLineLength = SendMessage(hEdit,EM_LINELENGTH,linesCount-1,0); - // Create the MDI child window + lineindex += lastLineLength; + SendMessage(hEdit,EM_SETSEL,lineindex,lineindex); +} - mcs.szClass = "MdiChildWndClass"; // window class name - mcs.szTitle = rgch; // window title - mcs.hOwner = hInst; // owner - mcs.x = CW_USEDEFAULT; // x position - mcs.y = CW_USEDEFAULT; // y position - mcs.cx = CW_USEDEFAULT; // width - mcs.cy = CW_USEDEFAULT; // height - mcs.style = 0; // window style - mcs.lParam = 0; // lparam +/*------------------------------------------------------------------------ +Procedure: GotoPrompt ID:1 +Author: Chris Watford watford@uiuc.edu +Purpose: Puts the cursor on the prompt line right after the '# ' +Input: +Output: +Errors: +------------------------------------------------------------------------*/ +void GotoPrompt(void) +{ + HWND hEdit = (HWND)GetWindowLong(hwndSession,DWL_USER); + int lineindex = SendMessage(hEdit,EM_LINEINDEX,LastPromptPosition.line,0)+2; + SendMessage(hEdit,EM_SETSEL,lineindex,lineindex); +} - hwndChild = (HWND) SendMessage(hwndMDIClient, - WM_MDICREATE, - 0, - (LPARAM)(LPMDICREATESTRUCT) &mcs); +int GetCurLineIndex(HWND hEdit) +{ + return SendMessage(hEdit,EM_LINEFROMCHAR,(WPARAM)-1,0); +} - if (hwndChild != NULL && show) - ShowWindow(hwndChild, SW_SHOW); +int GetNumberOfLines(HWND hEdit) +{ + return SendMessage(hEdit,EM_GETLINECOUNT,0,0); +} - return hwndChild; +static int GetWordUnderCursor(HWND hwndEditControl,char *buf,int len) +{ + char *line,*p,*pstart,*pend; + int lineidx,start,end,length,offset,cursorpos,startingChar; + + SendMessage(hwndEditControl,EM_GETSEL,(WPARAM)&start,(LPARAM)&end); + lineidx = SendMessage(hwndEditControl,EM_EXLINEFROMCHAR,0,start); + startingChar = SendMessage(hwndEditControl,EM_LINEINDEX,lineidx,0); + start -= startingChar; + end -= startingChar; + lineidx = SendMessage(hwndEditControl,EM_LINEFROMCHAR,start,0); + length = SendMessage(hwndEditControl,EM_LINELENGTH,lineidx,0); + offset = SendMessage(hwndEditControl,EM_LINEINDEX,lineidx,0); + line = SafeMalloc(length+1); + memset(line,0,length+1); + *(unsigned short *)line = length; + SendMessage(hwndEditControl,EM_GETLINE,lineidx,(LPARAM)line); + cursorpos = start-offset; + p = line + cursorpos; + pstart = p; + while (*pstart + && *pstart != ' ' + && *pstart != '\t' + && *pstart != '(' + && pstart > line) + pstart--; + pend = p; + while (*pend + && *pend != ' ' + && *pend != '\t' + && *pend != '(' + && pend < line + length) + pend++; + if (*pstart == ' ' || *pstart == '\t') + pstart++; + if (*pend == ' ' || *pend == '\t') + pend--; + memcpy(buf,pstart,1+pend-pstart); + buf[pend-pstart] = 0; + free(line); + return 1; } -static HWND CreateMdiClient(HWND hwndparent) + +/*------------------------------------------------------------------------ +Procedure: GetLastLine ID:1 +Purpose: Gets the data in the line containing the cursor to + the interpreter. +Input: The edit control window handle +Output: None explicit +Errors: None +------------------------------------------------------------------------*/ +char* GetLastLine(HWND hEdit) { - CLIENTCREATESTRUCT ccs = {0}; - HWND hwndMDIClient; - int icount = GetMenuItemCount(GetMenu(hwndparent)); + int curline = GetCurLineIndex(hEdit); + char *linebuffer = (char*)SafeMalloc(2048*sizeof(char)); + int n; + int linescount = GetNumberOfLines(hEdit); - // Find window menu where children will be listed - ccs.hWindowMenu = GetSubMenu(GetMenu(hwndparent), icount-2); - ccs.idFirstChild = IDM_WINDOWCHILD; + *(unsigned short *)linebuffer = 2047; + n = SendMessage(hEdit,EM_GETLINE,curline,(LPARAM)linebuffer); - // Create the MDI client filling the client area - hwndMDIClient = CreateWindow("mdiclient", - NULL, - WS_CHILD | WS_CLIPCHILDREN | WS_VSCROLL | - WS_HSCROLL, - 0, 0, 0, 0, - hwndparent, - (HMENU)0xCAC, - hInst, - (LPVOID)&ccs); + if (n >= 2 && linebuffer[0] == '#' && linebuffer[1] == ' ') { + n -= 2; + memmove(linebuffer, linebuffer+2, n); + } - ShowWindow(hwndMDIClient, SW_SHOW); + linebuffer[n] = '\0'; - return hwndMDIClient; + return linebuffer; } -void GotoEOF(void) +void DoHelp(HWND hwnd) { - HWND hEdit = (HWND)GetWindowLong(hwndSession,DWL_USER); - int linesCount = SendMessage(hEdit,EM_GETLINECOUNT,0,0); - int lineindex = SendMessage(hEdit,EM_LINEINDEX,linesCount-1,0); - int lastLineLength = SendMessage(hEdit,EM_LINELENGTH,linesCount-1,0); - - lineindex += lastLineLength; - SendMessage(hEdit,EM_SETSEL,lineindex,lineindex); + char word[256]; + GetWordUnderCursor(hwnd,word,sizeof(word)); + MessageBox(NULL,word,"Aide pour:",MB_OK); } -int GetCurLineIndex(HWND hEdit) +/*------------------------------------------------------------------------ +Procedure: RewriteCurrentEditBuffer ID:1 +Purpose: Rewrites what is at the prompt with the current contents of + the edit buffer +Input: None +Output: None explicit +Errors: None +------------------------------------------------------------------------*/ +void RewriteCurrentEditBuffer(void) { - return SendMessage(hEdit,EM_LINEFROMCHAR,(WPARAM)-1,0); + // get the editbox's handle + HWND hEdit = (HWND)GetWindowLong(hwndSession,DWL_USER); + + // calculate what to highlight + int linesCount = SendMessage(hEdit,EM_GETLINECOUNT,0,0); + int lineindex = SendMessage(hEdit,EM_LINEINDEX,LastPromptPosition.line,0) + 2; + int lastLine = SendMessage(hEdit,EM_LINEINDEX,linesCount-1,0) + SendMessage(hEdit,EM_LINELENGTH,linesCount-1,0) + 100; + + // delete the current text + SendMessage(hEdit, EM_SETSEL, (WPARAM)lineindex, (LPARAM)lastLine); + SendMessage(hEdit, EM_REPLACESEL, (WPARAM)TRUE, (LPARAM)""); + + { + // loop through each line in the edit buffer and add it to the control + LineList* line = CurrentEditBuffer->Lines; + for(; line != NULL; line = line->Next) + { + // if there is a line before me, add a newline + if(line->Prev != NULL) + SendMessage(hEdit, EM_REPLACESEL, (WPARAM)TRUE, (LPARAM)"\r\n"); + + // add the line + SendMessage(hEdit, EM_REPLACESEL, (WPARAM)TRUE, (LPARAM)line->Text); + } + } } -int GetNumberOfLines(HWND hEdit) +/*------------------------------------------------------------------------ +Procedure: RefreshCurrentEditBuffer ID:1 +Purpose: Rewrites what is in the CurrentEditBuffer with what is + actually there +Input: None +Output: None explicit +Errors: None +------------------------------------------------------------------------*/ +void RefreshCurrentEditBuffer(void) { - return SendMessage(hEdit,EM_GETLINECOUNT,0,0); + // get the editbox's handle + HWND hEdit = (HWND)GetWindowLong(hwndSession,DWL_USER); + + // get the last line index + int linesCount = SendMessage(hEdit,EM_GETLINECOUNT,0,0) - 1; + int i = 0, n = 0; + + // where to hold the line we grab + char *linebuffer = (char*)SafeMalloc(2048*sizeof(char)); + *(unsigned short *)linebuffer = 2047; + + editbuffer_destroy(CurrentEditBuffer); + CurrentEditBuffer = editbuffer_new(); + + // loop through each line updating or adding it to the current edit buffer + for( ; (i + LastPromptPosition.line) <= linesCount; i++) + { + n = SendMessage(hEdit, EM_GETLINE, (i + LastPromptPosition.line), (LPARAM)linebuffer); + + if ((n >= 2) && (linebuffer[0] == '#') && (linebuffer[1] == ' ')) { + n -= 2; + memmove(linebuffer, linebuffer+2, n); + } + + linebuffer[n] = '\0'; + + { // remove line breaks and feeds + char* ln = linebuffer; + + while((*ln) != 0) + { + switch((*ln)) + { + case '\r': + case '\n': + (*ln) = ' '; + } + + ln++; + } + } + + editbuffer_addline(CurrentEditBuffer, linebuffer); + } } -static int GetWordUnderCursor(HWND hwndEditControl,char *buf,int len) +/*------------------------------------------------------------------------ +Procedure: NextHistoryEntry ID:1 +Purpose: Scrolls to the next history entry +Input: None +Output: None explicit +Errors: None +-------------------------------------------------------------------------- +Edit History: + 17 Sept 2003 - Chris Watford watford@uiuc.edu + - Added this as a helper function + 18 Sept 2003 - Chris Watford watford@uiuc.edu + - Corrected doubly linked list problems +------------------------------------------------------------------------*/ +void NextHistoryEntry(void) { - char *line,*p,*pstart,*pend; - int lineidx,start,end,length,offset,cursorpos,startingChar; - - SendMessage(hwndEditControl,EM_GETSEL,(WPARAM)&start,(LPARAM)&end); - lineidx = SendMessage(hwndEditControl,EM_EXLINEFROMCHAR,0,start); - startingChar = SendMessage(hwndEditControl,EM_LINEINDEX,lineidx,0); - start -= startingChar; - end -= startingChar; - lineidx = SendMessage(hwndEditControl,EM_LINEFROMCHAR,start,0); - length = SendMessage(hwndEditControl,EM_LINELENGTH,lineidx,0); - offset = SendMessage(hwndEditControl,EM_LINEINDEX,lineidx,0); - line = SafeMalloc(length+1); - memset(line,0,length+1); - *(unsigned short *)line = length; - SendMessage(hwndEditControl,EM_GETLINE,lineidx,(LPARAM)line); - cursorpos = start-offset; - p = line + cursorpos; - pstart = p; - while (*pstart - && *pstart != ' ' - && *pstart != '\t' - && *pstart != '(' - && pstart > line) - pstart--; - pend = p; - while (*pend - && *pend != ' ' - && *pend != '\t' - && *pend != '(' - && pend < line + length) - pend++; - if (*pstart == ' ' || *pstart == '\t') - pstart++; - if (*pend == ' ' || *pend == '\t') - pend--; - memcpy(buf,pstart,1+pend-pstart); - buf[pend-pstart] = 0; - free(line); - return 1; + // out of bounds, put it back into bounds + if(historyEntry == NULL && History == NULL) + { + return; + } else if (historyEntry == NULL && History != NULL) { + historyEntry = History; + } else { + if(historyEntry->Next == NULL) + return; + + historyEntry = historyEntry->Next; + } + + // if its valid + if(historyEntry != NULL) + { + // copy the history entry to a new buffer + EditBuffer* newBuf = editbuffer_copy(historyEntry->Statement); + + // destroy the old buffer + editbuffer_destroy(CurrentEditBuffer); + + // setup the current one to the copy + CurrentEditBuffer = newBuf; + + // rewrite the old one and go to the prompt + RewriteCurrentEditBuffer(); + GotoPrompt(); + } } -void DoHelp(HWND hwnd) +/*------------------------------------------------------------------------ +Procedure: PrevHistoryEntry ID:1 +Purpose: Scrolls to the previous history entry +Input: None +Output: None explicit +Errors: None +-------------------------------------------------------------------------- +Edit History: + 17 Sept 2003 - Chris Watford watford@uiuc.edu + - Added this as a helper function + 18 Sept 2003 - Chris Watford watford@uiuc.edu + - Corrected doubly linked list problems +------------------------------------------------------------------------*/ +void PrevHistoryEntry(void) { - char word[256]; - GetWordUnderCursor(hwnd,word,sizeof(word)); - MessageBox(NULL,word,"Aide pour:",MB_OK); + // out of bounds, put it back into bounds + if(historyEntry == NULL || History == NULL) + { + return; + } else { + if(historyEntry->Prev == NULL) + return; + + historyEntry = historyEntry->Prev; + } + + // if its valid + if(historyEntry != NULL) + { + // copy the history entry to a new buffer + EditBuffer* newBuf = editbuffer_copy(historyEntry->Statement); + + // destroy the old buffer + editbuffer_destroy(CurrentEditBuffer); + + // setup the current one to the copy + CurrentEditBuffer = newBuf; + + // rewrite the old one and go to the prompt + RewriteCurrentEditBuffer(); + GotoPrompt(); + } } - +/*------------------------------------------------------------------------ +Procedure: SubClassEdit ID:1 +Purpose: Handles messages to the editbox +Input: +Output: +Errors: +-------------------------------------------------------------------------- +Edit History: + 14 Sept 2003 - Chris Watford watford@uiuc.edu + - Setup handler for up and down arrows + 15 Sept 2003 - Chris Watford watford@uiuc.edu + - Setup framework for history on up arrow + - Saves lines you move off of in the edit buffer + 16 Sept 2003 - Chris Watford watford@uiuc.edu + - Proper handling of newline message finished + - Fixed ENTER on middle of interior line, moves cursor to the end + and sends the line + - Setup the copying and destroying of the old buffer + - Included buffer rewrite + 17 Sept 2003 - Chris Watford watford@uiuc.edu + - Added C-p/C-n support + - Changed UpArrow to C-UpArrow so as to not confuse users + 18 Sept 2003 - Chris Watford watford@uiuc.edu + - Added Left and Right arrow line saving + - Added backspace and delete line saving and removing + - Fixed history scrolling + 21 Sept 2003 - Chris Watford watford@uiuc.edu + - Fixed pasting errors associated with lines being out of bounds + for the buffer + - Added error handling, possibly able to handle it diff down the + line + - Removed C-Up/C-Dn for history scrolling, buggy at best on my + machine +------------------------------------------------------------------------*/ static LRESULT CALLBACK SubClassEdit(HWND hwnd, UINT msg, WPARAM mp1, LPARAM mp2) { - LRESULT r; - int postit=0,nl; - if (msg == WM_CHAR && mp1 == '\r') { - if (!busy) { - CallWindowProc(lpEProc,hwnd,WM_KEYDOWN,VK_END,1); - CallWindowProc(lpEProc,hwnd,WM_KEYUP,VK_END,1); - r = GetCurLineIndex(hwnd); - nl = GetNumberOfLines(hwnd); - if (r != nl-1) { - PostMessage(GetParent(hwnd),WM_NEWLINE,0,0); - return 0; - } - postit = 1; - } - - } - else if (msg == WM_KEYDOWN && mp1 == VK_F1) { - DoHelp(hwnd); - } - r = CallWindowProc(lpEProc, hwnd, msg, mp1, mp2); - if (postit) - PostMessage(GetParent(hwnd),WM_NEWLINE,0,0); - return r; + LRESULT r; + int postit=0,nl; + + if (msg == WM_CHAR && mp1 == '\r') { + if (!busy) { + r = GetCurLineIndex(hwnd); + nl = GetNumberOfLines(hwnd); + + // if we're not the last line + if (r != nl-1) + { + // update or add us, we might not have any lines in the edit buffer + editbuffer_updateoraddline(CurrentEditBuffer, r-LastPromptPosition.line, GetLastLine(hwnd)); + + // scroll to the end, add CrLf then post the newline message + GotoEOF(); + AddStringToControl("\r\n"); + PostMessage(GetParent(hwnd),WM_NEWLINE,0,0); + return 0; + } + + CallWindowProc(lpEProc,hwnd,WM_KEYDOWN,VK_END,1); + CallWindowProc(lpEProc,hwnd,WM_KEYUP,VK_END,1); + + postit = 1; + } + + } + else if (msg == WM_CHAR && mp1 == (char)0x08) { + int lineindex = SendMessage(hwnd, EM_LINEINDEX, LastPromptPosition.line, 0) + 2; + int curline = SendMessage(hwnd,EM_LINEFROMCHAR,(WPARAM)-1,0); + int nextline = 0; + int curpoint = 0; + + SendMessage(hwnd, EM_GETSEL, (WPARAM)&curpoint, (LPARAM)NULL); + nextline = SendMessage(hwnd,EM_LINEFROMCHAR,(WPARAM)(curpoint - 1),0); + + if(curpoint <= lineindex) + { + return 0; + } else if(nextline != curline) { + // delete the line we're on + + // grab the index + curline -= LastPromptPosition.line; + + // kill it + editbuffer_removeline(CurrentEditBuffer, curline); + } + } + else if (msg == WM_KEYDOWN && mp1 == VK_F1) { + DoHelp(hwnd); + } + else if ((msg == WM_KEYDOWN || msg == WM_KEYUP) && mp1 == VK_UP) { + int curline = GetCurLineIndex(hwnd); + + /*if((msg == WM_KEYDOWN) && (GetKeyState(VK_CONTROL) && 0x8000)) + { // go forward once in history + NextHistoryEntry(); + return 0; + } else */ + if((curline > LastPromptPosition.line) && (curline <= (LastPromptPosition.line + CurrentEditBuffer->LineCount))) + { + // update current line + if (msg == WM_KEYDOWN) + { + int lineidx = (curline - LastPromptPosition.line); + + CallWindowProc(lpEProc,hwnd,WM_KEYDOWN,VK_END,1); + CallWindowProc(lpEProc,hwnd,WM_KEYUP,VK_END,1); + + // we may have to add this line, otherwise update it + editbuffer_updateoraddline(CurrentEditBuffer, lineidx, GetLastLine(hwnd)); + } + } else { + return 0; + } + } + else if ((msg == WM_KEYDOWN || msg == WM_KEYUP) && (mp1 == VK_LEFT)) { + int lineindex = SendMessage(hwnd, EM_LINEINDEX, LastPromptPosition.line, 0) + 2; + int curline = SendMessage(hwnd,EM_LINEFROMCHAR,(WPARAM)-1,0); + int nextline = 0; + int curpoint = 0; + + SendMessage(hwnd, EM_GETSEL, (WPARAM)&curpoint, (LPARAM)NULL); + nextline = SendMessage(hwnd,EM_LINEFROMCHAR,(WPARAM)(curpoint - 1),0); + + if(curpoint <= lineindex) + { // no left arrow to the left of the prompt + return 0; + } else if(nextline != curline) { + // update current line + if (msg == WM_KEYDOWN) + { + int lineidx = (curline - LastPromptPosition.line); + + CallWindowProc(lpEProc,hwnd,WM_KEYDOWN,VK_END,1); + CallWindowProc(lpEProc,hwnd,WM_KEYUP,VK_END,1); + + // we may have to add this line, otherwise update it + editbuffer_updateoraddline(CurrentEditBuffer, lineidx, GetLastLine(hwnd)); + + CallWindowProc(lpEProc,hwnd,WM_KEYDOWN,VK_HOME,1); + CallWindowProc(lpEProc,hwnd,WM_KEYUP,VK_HOME,1); + } + } + } + else if ((msg == WM_KEYDOWN || msg == WM_KEYUP) && (mp1 == VK_DOWN)) { + int curline = GetCurLineIndex(hwnd); + + /*if((msg == WM_KEYDOWN) && (GetKeyState(VK_CONTROL) && 0x8000)) + { // go back once in history + PrevHistoryEntry(); + return 0; + } else*/ + if((curline >= LastPromptPosition.line) && (curline < (LastPromptPosition.line + CurrentEditBuffer->LineCount))) + { + // We don't post the newline, but instead update the current line + if (msg == WM_KEYDOWN) + { + int lineidx = (curline - LastPromptPosition.line); + + CallWindowProc(lpEProc,hwnd,WM_KEYDOWN,VK_END,1); + CallWindowProc(lpEProc,hwnd,WM_KEYUP,VK_END,1); + + editbuffer_updateline(CurrentEditBuffer, lineidx, GetLastLine(hwnd)); + } + } else { + return 0; + } + } + else if ((msg == WM_KEYDOWN || msg == WM_KEYUP) && (mp1 == VK_RIGHT)) { + int lineindex = SendMessage(hwnd, EM_LINEINDEX, LastPromptPosition.line, 0) + 1; + int curline = SendMessage(hwnd,EM_LINEFROMCHAR,(WPARAM)-1,0); + int nextline = 0; + int curpoint = 0; + + SendMessage(hwnd, EM_GETSEL, (WPARAM)&curpoint, (LPARAM)NULL); + nextline = SendMessage(hwnd,EM_LINEFROMCHAR,(WPARAM)(curpoint + 2),0); + + if(curpoint <= lineindex) + { // no movement behind the prompt + return 0; + } else if((nextline != curline) && (msg = WM_KEYDOWN)) { + int lineidx = (curline - LastPromptPosition.line); + + CallWindowProc(lpEProc,hwnd,WM_KEYDOWN,VK_END,1); + CallWindowProc(lpEProc,hwnd,WM_KEYUP,VK_END,1); + + editbuffer_updateline(CurrentEditBuffer, lineidx, GetLastLine(hwnd)); + } + } + else if ((msg == WM_KEYDOWN) && (mp1 == VK_PRIOR) && (GetKeyState(VK_CONTROL) && 0x8000)) { + // C-p + NextHistoryEntry(); + return 0; + } + else if ((msg == WM_KEYDOWN) && (mp1 == VK_NEXT) && (GetKeyState(VK_CONTROL) && 0x8000)) { + // C-n + PrevHistoryEntry(); + return 0; + } + else if ((msg == WM_KEYDOWN || msg == WM_KEYUP) && (mp1 == VK_DELETE)) { + // see if we're the last char on the line, if so delete the next line + // don't allow deleting left of the prompt + int lineindex = SendMessage(hwnd, EM_LINEINDEX, LastPromptPosition.line, 0) + 2; + int curline = SendMessage(hwnd,EM_LINEFROMCHAR,(WPARAM)-1,0); + int nextline = 0; + int curpoint = 0; + + SendMessage(hwnd, EM_GETSEL, (WPARAM)&curpoint, (LPARAM)NULL); + nextline = SendMessage(hwnd,EM_LINEFROMCHAR,(WPARAM)(curpoint + 2),0); + + if(curpoint < lineindex) + { // no chomping behind the prompt + return 0; + } else if(nextline != curline) { + // deleting + // grab the next line index + curline -= LastPromptPosition.line; + + // kill it + editbuffer_removeline(CurrentEditBuffer, curline+1); + } + } + else if (msg == WM_PASTE) { + // if they paste text, allow it + r = CallWindowProc(lpEProc, hwnd, msg, mp1, mp2); + + // update the current edit buffer + RefreshCurrentEditBuffer(); + + return r; + } + + // handle errors + switch(msg) + { + case WM_SYNTAXERROR: + case WM_ILLEGALCHAR: + case WM_UNBOUNDVAL: + { // currently I handle them all the same + // get the start of the line + int start = SendMessage(hwnd, EM_LINEINDEX, LastPromptPosition.line, 0) + 2; + + // get the statement that error'd + NextHistoryEntry(); + + // tell the history that the last line errored + if(History != NULL) + if(History->Statement != NULL) + History->Statement->isCorrect = FALSE; + + // highlight the offending chars + SendMessage(hwnd,EM_SETSEL,(WPARAM)(start + mp1), (LPARAM)(start + mp2)); + + return 0; + } + } + + r = CallWindowProc(lpEProc, hwnd, msg, mp1, mp2); + + if (postit) + PostMessage(GetParent(hwnd),WM_NEWLINE,0,0); + + return r; } static void SubClassEditField(HWND hwnd) { - if (lpEProc == NULL) { - lpEProc = (WNDPROC) GetWindowLong(hwnd, GWL_WNDPROC); - } - SetWindowLong(hwnd, GWL_WNDPROC, (DWORD) SubClassEdit); + if (lpEProc == NULL) { + lpEProc = (WNDPROC) GetWindowLong(hwnd, GWL_WNDPROC); + } + SetWindowLong(hwnd, GWL_WNDPROC, (DWORD) SubClassEdit); } -void AddToHistory(char *text) +/*------------------------------------------------------------------------ +Procedure: SendLastLine ID:1 +Purpose: Sends the data in the line containing the cursor to +the interpreter. If this is NOT the last line, copy +the line to the end of the text. +Input: The edit control window handle +Output: None explicit +Errors: None + +REMOVED! +------------------------------------------------------------------------*/ +void SendLastLine(HWND hEdit) { - HISTORYLINE *newLine; - - while (*text == ' ') - text++; // skip leading blanks - if (*text == 0) - return; - if (History && !strstr(History->Text,";;")) { - char *p = History->Text; - int len = strlen(p)+strlen(text) + 1 + 1; // space and zero terminator - History->Text = SafeMalloc(len); - strcpy(History->Text,p); - strcat(History->Text," "); - strcat(History->Text,text); - free(p); - return; - } - newLine = SafeMalloc(sizeof(HISTORYLINE)); - newLine->Next = History; - newLine->Text = SafeMalloc(strlen(text)+1); - strcpy(newLine->Text,text); - History = newLine; +/* int curline = GetCurLineIndex(hEdit); + char *p,linebuffer[2048]; + int n; + int linescount = GetNumberOfLines(hEdit); + + *(unsigned short *)linebuffer = sizeof(linebuffer)-1; + if (curline != linescount-1) + n = SendMessage(hEdit,EM_GETLINE,curline,(LPARAM)linebuffer); + else + n = SendMessage(hEdit,EM_GETLINE,curline-1,(LPARAM)linebuffer); + if (n >= 2 && linebuffer[0] == '#' && linebuffer[1] == ' ') { + n -= 2; + memmove(linebuffer, linebuffer+2, n); + } + linebuffer[n] = 0; + + // Record user input! + AddToHistory(linebuffer); + linebuffer[n] = '\n'; + linebuffer[n+1] = 0; + WriteToPipe(linebuffer); + if (curline != linescount-1) { + // Copy the line sent to the end of the text + p = strrchr(linebuffer,'\n'); + if (p) { + *p = 0; + } + busy = 1; + AddLineToControl(linebuffer); + busy = 0; + }*/ } -char *GetHistoryLine(int n) +/*------------------------------------------------------------------------ +Procedure: SendLastEditBuffer ID:1 +Author: Chris Watford watford@uiuc.edu +Purpose: Sends an edit buffer to the pipe +Input: +Output: +Errors: +-------------------------------------------------------------------------- +Edit History: + 15 Sept 2003 - Chris Watford watford@uiuc.edu + - Sends line to the pipe and adds newline to the end +------------------------------------------------------------------------*/ +void SendLastEditBuffer(HWND hwndChild) { - HISTORYLINE *rvp = History; - int i; + char* line = editbuffer_getasbuffer(CurrentEditBuffer); + int l = strlen(line); + char* linebuffer = (char*)SafeMalloc(l+2); + + // save current edit buffer to history and create a new blank edit buffer + CurrentEditBuffer->isCorrect = TRUE; + AddToHistory(CurrentEditBuffer); + CurrentEditBuffer = (EditBuffer*)SafeMalloc(sizeof(EditBuffer)); + CurrentEditBuffer->LineCount = 0; + CurrentEditBuffer->Lines = NULL; + + // add the newline to the end + strncpy(linebuffer, line, l); + linebuffer[l] = '\n'; + linebuffer[l+1] = '\0'; + + // save line to the pipe + WriteToPipe(linebuffer); +} - for (i=0; i<n; i++) { - rvp = rvp->Next; - } - if (rvp) - return &rvp->Text[0]; - else - return ""; +/*------------------------------------------------------------------------ +Procedure: SendingFullCommand ID:1 +Author: Chris Watford watford@uiuc.edu +Purpose: Returns if the command being sent +Input: The edit control window handle +Output: None explicit +Errors: None +-------------------------------------------------------------------------- +Edit History: + 13 Oct 2003 - Chris Watford watford@uiuc.edu + - Solved the error when you have a malformed comment in the buffer +------------------------------------------------------------------------*/ +BOOL SendingFullCommand(void) +{ + // if there is a ;; on the line, return true + char *line = editbuffer_getasline(CurrentEditBuffer); + char *firstComment = strstr(line, "(*"), *firstSemiColonSemiColon = strstr(line, ";;"); + + // easy case :D + if(firstSemiColonSemiColon == NULL) + { + free(line); + return FALSE; + } + + // if there are no comments + if(firstComment == NULL) + { + BOOL r = (firstSemiColonSemiColon != NULL); + free(line); + return r; + } else { + // we have to search through finding all comments + + // a neat little trick we can do is compare the point at which + // the ;; is and where the first (* can be found, if the ;; is + // before the (* ocaml.exe ignores the comment + if((unsigned int)firstSemiColonSemiColon < (unsigned int)firstComment) + { + free(line); + return TRUE; + } else { + // time to search and find if the endline is inside a comment or not + // start at the first comment, and move forward keeping track of the + // nesting level, if the nest level is 0, i.e. outside a comment + // and we find the ;; return TRUE immediately, otherwise keep searching + // if we end with a nest level >0 return FALSE + + char *c = firstComment+2; // firstComment[0] is the '(', firstComment[1] is the '*' + int nestLevel = 1; // we have a (* + + // in-comment determiner loop + while(c[0] != '\0') + { + // are we an endline + if((c[0] == ';') && (c[1] == ';')) + { + // if we are NOT in a comment, its a full line + if(nestLevel <= 0) + { + free(line); + return TRUE; + } + } + + // are we in a comment? + if((c[0] == '(') && (c[1] == '*')) + { + nestLevel++; + + // watch out we may go past the end + if(c[2] == '\0') + { + free(line); + return FALSE; + } + + // c needs to advance past the *, cause (*) is NOT the start/finish of a comment + c++; + } + + // adjust the nesting down a level + if((c[0] == '*') && (c[1] == ')')) + nestLevel--; + + // next char + c++; + } + + // not a full line + free(line); + return FALSE; + } + } + + // weird case ;) + free(line); + return FALSE; } /*------------------------------------------------------------------------ - Procedure: SendLastLine ID:1 - Purpose: Sends the data in the line containing the cursor to - the interpreter. If this is NOT the last line, copy - the line to the end of the text. - Input: The edit control window handle - Output: None explicit - Errors: None +Procedure: AppendToEditBuffer ID:1 +Author: Chris Watford watford@uiuc.edu +Purpose: Add a line to the edit buffer +Input: Handle of the edit control +Output: +Errors: ------------------------------------------------------------------------*/ -void SendLastLine(HWND hEdit) +void AppendToEditBuffer(HWND hEdit) { - int curline = GetCurLineIndex(hEdit); - char *p,linebuffer[2048]; - int n; - int linescount = GetNumberOfLines(hEdit); - - *(unsigned short *)linebuffer = sizeof(linebuffer)-1; - if (curline != linescount-1) - n = SendMessage(hEdit,EM_GETLINE,curline,(LPARAM)linebuffer); - else - n = SendMessage(hEdit,EM_GETLINE,curline-1,(LPARAM)linebuffer); - if (n >= 2 && linebuffer[0] == '#' && linebuffer[1] == ' ') { - n -= 2; - memmove(linebuffer, linebuffer+2, n); - } - linebuffer[n] = 0; - // Record user input! - AddToHistory(linebuffer); - linebuffer[n] = '\n'; - linebuffer[n+1] = 0; - WriteToPipe(linebuffer); - if (curline != linescount-1) { - // Copy the line sent to the end of the text - p = strrchr(linebuffer,'\n'); - if (p) { - *p = 0; - } - busy = 1; - AddLineToControl(linebuffer); - busy = 0; - } + char *p = NULL, linebuffer[2048]; + int n = 0; + int curline = GetCurLineIndex(hEdit); + int linescount = GetNumberOfLines(hEdit); + + // they are passing the size of the buffer as + // the first 'short' in the array... + *(unsigned short *)linebuffer = sizeof(linebuffer)-1; + + if (curline > (linescount-1)) + { + n = SendMessage(hEdit, EM_GETLINE, curline, (LPARAM)linebuffer); + } else { + n = SendMessage(hEdit, EM_GETLINE, --curline, (LPARAM)linebuffer); + } + + // correct for the prompt line + if (n >= 2 && linebuffer[0] == '#' && linebuffer[1] == ' ') + { + n -= 2; + memmove(linebuffer, linebuffer+2, n); + } + + linebuffer[n] = '\0'; + + // linebuffer now has the line to add to our edit buffer + editbuffer_updateoraddline(CurrentEditBuffer, (curline - LastPromptPosition.line), linebuffer); } + /*------------------------------------------------------------------------ - Procedure: SetLastPrompt ID:1 - Purpose: Record the position of the last prompt ("# ") sent by - the interpreter. This isn't really used yet. - Input: - Output: - Errors: +Procedure: SetLastPrompt ID:1 +Purpose: Record the position of the last prompt ("# ") sent by +the interpreter. This isn't really used yet. +Input: +Output: +Errors: ------------------------------------------------------------------------*/ void SetLastPrompt(HWND hEdit) { - DWORD startpos,endpos; - SendMessage(hEdit,EM_GETSEL,(WPARAM)&startpos,(LPARAM)&endpos); - LastPromptPosition.line = SendMessage(hEdit,EM_LINEFROMCHAR,(WPARAM)-1,0); - LastPromptPosition.col = startpos; + DWORD startpos,endpos; + SendMessage(hEdit,EM_GETSEL,(WPARAM)&startpos,(LPARAM)&endpos); + LastPromptPosition.line = SendMessage(hEdit,EM_LINEFROMCHAR,(WPARAM)-1,0); + LastPromptPosition.col = startpos; } /*------------------------------------------------------------------------ - Procedure: MdiChildWndProc ID:1 - Purpose: The edit control is enclosed in a normal MDI window. - This is the window procedure for that window. When it - receives the WM_CREATE message, it will create the - edit control. - Input: - Output: - Errors: +Procedure: MdiChildWndProc ID:1 +Purpose: The edit control is enclosed in a normal MDI window. +This is the window procedure for that window. When it +receives the WM_CREATE message, it will create the +edit control. +Input: +Output: +Errors: +-------------------------------------------------------------------------- +Edit History: + 14 Sept 2003 - Chris Watford watford@uiuc.edu + - Added edit buffer and statement buffer support to the WM_NEWLINE + message. + 15 Sept 2003 - Chris Watford watford@uiuc.edu + - Got it adding to the edit buffer + 16 Sept 2003 - Chris Watford watford@uiuc.edu + - Proper handling of newline message finished + 21 Sept 2003 - Chris Watford watford@uiuc.edu + - Added error detection on return from ocaml interp + 23 Sept 2003 - Chris Watford watford@uiuc.edu + - Fixed prompt detection error as pointed out by Patrick Meredith ------------------------------------------------------------------------*/ static LRESULT CALLBACK MdiChildWndProc(HWND hwnd,UINT msg,WPARAM wparam,LPARAM lparam) { - HWND hwndChild; - RECT rc; - HDC hDC; - - switch(msg) { - case WM_CREATE: - GetClientRect(hwnd,&rc); - hwndChild= CreateWindow("EDIT", - NULL, - WS_CHILD | WS_VISIBLE | - ES_MULTILINE | - WS_VSCROLL | WS_HSCROLL | - ES_AUTOHSCROLL | ES_AUTOVSCROLL, - 0, - 0, - (rc.right-rc.left), - (rc.bottom-rc.top), - hwnd, - (HMENU) EditControls++, - hInst, - NULL); - SetWindowLong(hwnd, DWL_USER, (DWORD) hwndChild); - SendMessage(hwndChild, WM_SETFONT, (WPARAM) ProgramParams.hFont, 0L); - SendMessage(hwndChild,EM_LIMITTEXT,0xffffffff,0); - SubClassEditField(hwndChild); - break; - // Resize the edit control - case WM_SIZE: - hwndChild = (HWND) GetWindowLong(hwnd, DWL_USER); - MoveWindow(hwndChild, 0, 0, LOWORD(lparam), HIWORD(lparam), TRUE); - break; - // Always set the focus to the edit control. - case WM_SETFOCUS: - hwndChild = (HWND) GetWindowLong(hwnd, DWL_USER); - SetFocus(hwndChild); - break; - // Repainting of the edit control about to happen. - // Set the text color and the background color - case WM_CTLCOLOREDIT: - hDC = (HDC)wparam; - SetTextColor(hDC,ProgramParams.TextColor); - SetBkColor(hDC,BackColor); - return (LRESULT)BackgroundBrush; - // Take care of erasing the background color to avoid flicker - case WM_ERASEBKGND: - GetWindowRect(hwnd,&rc); - hDC = (HDC)wparam; - FillRect(hDC,&rc,BackgroundBrush); - return 1; - // A carriage return has been pressed. Send the data to the interpreted. - // This message is posted by the subclassed edit field. - case WM_COMMAND: - if (LOWORD(wparam) >= IDEDITCONTROL && LOWORD(wparam) < IDEDITCONTROL+5) { - switch (HIWORD(wparam)) { - case EN_ERRSPACE: - case EN_MAXTEXT: - ResetText(); - break; - } - } - break; - case WM_NEWLINE: - if (busy) - break; - hwndChild = (HWND) GetWindowLong(hwnd, DWL_USER); - SendLastLine(hwndChild); - break; - // The timer will call us 4 times a second. Look if the interpreter - // has written something in its end of the pipe. - case WM_TIMERTICK: - hwndChild = (HWND) GetWindowLong(hwnd, DWL_USER); - if (ReadToLineBuffer()) { - char *p; - // Ok we read something. Display it. - AddLineBuffer(); - p = strrchr(lineBuffer,'\r'); - if (p && !strcmp(p,"\r\n# ")) { - if (p[4] == 0) { - SetLastPrompt(hwndChild); - } - } - - } - break; - - } - return DefMDIChildProc(hwnd, msg, wparam, lparam); + HWND hwndChild; + RECT rc; + HDC hDC; + + switch(msg) { + case WM_CREATE: + GetClientRect(hwnd,&rc); + hwndChild= CreateWindow("EDIT", + NULL, + WS_CHILD | WS_VISIBLE | + ES_MULTILINE | + WS_VSCROLL | WS_HSCROLL | + ES_AUTOHSCROLL | ES_AUTOVSCROLL, + 0, + 0, + (rc.right-rc.left), + (rc.bottom-rc.top), + hwnd, + (HMENU) EditControls++, + hInst, + NULL); + SetWindowLong(hwnd, DWL_USER, (DWORD) hwndChild); + SendMessage(hwndChild, WM_SETFONT, (WPARAM) ProgramParams.hFont, 0L); + SendMessage(hwndChild,EM_LIMITTEXT,0xffffffff,0); + SubClassEditField(hwndChild); + break; + // Resize the edit control + case WM_SIZE: + hwndChild = (HWND) GetWindowLong(hwnd, DWL_USER); + MoveWindow(hwndChild, 0, 0, LOWORD(lparam), HIWORD(lparam), TRUE); + break; + // Always set the focus to the edit control. + case WM_SETFOCUS: + hwndChild = (HWND) GetWindowLong(hwnd, DWL_USER); + SetFocus(hwndChild); + break; + // Repainting of the edit control about to happen. + // Set the text color and the background color + case WM_CTLCOLOREDIT: + hDC = (HDC)wparam; + SetTextColor(hDC,ProgramParams.TextColor); + SetBkColor(hDC,BackColor); + return (LRESULT)BackgroundBrush; + // Take care of erasing the background color to avoid flicker + case WM_ERASEBKGND: + GetWindowRect(hwnd,&rc); + hDC = (HDC)wparam; + FillRect(hDC,&rc,BackgroundBrush); + return 1; + // A carriage return has been pressed. Send the data to the interpreted. + // This message is posted by the subclassed edit field. + case WM_COMMAND: + if (LOWORD(wparam) >= IDEDITCONTROL && LOWORD(wparam) < IDEDITCONTROL+5) { + switch (HIWORD(wparam)) { + case EN_ERRSPACE: + case EN_MAXTEXT: + ResetText(); + break; + } + } + break; + case WM_NEWLINE: + if (busy) + break; + + hwndChild = (HWND) GetWindowLong(hwnd, DWL_USER); + + // add what they wrote to the edit buffer + AppendToEditBuffer(hwndChild); + + /** Modified by Chris Watford 14 Sept 2003, 15 Sept 2003, 16 Sept 2003 **/ + // test if this line has an end or if it needs to be in the Edit Buffer + if(SendingFullCommand()) + { + // send the edit buffer to the interpreter + //SendLastLine(hwndChild); + SendLastEditBuffer(hwndChild); + historyEntry = NULL; + } else { + AddStringToControl(" "); + } + /** End Modifications **/ + + break; + // The timer will call us 4 times a second. Look if the interpreter + // has written something in its end of the pipe. + case WM_TIMERTICK: + /** Modified by Chris Watford 21 Sept 2003 **/ + hwndChild = (HWND) GetWindowLong(hwnd, DWL_USER); + + if (ReadToLineBuffer()) + { + int errMsg = 0; + char *p, *l = lineBuffer; + + // Ok we read something. Display the trimmed version + while(((*l) == ' ') || ((*l) == '\t') || ((*l) == '\n') || ((*l) == '\r') || ((*l) == '*')) + l++; + + SendMessage(hwndChild,EM_REPLACESEL,0,(LPARAM)l); + + // fix bug where it won't find prompt + p = strrchr(l, '\r'); + if((l[0] == '#') || (p != NULL)) + { + if(p != NULL) + { + if(!strcmp(p, "\r\n# ")) + { + SetLastPrompt(hwndChild); + } + // solve the bug Patrick found + } else if((l[0] == '#') && (l[1] == ' ')) { + SetLastPrompt(hwndChild); + } + } + + // detect syntax errors + if(strstr(lineBuffer, "Syntax error")) + { + errMsg = WM_SYNTAXERROR; + } else if(strstr(lineBuffer, "Illegal character")) { + errMsg = WM_ILLEGALCHAR; + } else if(strstr(lineBuffer, "Unbound value")) { + errMsg = WM_UNBOUNDVAL; + } + + // error! error! alert alert! + if(errMsg > 0) + { + int len = strlen(lineBuffer); + char* err = (char*)SafeMalloc(len+1); + char *m = err, *n1 = NULL, *n2 = NULL, *nt = NULL; + + // make a copy of the message + strncpy(err, lineBuffer, len); + err[len] = '\0'; + + // find it + m = strstr(err, "Characters "); + if(m == NULL) + break; + + // got the start char + n1 = m + strlen("Characters "); + + // start looking for the end char + nt = strstr(n1, "-"); + if(nt == NULL) + break; + + // makes n1 a valid string + nt[0] = '\0'; + + // end char is right after this + n2 = nt + 1; + + // find the end of n2 + nt = strstr(n2, ":"); + if(nt == NULL) + break; + + // makes n2 a valid string + nt[0] = '\0'; + + SendMessage(hwndChild, errMsg, (WPARAM)atoi(n1), (LPARAM)atoi(n2)); + } + } + /** End Modifications **/ + + break; + + } + return DefMDIChildProc(hwnd, msg, wparam, lparam); } /*------------------------------------------------------------------------ - Procedure: MainWndProc ID:1 - Purpose: Window procedure for the frame window, that contains - the menu. The messages handled are: - WM_CREATE: Creates the mdi child window - WM_SIZE: resizes the status bar and the mdi child - window - WM_COMMAND: Sends the command to the dispatcher - WM_CLOSE: If the user confirms, it exists the program - WM_QUITOCAML: Stops the program unconditionally. - Input: Standard windows callback - Output: - Errors: +Procedure: MainWndProc ID:1 +Purpose: Window procedure for the frame window, that contains +the menu. The messages handled are: +WM_CREATE: Creates the mdi child window +WM_SIZE: resizes the status bar and the mdi child +window +WM_COMMAND: Sends the command to the dispatcher +WM_CLOSE: If the user confirms, it exists the program +WM_QUITOCAML: Stops the program unconditionally. +Input: Standard windows callback +Output: +Errors: ------------------------------------------------------------------------*/ static LRESULT CALLBACK MainWndProc(HWND hwnd,UINT msg,WPARAM wParam,LPARAM lParam) { - switch (msg) { - // Create the MDI client invisible window - case WM_CREATE: - hwndMDIClient = CreateMdiClient(hwnd); - TimerId = SetTimer((HWND) 0, 0, 100, (TIMERPROC) TimerProc); - break; - // Move the child windows - case WM_SIZE: - SendMessage(hWndStatusbar,msg,wParam,lParam); - InitializeStatusBar(hWndStatusbar,1); - // Position the MDI client window between the tool and status bars - if (wParam != SIZE_MINIMIZED) { - RECT rc, rcClient; - - GetClientRect(hwnd, &rcClient); - GetWindowRect(hWndStatusbar, &rc); - ScreenToClient(hwnd, (LPPOINT)&rc.left); - rcClient.bottom = rc.top; - MoveWindow(hwndMDIClient,rcClient.left,rcClient.top,rcClient.right-rcClient.left, rcClient.bottom-rcClient.top, TRUE); - } - - return 0; - // Dispatch the menu commands - case WM_COMMAND: - HandleCommand(hwnd, wParam,lParam); - return 0; - // If user confirms close - case WM_CLOSE: - if (!AskYesOrNo("Quit Ocaml?")) - return 0; - break; - // End application - case WM_DESTROY: - PostQuitMessage(0); - break; - // The interpreter has exited. Force close of the application - case WM_QUITOCAML: - DestroyWindow(hwnd); - return 0; - case WM_USER+1000: - // TestGraphics(); - break; - default: - return DefFrameProc(hwnd,hwndMDIClient,msg,wParam,lParam); - } - return DefFrameProc(hwnd,hwndMDIClient,msg,wParam,lParam); + switch (msg) { + // Create the MDI client invisible window + case WM_CREATE: + hwndMDIClient = CreateMdiClient(hwnd); + TimerId = SetTimer((HWND) 0, 0, 100, (TIMERPROC) TimerProc); + break; + // Move the child windows + case WM_SIZE: + SendMessage(hWndStatusbar,msg,wParam,lParam); + InitializeStatusBar(hWndStatusbar,1); + // Position the MDI client window between the tool and status bars + if (wParam != SIZE_MINIMIZED) { + RECT rc, rcClient; + + GetClientRect(hwnd, &rcClient); + GetWindowRect(hWndStatusbar, &rc); + ScreenToClient(hwnd, (LPPOINT)&rc.left); + rcClient.bottom = rc.top; + MoveWindow(hwndMDIClient,rcClient.left,rcClient.top,rcClient.right-rcClient.left, rcClient.bottom-rcClient.top, TRUE); + } + + return 0; + // Dispatch the menu commands + case WM_COMMAND: + HandleCommand(hwnd, wParam,lParam); + return 0; + // If user confirms close + case WM_CLOSE: + if (!AskYesOrNo("Quit OCamlWinPlus?")) + return 0; + break; + // End application + case WM_DESTROY: + PostQuitMessage(0); + break; + // The interpreter has exited. Force close of the application + case WM_QUITOCAML: + DestroyWindow(hwnd); + return 0; + case WM_USER+1000: + // TestGraphics(); + break; + default: + return DefFrameProc(hwnd,hwndMDIClient,msg,wParam,lParam); + } + return DefFrameProc(hwnd,hwndMDIClient,msg,wParam,lParam); } /*------------------------------------------------------------------------ - Procedure: CreationCourier ID:1 - Purpose: Creates the courier font - Input: - Output: - Errors: +Procedure: CreationCourier ID:1 +Purpose: Creates the courier font +Input: +Output: +Errors: ------------------------------------------------------------------------*/ static HFONT CreationCourier(int flag) { - LOGFONT CurrentFont; - memset(&CurrentFont, 0, sizeof(LOGFONT)); - CurrentFont.lfCharSet = ANSI_CHARSET; - CurrentFont.lfWeight = FW_NORMAL; - if (flag) - CurrentFont.lfHeight = 18; - else - CurrentFont.lfHeight = 15; - CurrentFont.lfPitchAndFamily = (BYTE) (FIXED_PITCH | FF_MODERN); - strcpy(CurrentFont.lfFaceName, "Courier"); /* Courier */ - return (CreateFontIndirect(&CurrentFont)); + LOGFONT CurrentFont; + memset(&CurrentFont, 0, sizeof(LOGFONT)); + CurrentFont.lfCharSet = ANSI_CHARSET; + CurrentFont.lfWeight = FW_NORMAL; + if (flag) + CurrentFont.lfHeight = 18; + else + CurrentFont.lfHeight = 15; + CurrentFont.lfPitchAndFamily = (BYTE) (FIXED_PITCH | FF_MODERN); + strcpy(CurrentFont.lfFaceName, "Courier"); /* Courier */ + return (CreateFontIndirect(&CurrentFont)); } /*------------------------------------------------------------------------ - Procedure: ReadToLineBuffer ID:1 - Purpose: Reads into the line buffer the characters written by - the interpreter - Input: None - Output: The number of characters read - Errors: None +Procedure: ReadToLineBuffer ID:1 +Purpose: Reads into the line buffer the characters written by +the interpreter +Input: None +Output: The number of characters read +Errors: None ------------------------------------------------------------------------*/ int ReadToLineBuffer(void) { - memset(lineBuffer,0,sizeof(lineBuffer)); - return ReadFromPipe(lineBuffer,sizeof(lineBuffer)); + memset(lineBuffer,0,sizeof(lineBuffer)); + return ReadFromPipe(lineBuffer,sizeof(lineBuffer)); } /*------------------------------------------------------------------------ - Procedure: AddLineBuffer ID:1 - Purpose: Sends the contents of the line buffer to the edit - control - Input: None - Output: - Errors: +Procedure: AddLineBuffer ID:1 +Purpose: Sends the contents of the line buffer to the edit +control +Input: None +Output: +Errors: ------------------------------------------------------------------------*/ int AddLineBuffer(void) { - HWND hEditCtrl; + HWND hEditCtrl; - hEditCtrl = (HWND)GetWindowLong(hwndSession,DWL_USER); - return SendMessage(hEditCtrl,EM_REPLACESEL,0,(LPARAM)lineBuffer); + hEditCtrl = (HWND)GetWindowLong(hwndSession,DWL_USER); + return SendMessage(hEditCtrl,EM_REPLACESEL,0,(LPARAM)lineBuffer); } /*------------------------------------------------------------------------ - Procedure: Setup ID:1 - Purpose: Handles GUI initialization (Fonts, brushes, colors, - etc) - Input: - Output: - Errors: +Procedure: Setup ID:1 +Purpose: Handles GUI initialization (Fonts, brushes, colors, +etc) +Input: +Output: +Errors: ------------------------------------------------------------------------*/ static int Setup(HANDLE *phAccelTable) { - if (!InitApplication()) - return 0; - ProgramParams.hFont = CreationCourier(1); - ProgramParams.TextColor = RGB(0,0,0); - GetObject(ProgramParams.hFont,sizeof(LOGFONT),&CurrentFont); - BackgroundBrush = CreateSolidBrush(BackColor); - *phAccelTable = LoadAccelerators(hInst,MAKEINTRESOURCE(IDACCEL)); - return 1; + if (!InitApplication()) + return 0; + ProgramParams.hFont = CreationCourier(1); + ProgramParams.TextColor = RGB(0,0,0); + GetObject(ProgramParams.hFont,sizeof(LOGFONT),&CurrentFont); + BackgroundBrush = CreateSolidBrush(BackColor); + *phAccelTable = LoadAccelerators(hInst,MAKEINTRESOURCE(IDACCEL)); + return 1; } /*------------------------------------------------------------------------ - Procedure: WinMain ID:1 - Purpose: Entry point for windows programs. - Input: - Output: - Errors: +Procedure: WinMain ID:1 +Purpose: Entry point for windows programs. +Input: +Output: +Errors: ------------------------------------------------------------------------*/ int WINAPI WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR lpCmdLine, INT nCmdShow) { - MSG msg; - HANDLE hAccelTable; - char consoleTitle[512]; - HWND hwndConsole; - - // Setup the hInst global - hInst = hInstance; - // Do the setup - if (!Setup(&hAccelTable)) - return 0; - // Need to set up a console so that we can send ctrl-break signal - // to inferior Caml - AllocConsole(); - GetConsoleTitle(consoleTitle,sizeof(consoleTitle)); - hwndConsole = FindWindow(NULL,consoleTitle); - ShowWindow(hwndConsole,SW_HIDE); - // Create main window and exit if this fails - if ((hwndMain = CreateinriaWndClassWnd()) == (HWND)0) - return 0; - // Create the status bar - CreateSBar(hwndMain,"Ready",2); - // Show the window - ShowWindow(hwndMain,SW_SHOW); - // Create the session window - hwndSession = MDICmdFileNew("Session transcript",0); - // Get the path to ocaml.exe - GetOcamlPath(); - // Start the interpreter - StartOcaml(); - // Show the session window - ShowWindow(hwndSession, SW_SHOW); - // Maximize it - SendMessage(hwndMDIClient, WM_MDIMAXIMIZE, (WPARAM) hwndSession, 0); - - PostMessage(hwndMain,WM_USER+1000,0,0); - while (GetMessage(&msg,NULL,0,0)) { - if (!TranslateMDISysAccel(hwndMDIClient, &msg)) - if (!TranslateAccelerator(msg.hwnd, hAccelTable, &msg)) { - TranslateMessage(&msg); // Translates virtual key codes - DispatchMessage(&msg); // Dispatches message to window - } - } - WriteToPipe("#quit;;\r\n\032"); - KillTimer((HWND) 0, TimerId); - return msg.wParam; + MSG msg; + HANDLE hAccelTable; + char consoleTitle[512]; + HWND hwndConsole; + + CurrentEditBuffer = (EditBuffer*)SafeMalloc(sizeof(EditBuffer)); + CurrentEditBuffer->LineCount = 0; + CurrentEditBuffer->Lines = NULL; + + //setup the history index pointer + historyEntry = NULL; + + // Setup the hInst global + hInst = hInstance; + // Do the setup + if (!Setup(&hAccelTable)) + return 0; + // Need to set up a console so that we can send ctrl-break signal + // to inferior Caml + AllocConsole(); + GetConsoleTitle(consoleTitle,sizeof(consoleTitle)); + hwndConsole = FindWindow(NULL,consoleTitle); + ShowWindow(hwndConsole,SW_HIDE); + // Create main window and exit if this fails + if ((hwndMain = CreateinriaWndClassWnd()) == (HWND)0) + return 0; + // Create the status bar + CreateSBar(hwndMain,"Ready",2); + // Show the window + ShowWindow(hwndMain,SW_SHOW); + // Create the session window + hwndSession = MDICmdFileNew("Session transcript",0); + // Get the path to ocaml.exe + GetOcamlPath(); + // Start the interpreter + StartOcaml(); + // Show the session window + ShowWindow(hwndSession, SW_SHOW); + // Maximize it + SendMessage(hwndMDIClient, WM_MDIMAXIMIZE, (WPARAM) hwndSession, 0); + + PostMessage(hwndMain,WM_USER+1000,0,0); + while (GetMessage(&msg,NULL,0,0)) { + if (!TranslateMDISysAccel(hwndMDIClient, &msg)) + if (!TranslateAccelerator(msg.hwnd, hAccelTable, &msg)) { + TranslateMessage(&msg); // Translates virtual key codes + DispatchMessage(&msg); // Dispatches message to window + } + } + WriteToPipe("#quit;;\r\n\032"); + KillTimer((HWND) 0, TimerId); + return msg.wParam; } diff --git a/win32caml/ocaml.rc b/win32caml/ocaml.rc index 3497f5cb5..52ae94974 100644 --- a/win32caml/ocaml.rc +++ b/win32caml/ocaml.rc @@ -1,114 +1,255 @@ -/***********************************************************************/ -/* */ -/* Objective Caml */ -/* */ -/* Developed by Jacob Navia. */ -/* Copyright 2001 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the GNU Library General Public License, with */ -/* the special exception on linking described in file ../LICENSE. */ -/* */ -/***********************************************************************/ - -/* $Id$ */ - -/* Wedit generated resource file */ -#include <windows.h> +// Microsoft Visual C++ generated resource script. +// +#include "resource.h" + +#define APSTUDIO_READONLY_SYMBOLS +///////////////////////////////////////////////////////////////////////////// +// +// Generated from the TEXTINCLUDE 2 resource. +// +#define APSTUDIO_HIDDEN_SYMBOLS +#include "windows.h" +#undef APSTUDIO_HIDDEN_SYMBOLS #include "inriares.h" -1000 ICON "ocaml.ico" -IDMAINMENU MENU +///////////////////////////////////////////////////////////////////////////// +#undef APSTUDIO_READONLY_SYMBOLS + +///////////////////////////////////////////////////////////////////////////// +// English (U.S.) resources + +#if !defined(AFX_RESOURCE_DLL) || defined(AFX_TARG_ENU) +#ifdef _WIN32 +LANGUAGE LANG_ENGLISH, SUBLANG_ENGLISH_US +#pragma code_page(1252) +#endif //_WIN32 + +///////////////////////////////////////////////////////////////////////////// +// +// Icon +// + +// Icon with lowest ID value placed first to ensure application icon +// remains consistent on all systems. +1000 ICON "ocaml.ico" + +///////////////////////////////////////////////////////////////////////////// +// +// Menu +// + +IDMAINMENU MENU BEGIN POPUP "&File" - BEGIN - MENUITEM "&Open...", IDM_OPEN - MENUITEM "&Save", IDM_SAVE - MENUITEM "Save &As...", IDM_SAVEAS - MENUITEM "&Close", IDM_CLOSE + BEGIN + MENUITEM "&Open...", IDM_OPEN + MENUITEM "&Save ML...", IDM_SAVE + MENUITEM "Save &Transcript...", IDM_SAVEAS MENUITEM SEPARATOR - MENUITEM "&Print", IDM_PRINT - MENUITEM "P&rint Setup...", IDM_PRINTSU + MENUITEM "&Print", IDM_PRINT, GRAYED + MENUITEM "P&rint Setup...", IDM_PRINTSU, GRAYED MENUITEM SEPARATOR - MENUITEM "E&xit", IDM_EXIT - END + MENUITEM "E&xit", IDM_EXIT + END POPUP "&Edit" - BEGIN - MENUITEM "&Undo Alt+BkSp", IDM_EDITUNDO + BEGIN + MENUITEM "&Undo\tAlt+BkSp", IDM_EDITUNDO MENUITEM SEPARATOR - MENUITEM "Cu&t Shift+Del", IDM_EDITCUT - MENUITEM "&Copy Ctrl+Ins", IDM_EDITCOPY - MENUITEM "&Paste Shift+Ins", IDM_EDITPASTE - MENUITEM "&Delete Del", IDM_EDITCLEAR - END + MENUITEM "Cu&t\t Shift+Del", IDM_EDITCUT + MENUITEM "&Copy\tCtrl+Ins", IDM_EDITCOPY + MENUITEM "&Paste\tShift+Ins", IDM_EDITPASTE + END POPUP "Workspace" - BEGIN - MENUITEM "Font", IDM_FONT - MENUITEM "Text Color", IDM_COLORTEXT - MENUITEM "Background color", IDM_BACKCOLOR + BEGIN + MENUITEM "&Font...", IDM_FONT + MENUITEM "Text &Color...", IDM_COLORTEXT + MENUITEM "&Background Color...", IDM_BACKCOLOR MENUITEM SEPARATOR - MENUITEM "&History", IDM_HISTORY - MENUITEM "&Garbage collect", IDM_GC - MENUITEM "&Interrupt", IDCTRLC - END - POPUP "&Window" - BEGIN - MENUITEM "&Tile", IDM_WINDOWTILE - MENUITEM "&Cascade", IDM_WINDOWCASCADE - MENUITEM "Arrange &Icons", IDM_WINDOWICONS - MENUITEM "Close &All", IDM_WINDOWCLOSEALL - END + MENUITEM "&History...", IDM_HISTORY + MENUITEM "&Garbage Collect", IDM_GC + MENUITEM "&Interrupt", IDCTRLC + END + POPUP "&Window", GRAYED + BEGIN + MENUITEM "&Tile", IDM_WINDOWTILE, INACTIVE + MENUITEM "&Cascade", IDM_WINDOWCASCADE, INACTIVE + MENUITEM "Arrange &Icons", IDM_WINDOWICONS, INACTIVE + MENUITEM "Close &All", IDM_WINDOWCLOSEALL, INACTIVE + END POPUP "&Help" - BEGIN - MENUITEM "&About...", IDM_ABOUT - END + BEGIN + MENUITEM "&About...", IDM_ABOUT + END END -BARMDI ACCELERATORS + + +///////////////////////////////////////////////////////////////////////////// +// +// Accelerator +// + +BARMDI ACCELERATORS BEGIN - 81, IDM_EXIT, VIRTKEY, CONTROL + "Q", IDM_EXIT, VIRTKEY, CONTROL END + +///////////////////////////////////////////////////////////////////////////// +// +// Dialog +// + IDD_ABOUT DIALOGEX 7, 29, 236, 81 -STYLE DS_CENTER | WS_POPUP | WS_VISIBLE | WS_CAPTION | WS_SYSMENU -EXSTYLE WS_EX_CLIENTEDGE | WS_EX_TOOLWINDOW -CAPTION "About Ocaml" -FONT 8, "MS Sans Serif" +STYLE DS_SETFONT | DS_CENTER | WS_POPUP | WS_VISIBLE | WS_CAPTION | + WS_SYSMENU +EXSTYLE WS_EX_TOOLWINDOW | WS_EX_CLIENTEDGE +CAPTION "About OCamlWinPlus" +FONT 8, "MS Sans Serif", 0, 0, 0x1 BEGIN - LTEXT "The Objective Caml system for windows", 101, 56, 9, 126, 12 - LTEXT "Windows Interface 2.0", 102, 78, 21, 72, 12 - LTEXT "Copyright 1996-2001", 103, 84, 42, 66, 10 - CTEXT "Institut National de Recherche en Informatique et Automatique", 104, 15, 56, 211, 10 - CTEXT "Réalisé par Jacob Navia 2001", 105, 19, 66, 207, 12 + LTEXT "Objective Caml for Windows",101,75,7,90,12 + LTEXT "New Windows Interface 1.9RC4",102,68,15,104,12 + CTEXT "Copyright 1996-2001\nUpdated 2003",103,88,25,66,23 + CTEXT "Institut National de Recherche en Informatique et Automatique", + 104,16,46,211,10 + CTEXT "Réalisé par Jacob Navia 2001. Updated by Chris Watford 2003.\nwatford@uiuc.edu", + 105,18,54,207,19 END IDD_HISTORY DIALOGEX 6, 18, 261, 184 -STYLE DS_MODALFRAME | WS_POPUP | WS_VISIBLE | WS_CAPTION | WS_SYSMENU | WS_THICKFRAME +STYLE DS_SETFONT | DS_MODALFRAME | WS_POPUP | WS_VISIBLE | WS_CAPTION | + WS_SYSMENU | WS_THICKFRAME EXSTYLE WS_EX_TOOLWINDOW CAPTION "Session History" -FONT 8, "MS Sans Serif" -BEGIN - LISTBOX IDLIST, 7, 7, 247, 173, LBS_USETABSTOPS | WS_VSCROLL | WS_HSCROLL | WS_TABSTOP -END -STRINGTABLE -BEGIN - 3010, "Switches to " - 2010, "Get help" - 2000, "Create, open, save, or print documents" - 500, "Displays information about this application" - 440, "Closes all open windows" - 430, "Arranges minimized window icons" - 420, "Arranges windows as overlapping tiles" - 410, "Arranges windows as non-overlapping tiles" - 350, "Removes the selection without putting it on the clipboard" - 340, "Inserts the clipboard contents at the insertion point" - 330, "Copies the selection and puts it on the clipboard" - 320, "Cuts the selection and puts it on the clipboard" - 310, "Reverses the last action" - 270, "Quits this application" - 260, "Changes the printer selection or configuration" - 250, "Prints the active document" - 240, "Closes the active document" - 230, "Saves the active document under a different name" - 220, "Saves the active document" - 210, "Opens an existing document" - 200, "Creates a new session" +FONT 8, "MS Sans Serif", 0, 0, 0x1 +BEGIN + LISTBOX IDLIST,7,7,247,173,LBS_USETABSTOPS | WS_VSCROLL | + WS_HSCROLL | WS_TABSTOP +END + + +#ifdef APSTUDIO_INVOKED +///////////////////////////////////////////////////////////////////////////// +// +// TEXTINCLUDE +// + +1 TEXTINCLUDE +BEGIN + "resource.h\0" +END + +2 TEXTINCLUDE +BEGIN + "#define APSTUDIO_HIDDEN_SYMBOLS\r\n" + "#include ""windows.h""\r\n" + "#undef APSTUDIO_HIDDEN_SYMBOLS\r\n" + "#include ""inriares.h""\r\n" + "\0" +END + +3 TEXTINCLUDE +BEGIN + "\r\n" + "\0" +END + +#endif // APSTUDIO_INVOKED + + +///////////////////////////////////////////////////////////////////////////// +// +// String Table +// + +STRINGTABLE +BEGIN + 3010 "Switches to " +END + +STRINGTABLE +BEGIN + 2000 "Create, open, save, or print documents" + 2010 "Get help" +END + +STRINGTABLE +BEGIN + 500 "Displays information about this application" +END + +STRINGTABLE +BEGIN + 440 "Closes all open windows" +END + +STRINGTABLE +BEGIN + 420 "Arranges windows as overlapping tiles" + 430 "Arranges minimized window icons" +END + +STRINGTABLE +BEGIN + 410 "Arranges windows as non-overlapping tiles" +END + +STRINGTABLE +BEGIN + 340 "Inserts the clipboard contents at the insertion point" + 350 "Removes the selection without putting it on the clipboard" +END + +STRINGTABLE +BEGIN + 320 "Cuts the selection and puts it on the clipboard" + 330 "Copies the selection and puts it on the clipboard" +END + +STRINGTABLE +BEGIN + 310 "Reverses the last action" +END + +STRINGTABLE +BEGIN + 260 "Changes the printer selection or configuration" + 270 "Quits this application" END + +STRINGTABLE +BEGIN + 240 "Closes the active document" + 250 "Prints the active document" +END + +STRINGTABLE +BEGIN + 230 "Saves the active document under a different name" +END + +STRINGTABLE +BEGIN + 210 "Opens an existing document" + 220 "Saves the active document" +END + +STRINGTABLE +BEGIN + 200 "Creates a new session" +END + +#endif // English (U.S.) resources +///////////////////////////////////////////////////////////////////////////// + + + +#ifndef APSTUDIO_INVOKED +///////////////////////////////////////////////////////////////////////////// +// +// Generated from the TEXTINCLUDE 3 resource. +// + + +///////////////////////////////////////////////////////////////////////////// +#endif // not APSTUDIO_INVOKED + 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(" "); } |