void MainCommand(HWND hWnd, int ID)
{
switch (ID) {
case IDCANCEL: EndDialog(hWnd, 0); break;
case ID_OPEN: MainOpenFile(hWnd); break;
case ID_SCRIPTMAN: ShowScriptMan(); break;
case ID_EXIT: FireCommand(":quit\n"); break;
/* Load one of the last 10 open files */
case ID_MRU+0: case ID_MRU+1: case ID_MRU+2: case ID_MRU+3:
case ID_MRU+4: case ID_MRU+5: case ID_MRU+6: case ID_MRU+7:
case ID_MRU+8: case ID_MRU+9:
{
char Command[1000];
wsprintf(Command, ":load %s", ExpandFileName(MruGetItem(ID-ID_MRU)));
FireCommand(Command);
}
break;
// EDIT MENU
case ID_CUT: RtfWindowClipboard(WM_CUT); break;
case ID_COPY: RtfWindowClipboard(WM_COPY); break;
case ID_PASTE: RtfWindowClipboard(WM_PASTE); break;
case ID_CLEARSCREEN: RtfWindowClear(); break;
case ID_DELETE: RtfWindowDelete(); break;
case ID_SELECTALL: RtfWindowSelectAll(); break;
case ID_GOPREVIOUS: RtfWindowHistory(-1); break;
case ID_GONEXT: RtfWindowHistory(+1); break;
// ACTIONS MENU
// Reload script files
case ID_COMPILE: case ID_MAKE: FireCommand(":reload"); break;
case ID_CLEARALL: FireCommand(":load"); break;
case ID_GOEDIT: FireCommand(":edit"); break;
/* Stop program execution */
case ID_STOP:
MessageBeep(0xFFFFFFFF);
AbortExecution();
break;
/* Evaluate main expression */
case ID_RUN:
{
char Buffer[1000];
RtfWindowGetCommand(Buffer);
if (Buffer[0] == '\0')
FireCommand(":main");
else
FireCommand(Buffer);
}
break;
/* Set interpreter options using dialog box */
case ID_SETOPTIONS:
if (ShowOptionsDialog(hWnd))
RtfWindowUpdateFont();
break;
// BROWSE MENU
case ID_BROWSEHIERARCHY: DrawClassesHierarchy(); break;
case ID_BROWSECLASSES: DoBrowseClasses(); break;
case ID_BROWSENAMES: DoBrowseNames(); break;
case ID_BROWSETYCONS: DoBrowseTycons(); break;
// HELP MENU
case ID_HELPCONTENTS: ExecuteFileDocs("hugs98.chm"); break;
case ID_HELPCOMMANDS: FireCommand(":?\n"); break;
case ID_LIBRARIES: ExecuteFile("http://www.haskell.org/ghc/docs/latest/html/libraries/index.html"); break;
case ID_WWWHASKELL: ExecuteFile("http://haskell.org/"); break;
case ID_WWWHUGS: ExecuteFile("http://haskell.org/hugs/"); break;
case ID_ABOUT: ShowAboutDialog(hWnd); break;
}
}
/* Handles browse classes dialog box */
LRESULT CALLBACK BrowseClassesDlgProc(HWND hDlg, UINT msg, WPARAM wParam, LPARAM lParam)
{
INT i;
static Class currClass;
Class theClass;
Inst theInst;
Name theMember;
WORD NotifyCode, wId;
HBITMAP hBitmap;
RECT aRect, DlgRect;
HBITMAP hBmp;
BITMAP bm;
DRAWITEMSTRUCT FAR *lpdis;
LPMEASUREITEMSTRUCT lpmis;
LPCOMPAREITEMSTRUCT lpcis;
BOOL Selected = FALSE;
static HBITMAP hCBm, hCSelBm, hIBm, hISelBm, hMBm, hMSelBm;
String string;
CHAR string1[256];
NotifyCode = HIWORD (wParam);
wId = LOWORD (wParam);
switch (msg) {
case WM_INITDIALOG:
CenterDialogInParent(hDlg);
SetDialogFont (hDlg, hDialogFont);
SendDlgItemMessage(hDlg, LB_CLASS, LB_SETHORIZONTALEXTENT, (WPARAM)300, 0L);
SendDlgItemMessage(hDlg, LB_MEMBERS, LB_SETHORIZONTALEXTENT, (WPARAM)400, 0L);
/* Create list of classes and set current class */
for(i=CLASSMIN; i<classMax(); i++) {
SendDlgItemMessage(hDlg, LB_CLASS ,LB_ADDSTRING, 0, (LPARAM)(LPSTR) i);
}
SendDlgItemMessage(hDlg, LB_CLASS, LB_SETCURSEL, 0, 0L);
currClass = (Class) SendDlgItemMessage(hDlg, LB_CLASS ,LB_GETITEMDATA, (WPARAM) SendDlgItemMessage(hDlg, LB_CLASS ,LB_GETCURSEL, 0, 0L), 0L);
SetClass(hDlg, currClass);
/* Create Bitmaps */
hCBm = LoadBitmap (hThisInstance, "CLASSBMP");
MapBitmap (hCBm, RGB(0,128,128), GetSysColor(COLOR_WINDOW));
hCSelBm = LoadBitmap (hThisInstance, "CLASSBMP");
MapBitmap (hCSelBm, RGB(0,128,128), GetSysColor(COLOR_HIGHLIGHT));
hIBm = LoadBitmap (hThisInstance, "INSTANCEBMP");
MapBitmap (hIBm, RGB(0,128,128), GetSysColor(COLOR_WINDOW));
hISelBm = LoadBitmap (hThisInstance, "INSTANCEBMP");
MapBitmap (hISelBm, RGB(0,128,128), GetSysColor(COLOR_HIGHLIGHT));
hMBm = LoadBitmap (hThisInstance, "MEMBERBMP");
MapBitmap (hMBm, RGB(0,128,128), GetSysColor(COLOR_WINDOW));
hMSelBm = LoadBitmap (hThisInstance, "MEMBERBMP");
MapBitmap (hMSelBm, RGB(0,128,128), GetSysColor(COLOR_HIGHLIGHT));
return TRUE;
case WM_DESTROY:
/* Destroy Bitmaps */
DeleteObject (hCBm);
DeleteObject (hCSelBm);
DeleteObject (hIBm);
DeleteObject (hISelBm);
DeleteObject (hMBm);
DeleteObject (hMSelBm);
break;
case WM_CTLCOLORBTN:
case WM_CTLCOLORDLG:
case WM_CTLCOLOREDIT:
case WM_CTLCOLORLISTBOX:
case WM_CTLCOLORMSGBOX:
case WM_CTLCOLORSCROLLBAR:
case WM_CTLCOLORSTATIC:
break;
case WM_PAINT: {
HDC hDC;
PAINTSTRUCT Ps;
BeginPaint(hDlg, &Ps);
hDC = Ps.hdc;
/* Paint classes Bitmap */
GetWindowRect(hDlg, &DlgRect);
GetWindowRect(GetDlgItem(hDlg, ID_PLACEBITMAP), &aRect);
hBitmap = LoadMappedBitmap(hThisInstance, "CLASSESDLGBMP");
DrawBitmap(hDC, hBitmap,
aRect.left-DlgRect.left-GetSystemMetrics(SM_CXDLGFRAME),
aRect.top-DlgRect.top-GetSystemMetrics(SM_CYDLGFRAME)-GetSystemMetrics(SM_CYCAPTION));
DeleteObject(hBitmap);
EndPaint(hDlg, &Ps);
}
break;
case WM_COMPAREITEM: {
lpcis = (COMPAREITEMSTRUCT FAR *) lParam;
switch (wParam) {
case LB_CLASS: return strcmp (textToStr(cclass(lpcis->itemData1).text),
textToStr(cclass(lpcis->itemData2).text));
case LB_INSTANCES: if (nonNull(inst(lpcis->itemData1).specifics)) {
printContext(stdstr,inst(lpcis->itemData1).specifics);
fprintf(stdstr," => ");
}
printPred(stdstr,inst(lpcis->itemData1).head);
fprintf(stdstr,"\n");
strcpy (string1, stdstrbuff);
if (nonNull(inst(lpcis->itemData2).specifics)) {
printContext(stdstr,inst(lpcis->itemData2).specifics);
fprintf(stdstr," => ");
}
printPred(stdstr,inst(lpcis->itemData2).head);
fprintf(stdstr,"\n");
return strcmp (string1, stdstrbuff);
case LB_MEMBERS: printExp (stdstr, lpcis->itemData1);
fprintf(stdstr,"\n");
strcpy (string1, stdstrbuff);
printExp (stdstr, lpcis->itemData2);
fprintf(stdstr,"\n");
return strcmp (string1, stdstrbuff);
}
}
break;
case WM_MEASUREITEM:
lpdis = (DRAWITEMSTRUCT FAR *) lParam;
if (lpdis->CtlID == LB_CLASS ||
lpdis->CtlID == LB_INSTANCES ||
lpdis->CtlID == LB_MEMBERS ) {
lpmis = (LPMEASUREITEMSTRUCT) lParam;
/* Set the height of the list box items to Bitmap height */
hBmp = LoadBitmap(hThisInstance, "CLASSBMP");
GetObject(hBmp, sizeof(BITMAP), &bm);
DeleteObject(hBmp);
lpmis->itemHeight = bm.bmHeight+1;
lpmis->itemWidth = 50000;
return TRUE;
}
break;
case WM_DRAWITEM:
lpdis = (DRAWITEMSTRUCT FAR *) lParam;
if (lpdis->CtlID == LB_CLASS ||
lpdis->CtlID == LB_INSTANCES ||
lpdis->CtlID == LB_MEMBERS ) {
if (lpdis->itemID == (UINT)-1) {
return TRUE;
}
switch (lpdis->itemAction) {
case ODA_DRAWENTIRE:
case ODA_SELECT:
case ODA_FOCUS:
if ((lpdis->itemState & ODS_SELECTED) /*&& (lpdis->itemState & ODS_FOCUS)*/) {
SetBkColor(lpdis->hDC, GetSysColor(COLOR_HIGHLIGHT));
SetTextColor(lpdis->hDC, GetSysColor(COLOR_HIGHLIGHTTEXT));
Selected = TRUE;
}
else {
SetBkColor(lpdis->hDC, GetSysColor(COLOR_WINDOW));
SetTextColor(lpdis->hDC, GetSysColor(COLOR_WINDOWTEXT));
}
break;
default:
return FALSE;
}
switch (lpdis->CtlID) {
case LB_CLASS: theClass = (Class) SendDlgItemMessage(hDlg, lpdis->CtlID, LB_GETITEMDATA, lpdis->itemID, 0);
printPred(stdstr,cclass(theClass).head);
fprintf (stdstr, " -- in %s\n", textToStr(module(cclass(theClass).mod).text));
ExtTextOut(lpdis->hDC, lpdis->rcItem.left+21, lpdis->rcItem.top, ETO_OPAQUE, &(lpdis->rcItem), stdstrbuff, strlen(stdstrbuff), NULL);
hBmp = Selected ? hCSelBm : hCBm;
break;
case LB_INSTANCES: theInst = (Inst) SendDlgItemMessage(hDlg, lpdis->CtlID, LB_GETITEMDATA, lpdis->itemID, 0);
if (nonNull(inst(theInst).specifics)) {
printContext(stdstr,inst(theInst).specifics);
fprintf(stdstr," => ");
}
printPred(stdstr,inst(theInst).head);
fprintf (stdstr, " -- in %s \n", textToStr(module(moduleOfScript(scriptThisInst(theInst))).text));
ExtTextOut(lpdis->hDC, lpdis->rcItem.left+21, lpdis->rcItem.top, ETO_OPAQUE, &(lpdis->rcItem), stdstrbuff, strlen(stdstrbuff), NULL);
hBmp = Selected ? hISelBm : hIBm;
break;
case LB_MEMBERS: theMember = (Name) SendDlgItemMessage(hDlg, lpdis->CtlID, LB_GETITEMDATA, lpdis->itemID, 0);
printExp(stdstr,theMember);
fprintf(stdstr, " :: ");
printType(stdstr,name(theMember).type);
fprintf(stdstr,"\n");
ExtTextOut(lpdis->hDC, lpdis->rcItem.left+21, lpdis->rcItem.top, ETO_OPAQUE, &(lpdis->rcItem), stdstrbuff, strlen(stdstrbuff), NULL);
hBmp = Selected ? hMSelBm : hMBm;
break;
}
DrawBitmap (lpdis->hDC, hBmp, (lpdis->rcItem.left)+4, lpdis->rcItem.top);
/* If selected draw rectangle */
if ((lpdis->itemState & ODS_SELECTED)&&(lpdis->itemState & ODS_FOCUS)) {
DrawFocusRect(lpdis->hDC, &(lpdis->rcItem));
}
return TRUE;
}
case WM_COMMAND:
switch (wId) {
case LB_CLASS:
switch(NotifyCode) {
case LBN_SELCHANGE: /* select a new class */
currClass = (Class) SendDlgItemMessage(hDlg, LB_CLASS ,LB_GETITEMDATA, SendDlgItemMessage(hDlg, LB_CLASS ,LB_GETCURSEL, 0, 0L), 0L);
SetClass(hDlg, currClass);
break;
case LBN_DBLCLK: { /* Open in text editor script file with class definition */
currClass = (Class) SendDlgItemMessage(hDlg, LB_CLASS ,LB_GETITEMDATA, SendDlgItemMessage(hDlg, LB_CLASS ,LB_GETCURSEL, 0, 0L), 0L);
currClass = (Class) SendDlgItemMessage(hDlg, LB_CLASS ,LB_GETITEMDATA, SendDlgItemMessage(hDlg, LB_CLASS ,LB_GETCURSEL, 0, 0L), 0L);
setLastEdit(getScriptName(scriptThisClass(currClass)), cclass(currClass).line);
runEditor();
}
break;
}
break;
case LB_MEMBERS:
case LB_INSTANCES:
switch(NotifyCode) {/* Open in text editor script file with instance definition */
case LBN_DBLCLK: {
Inst currInst;
currInst = (Inst) SendDlgItemMessage(hDlg, LB_INSTANCES, LB_GETITEMDATA, SendDlgItemMessage(hDlg, LB_INSTANCES ,LB_GETCURSEL, 0, 0L), 0L);
/* Find instance module */
setLastEdit(getScriptName(scriptThisInst(currInst)), inst(currInst).line);
runEditor();
}
break;
}
break;
case ID_HIERARCHY: /* Draw classes hierarchy */
DrawClassesHierarchy();
break;
case ID_EDITCLASS: /* Pushed on Edit class button */
if (SendDlgItemMessage(hDlg, LB_CLASS, LB_GETCURSEL, 0, 0L) != LB_ERR)
DlgSendMessage(hDlg, WM_COMMAND, LB_CLASS, MAKELONG(0, LBN_DBLCLK));
break;
case ID_EDITINSTANCE: /* Pushed on Edit instance button */
if (SendDlgItemMessage(hDlg, LB_INSTANCES, LB_GETCURSEL, 0, 0L) != LB_ERR)
DlgSendMessage(hDlg, WM_COMMAND, LB_INSTANCES, MAKELONG(0, LBN_DBLCLK));
break;
case IDCANCEL: /* Close dialog */
case IDOK:
EndDialog(hDlg, TRUE);
return TRUE;
default:
return TRUE;
}
}
return FALSE;
}
