summaryrefslogtreecommitdiffstats
path: root/win32caml/ocaml.c
diff options
context:
space:
mode:
authorXavier Leroy <xavier.leroy@inria.fr>2001-11-06 12:36:24 +0000
committerXavier Leroy <xavier.leroy@inria.fr>2001-11-06 12:36:24 +0000
commit2f391a02b894fcf9d2580a04ab9ac66ed8040862 (patch)
tree565d50a408f3cc517a0c94843181fe76013f7b70 /win32caml/ocaml.c
parent839a289aa108482e203053488863d622985bc8b0 (diff)
GUI Win32 pour le toplevel (J.Navia)
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@3988 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat (limited to 'win32caml/ocaml.c')
-rw-r--r--win32caml/ocaml.c791
1 files changed, 791 insertions, 0 deletions
diff --git a/win32caml/ocaml.c b/win32caml/ocaml.c
new file mode 100644
index 000000000..cddbbcbe8
--- /dev/null
+++ b/win32caml/ocaml.c
@@ -0,0 +1,791 @@
+/***********************************************************************/
+/* */
+/* 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. */
+/* */
+/***********************************************************************/
+
+/* $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 = 10000;
+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);
+ 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;
+ // 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;
+
+ // Setup the hInst global
+ hInst = hInstance;
+ // Do the setup
+ if (!Setup(&hAccelTable))
+ return 0;
+ // 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;
+}