Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Suite integration corrections J. Navia 

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@4025 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Xavier Leroy 2001-11-20 13:45:37 +00:00
parent d3db3052c3
commit 5242d0edd8
7 changed files with 185 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
win32caml/Makefile
View File

@ -5,10 +5,10 @@ OBJS=startocaml.obj ocaml.res ocaml.obj menu.obj
LIBS=kernel32.lib advapi32.lib gdi32.lib user32.lib comdlg32.lib comctl32.lib
all: ocaml.exe
all: ocamlwin.exe
ocaml.exe: $(OBJS)
$(CC) $(CFLAGS) -o ocaml.exe $(OBJS) $(LIBS)
ocamlwin.exe: $(OBJS)
$(CC) $(CFLAGS) -o ocamlwin.exe $(OBJS) $(LIBS)
ocaml.res: ocaml.rc ocaml.ico
rc ocaml.rc
@ -16,10 +16,10 @@ ocaml.res: ocaml.rc ocaml.ico
$(OBJS): inria.h inriares.h
clean:
rm -f ocaml.exe ocaml.res *.obj
rm -f ocamlwin.exe ocaml.res *.obj
install:
cp ocaml.exe $(PREFIX)
cp ocamlwin.exe $(PREFIX)/OCamlWin.exe
.SUFFIXES: .c .obj

2
win32caml/inria.h
View File

@ -110,3 +110,5 @@ typedef struct tagHistory {
extern void *SafeMalloc(int);
extern HISTORYLINE *History; // The root of the history lines
#define IDEDITCONTROL 15432

1
win32caml/inriares.h
View File

@ -12,6 +12,7 @@
#define IDM_EXIT 270
#define IDM_HISTORY 281
#define IDM_GC 282
#define IDCTRLC 283
#define IDD_HISTORY 300
#define IDLIST 301
#define IDM_EDITUNDO 310

79
win32caml/menu.c
View File

@ -13,6 +13,7 @@
#include <stdio.h>
#include <windows.h>
#include <Richedit.h>
#include "inria.h"
#include "inriares.h"
@ -298,6 +299,12 @@ void ForceRepaint(void)
InvalidateRect(hwndEdit,NULL,1);
}
static void Add_Char_To_Queue(int c)
{
HWND hwndEdit = (HWND)GetWindowLong(hwndSession,DWL_USER);
SendMessage(hwndEdit,WM_CHAR,c,1);
}
/*------------------------------------------------------------------------
Procedure: AddLineToControl ID:1
Purpose: It will ad the given text at the end of the edit
@ -423,6 +430,60 @@ static void SaveText(char *fname)
free(buf);
}
static void Add_Clipboard_To_Queue(void)
{
if (IsClipboardFormatAvailable(CF_TEXT) &&
OpenClipboard(hwndMain))
{
HANDLE hClipData = GetClipboardData(CF_TEXT);
if (hClipData)
{
char *str = GlobalLock(hClipData);
if (str)
while (*str)
{
if (*str != '\r')
Add_Char_To_Queue(*str);
str++;
}
GlobalUnlock(hClipData);
}
CloseClipboard();
}
}
static void CopyToClipboard(HWND hwnd)
{
HWND hwndEdit = (HWND)GetWindowLong(hwndSession,DWL_USER);
SendMessage(hwndEdit,WM_COPY,0,0);
}
int ResetText(void)
{
HWND hwndEdit = (HWND) GetWindowLong(hwndSession,DWL_USER);
TEXTRANGE cr;
int len = SendMessage(hwndEdit,WM_GETTEXTLENGTH,0,0);
char *tmp = malloc(len+10),*p;
memset(tmp,0,len+10);
cr.chrg.cpMin = 0;
cr.chrg.cpMax = -1;
cr.lpstrText = tmp;
SendMessage(hwndEdit,EM_GETTEXTRANGE,0,(LPARAM)&cr);
p = tmp+len/2;
while (*p && *p != '\r')
p++;
SendMessage(hwndEdit,EM_SETSEL,0,(LPARAM)-1);
SendMessage(hwndEdit,EM_REPLACESEL,0,(LPARAM)p);
InvalidateRect(hwndEdit,0,1);
free(tmp);
return 0;
}
/*------------------------------------------------------------------------
Procedure: HandleCommand ID:1
Purpose: Handles all menu commands.
@ -456,6 +517,15 @@ void HandleCommand(HWND hwnd, WPARAM wParam,LPARAM lParam)
case IDM_GC:
AddLineToControl("Gc.full_major();;");
break;
case IDCTRLC:
InterruptOcaml();
break;
case IDM_EDITPASTE:
Add_Clipboard_To_Queue();
break;
case IDM_EDITCOPY:
CopyToClipboard(hwnd);
break;
case IDM_SAVE:
fname = SafeMalloc(512);
if (GetSaveName(fname,512)) {
@ -503,6 +573,15 @@ void HandleCommand(HWND hwnd, WPARAM wParam,LPARAM lParam)
case IDM_ABOUT:
CallDlgProc(AboutDlgProc,IDD_ABOUT);
break;
default:
if (LOWORD(wParam) >= IDEDITCONTROL && LOWORD(wParam) < IDEDITCONTROL+5) {
switch (HIWORD(wParam)) {
case EN_ERRSPACE:
ResetText();
break;
}
}
break;
}
}

153
win32caml/ocaml.c
View File

@ -25,7 +25,7 @@
#include <Richedit.h>
#include "inriares.h"
#include "inria.h"
int EditControls = 10000;
int EditControls = IDEDITCONTROL;
static WNDPROC lpEProc;
static char lineBuffer[1024*32];
int ReadToLineBuffer(void);
@ -530,74 +530,85 @@ static LRESULT CALLBACK MdiChildWndProc(HWND hwnd,UINT msg,WPARAM wparam,LPARAM
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);
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_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;
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);
}
}
AddLineBuffer();
p = strrchr(lineBuffer,'\r');
if (p && !strcmp(p,"\r\n# ")) {
if (p[4] == 0) {
SetLastPrompt(hwndChild);
}
}
}
break;
}
break;
}
return DefMDIChildProc(hwnd, msg, wparam, lparam);
@ -753,12 +764,20 @@ int WINAPI WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR lpCmdLine
{
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;

1
win32caml/ocaml.rc
View File

@ -47,6 +47,7 @@ BEGIN
MENUITEM SEPARATOR
MENUITEM "&History", IDM_HISTORY
MENUITEM "&Garbage collect", IDM_GC
MENUITEM "&Interrupt", IDCTRLC
END
POPUP "&Window"
BEGIN

11
win32caml/startocaml.c
View File

@ -315,3 +315,14 @@ error:
goto error;
return result;
}
void InterruptOcaml(void)
{
if (! GenerateConsoleCtrlEvent(CTRL_BREAK_EVENT, pi.dwProcessId)) {
char message[1024];
sprintf(message, "GenerateConsole failed: %d\n", GetLastError());
MessageBox(NULL, message, "Ocaml", MB_OK);
}
WriteToPipe(" ");
}