summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorXavier Leroy <xavier.leroy@inria.fr>2004-06-17 07:33:45 +0000
committerXavier Leroy <xavier.leroy@inria.fr>2004-06-17 07:33:45 +0000
commit8e391de7cfcbac0a5ea0213b4eb70ebbb64988e9 (patch)
tree17ceee9990d940777ca481c88ce81571b0e3bfe1
parentfae0bc9d9ba0359d0f3d26325762e93a8e63c209 (diff)
Merge de OCamlWinPlus (Christopher Watford)
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@6416 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat
-rw-r--r--win32caml/Makefile5
-rw-r--r--win32caml/inria.h33
-rw-r--r--win32caml/menu.c292
-rw-r--r--win32caml/ocaml.c1955
-rw-r--r--win32caml/ocaml.rc323
-rw-r--r--win32caml/startocaml.c533
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(" ");
}
generated by cgit v1.2.3-70-g09d2 (git 2.46.0) at 2025-03-22 18:25:54 +0000