812 lines
26 KiB
C
812 lines
26 KiB
C
/***********************************************************************/
|
|
/* */
|
|
/* 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 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 */
|
|
/*<---------------------------------------------------------------------->*/
|
|
/*<---------------------------------------------------------------------->*/
|
|
#include <windows.h>
|
|
#include <windowsx.h>
|
|
#include <commctrl.h>
|
|
#include <string.h>
|
|
#include <direct.h>
|
|
#include <Richedit.h>
|
|
#include "inriares.h"
|
|
#include "inria.h"
|
|
int EditControls = IDEDITCONTROL;
|
|
static WNDPROC lpEProc;
|
|
static char lineBuffer[1024*32];
|
|
int ReadToLineBuffer(void);
|
|
int AddLineBuffer(void);
|
|
static int busy;
|
|
static DWORD TimerId;
|
|
POSITION LastPromptPosition;
|
|
char LibDir[512];
|
|
char OcamlPath[512];
|
|
HBRUSH BackgroundBrush;
|
|
COLORREF BackColor = RGB(255,255,255);
|
|
PROGRAM_PARAMS ProgramParams;
|
|
HISTORYLINE *History;
|
|
/*<----------------- global variables --------------------------------------->*/
|
|
HANDLE hInst; // Instance handle
|
|
HWND hwndMain; //Main window handle
|
|
HWND hwndSession;
|
|
HWND hwndMDIClient; //Mdi client window handle
|
|
static LRESULT CALLBACK MainWndProc(HWND hwnd,UINT msg,WPARAM wParam,LPARAM lParam);
|
|
static LRESULT CALLBACK MdiChildWndProc(HWND hwnd,UINT msg,WPARAM wParam,LPARAM lParam);
|
|
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
|
|
|
|
------------------------------------------------------------------------*/
|
|
void UpdateStatusBar(LPSTR lpszStatusString, WORD partNumber, WORD displayFlags)
|
|
{
|
|
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.
|
|
------------------------------------------------------------------------*/
|
|
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;
|
|
}
|
|
|
|
/*------------------------------------------------------------------------
|
|
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);
|
|
}
|
|
|
|
/*------------------------------------------------------------------------
|
|
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;
|
|
|
|
/* * Fill in the ptArray... */
|
|
|
|
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.
|
|
|
|
ReleaseDC(hwndParent, hDC);
|
|
SendMessage(hWndStatusbar,
|
|
SB_SETPARTS,
|
|
nrOfParts,
|
|
(LPARAM)(LPINT)ptArray);
|
|
|
|
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:
|
|
------------------------------------------------------------------------*/
|
|
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;
|
|
}
|
|
/*------------------------------------------------------------------------
|
|
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;
|
|
}
|
|
|
|
/*------------------------------------------------------------------------
|
|
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);
|
|
}
|
|
|
|
/*------------------------------------------------------------------------
|
|
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;
|
|
|
|
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;
|
|
}
|
|
|
|
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);
|
|
|
|
lineindex += lastLineLength;
|
|
SendMessage(hEdit,EM_SETSEL,lineindex,lineindex);
|
|
}
|
|
|
|
int GetCurLineIndex(HWND hEdit)
|
|
{
|
|
return SendMessage(hEdit,EM_LINEFROMCHAR,(WPARAM)-1,0);
|
|
}
|
|
|
|
int GetNumberOfLines(HWND hEdit)
|
|
{
|
|
return SendMessage(hEdit,EM_GETLINECOUNT,0,0);
|
|
}
|
|
|
|
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;
|
|
}
|
|
|
|
void DoHelp(HWND hwnd)
|
|
{
|
|
char word[256];
|
|
GetWordUnderCursor(hwnd,word,sizeof(word));
|
|
MessageBox(NULL,word,"Aide pour:",MB_OK);
|
|
}
|
|
|
|
|
|
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;
|
|
}
|
|
|
|
static void SubClassEditField(HWND hwnd)
|
|
{
|
|
if (lpEProc == NULL) {
|
|
lpEProc = (WNDPROC) GetWindowLong(hwnd, GWL_WNDPROC);
|
|
}
|
|
SetWindowLong(hwnd, GWL_WNDPROC, (DWORD) SubClassEdit);
|
|
}
|
|
|
|
void AddToHistory(char *text)
|
|
{
|
|
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;
|
|
}
|
|
|
|
char *GetHistoryLine(int n)
|
|
{
|
|
HISTORYLINE *rvp = History;
|
|
int i;
|
|
|
|
for (i=0; i<n; i++) {
|
|
rvp = rvp->Next;
|
|
}
|
|
if (rvp)
|
|
return &rvp->Text[0];
|
|
else
|
|
return "";
|
|
}
|
|
|
|
/*------------------------------------------------------------------------
|
|
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
|
|
------------------------------------------------------------------------*/
|
|
void SendLastLine(HWND hEdit)
|
|
{
|
|
int curline = GetCurLineIndex(hEdit);
|
|
char *p,linebuffer[2048];
|
|
int linescount = GetNumberOfLines(hEdit);
|
|
|
|
memset(linebuffer,0,sizeof(linebuffer));
|
|
*(unsigned short *)linebuffer = sizeof(linebuffer)-1;
|
|
if (curline != linescount-1)
|
|
SendMessage(hEdit,EM_GETLINE,curline,(LPARAM)linebuffer);
|
|
else
|
|
SendMessage(hEdit,EM_GETLINE,curline-1,(LPARAM)linebuffer);
|
|
if (linebuffer[0] == '#' && linebuffer[1] == ' ')
|
|
memmove(linebuffer,linebuffer+2,strlen(linebuffer)+1);
|
|
// Record user input!
|
|
AddToHistory(linebuffer);
|
|
strcat(linebuffer,"\n");
|
|
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;
|
|
}
|
|
}
|
|
/*------------------------------------------------------------------------
|
|
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;
|
|
}
|
|
|
|
/*------------------------------------------------------------------------
|
|
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:
|
|
------------------------------------------------------------------------*/
|
|
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);
|
|
}
|
|
|
|
|
|
/*------------------------------------------------------------------------
|
|
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);
|
|
}
|
|
|
|
/*------------------------------------------------------------------------
|
|
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));
|
|
}
|
|
|
|
/*------------------------------------------------------------------------
|
|
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));
|
|
}
|
|
|
|
/*------------------------------------------------------------------------
|
|
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;
|
|
|
|
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:
|
|
------------------------------------------------------------------------*/
|
|
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;
|
|
}
|
|
|
|
|
|
/*------------------------------------------------------------------------
|
|
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;
|
|
}
|