/* */ /* 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. */ /* */ /***********************************************************************/ /***********************************************************************/ /* 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 */ /*<---------------------------------------------------------------------->*/ #include #include #include #include #include #include #include #include "inriares.h" #include "inria.h" #define VK_BACKSPACE 0x108 /*<---------------------------------------------------------------------->*/ 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; 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 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","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: ------------------------------------------------------------------------*/ 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)GetWindowLongPtr(hwndSession,DWLP_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); } /*------------------------------------------------------------------------ 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)GetWindowLongPtr(hwndSession,DWLP_USER); int lineindex = SendMessage(hEdit,EM_LINEINDEX,LastPromptPosition.line,0)+2; 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; } /*------------------------------------------------------------------------ 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) { int curline = GetCurLineIndex(hEdit); char *linebuffer = (char*)SafeMalloc(2048*sizeof(char)); int n; int linescount = GetNumberOfLines(hEdit); *(unsigned short *)linebuffer = 2047; n = SendMessage(hEdit,EM_GETLINE,curline,(LPARAM)linebuffer); if (n >= 2 && linebuffer[0] == '#' && linebuffer[1] == ' ') { n -= 2; memmove(linebuffer, linebuffer+2, n); } linebuffer[n] = '\0'; return linebuffer; } void DoHelp(HWND hwnd) { char word[256]; GetWordUnderCursor(hwnd,word,sizeof(word)); MessageBox(NULL,word,"Aide pour:",MB_OK); } /*------------------------------------------------------------------------ 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) { // get the editbox's handle HWND hEdit = (HWND)GetWindowLongPtr(hwndSession,DWLP_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); } } } /*------------------------------------------------------------------------ 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) { // get the editbox's handle HWND hEdit = (HWND)GetWindowLongPtr(hwndSession,DWLP_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); } } /*------------------------------------------------------------------------ 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) { // 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(); } } /*------------------------------------------------------------------------ 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) { // 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) { 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) GetWindowLongPtr(hwnd, GWLP_WNDPROC); } SetWindowLongPtr(hwnd, GWLP_WNDPROC, (LONG_PTR) SubClassEdit); } /*------------------------------------------------------------------------ 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) { /* 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; }*/ } /*------------------------------------------------------------------------ Procedure: SendLastEditBuffer ID:1 Author: Chris Watford watford@uiuc.edu Purpose: Sends an edit buffer to the pipe Input: Output: Errors: -------------------------------------------------------------------------- Edit History: 7 Aug 2004 - Chris Watford christopher.watford@gmail.com - Fixed error where SendLastEditBuffer sent waaaay too many newlines which completely broke the underlying connection to the ocaml.exe pipe 15 Sept 2003 - Chris Watford watford@uiuc.edu - Sends line to the pipe and adds newline to the end ------------------------------------------------------------------------*/ void SendLastEditBuffer(HWND hwndChild) { char* line = editbuffer_getasbuffer(CurrentEditBuffer); int l = strlen(line) - 1; 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; // trim and add the newline to the end strncpy(linebuffer, line, l+1); while((linebuffer[l] == '\n' || linebuffer[l] == '\r') && (l >= 0)) { linebuffer[l--] = '\0'; } linebuffer[l+1] = '\n'; linebuffer[l+2] = '\0'; // save line to the pipe WriteToPipe(linebuffer); } /*------------------------------------------------------------------------ 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: 7 Aug 2004 - Chris Watford christopher.watford@gmail.com - Fixed bug #2932 where many carraige returns were sent and it came back with a null pointer error due to a fault of not checking if the line returned was NULL 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, *firstSemiColonSemiColon, *firstQuote; if(line == NULL) { return FALSE; } firstComment = strstr(line, "(*"); firstSemiColonSemiColon = strstr(line, ";;"); firstQuote = strstr(line, "\""); // easy case :D if(firstSemiColonSemiColon == NULL) { free(line); return FALSE; } // if there are no comments if(firstComment == NULL) { // if there are no quotations used if(firstQuote == NULL) { BOOL r = (firstSemiColonSemiColon != NULL); free(line); return r; } else { // we need to first check if the ;; is before the \", since the \" // won't matter if its before the semicolonsemicolon if(firstQuote < firstSemiColonSemiColon) { // the quote is before the ;;, we need to make sure its terminated // also we have to check for escaped quotes, le sigh! char *c = firstQuote+1; BOOL in_quote = TRUE; // in-quote determiner loop while(c[0] != '\0') { // are we a backslash? if(c[0] == '\\') { // ignore the next character c++; } else { // are we a quote? if(c[0] == '"') { in_quote = !in_quote; } } c++; } free(line); return !in_quote; } else { 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: 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 AppendToEditBuffer(HWND hEdit) { 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: ------------------------------------------------------------------------*/ 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: -------------------------------------------------------------------------- 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); SetWindowLongPtr(hwnd, DWLP_USER, (LONG_PTR) 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) GetWindowLongPtr(hwnd, DWLP_USER); MoveWindow(hwndChild, 0, 0, LOWORD(lparam), HIWORD(lparam), TRUE); break; // Always set the focus to the edit control. case WM_SETFOCUS: hwndChild = (HWND) GetWindowLongPtr(hwnd, DWLP_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) GetWindowLongPtr(hwnd, DWLP_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) GetWindowLongPtr(hwnd, DWLP_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: ------------------------------------------------------------------------*/ 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 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: ------------------------------------------------------------------------*/ 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)GetWindowLongPtr(hwndSession,DWLP_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; 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; }