Commit bdeec1a5 authored by Diederik van Arkel's avatar Diederik van Arkel

switch to alternate file selectors

parent 5b006f5b
......@@ -152,7 +152,7 @@ where
# prjName = RemovePath prjPath
# prjPath = RemoveFilename prjPath
# (exename,ps) = PlatformDependant
(selectOutputFile "Executable" "*.exe" ps) // win
(selectOutputFile` "Executable" "*.exe" "Set" ps) // win
(selectOutputFile "Executable" prjName ps) // mac
| isNothing exename
= (ls,ps)
......@@ -331,7 +331,7 @@ where
*/
setrsrcs (ls,ps)
# (rsrcname,ps) = PlatformDependant
(selectOutputFile "Resource source" "*.exe" ps) // win
(selectOutputFile` "Resource source" "*.exe" "Set" ps) // win
(selectOutputFile "Resource source" "" ps) // mac
| isNothing rsrcname
= (ls,ps)
......@@ -346,7 +346,7 @@ where
setsymbols (ls,ps)
# (symbname,ps) = PlatformDependant
(selectOutputFile "DLL symbol source" "*" ps) // win
(selectOutputFile` "DLL symbol source" "*" "Set" ps) // win
(selectOutputFile "DLL symbol source" "" ps) // mac
| isNothing symbname
= (ls,ps)
......
......@@ -121,7 +121,7 @@ import first_run, UtilIO, PmPath
setTP tpId ps
# (prefs,ps) = getPrefs ps
# (result,ps) = selectOutputFile "Select time profiler" "*.exe" ps
# (result,ps) = selectOutputFile` "Select time profiler" "*.exe" "Set" ps
| isNothing result = ps
# full = fromJust result
# name = GetFileName full
......@@ -143,7 +143,7 @@ setTP tpId ps
setHP hpId ps
# (prefs,ps) = getPrefs ps
# (result,ps) = selectOutputFile "Select heap profiler" "*.exe" ps
# (result,ps) = selectOutputFile` "Select heap profiler" "*.exe" "Set" ps
| isNothing result = ps
# full = fromJust result
# name = GetFileName full
......@@ -165,7 +165,7 @@ setHP hpId ps
setPR prId ps
# (prefs,ps) = getPrefs ps
# (result,ps) = selectOutputFile "Select theorem prover" "*.exe" ps
# (result,ps) = selectOutputFile` "Select theorem prover" "*.exe" "Set" ps
| isNothing result = ps
# full = fromJust result
# name = GetFileName full
......
#define WINVER 0x0500
#include "util_121.h"
#include <Windows.h>
#include <Windowsx.h>
......@@ -8,6 +10,8 @@
#include "cAcceleratorTable_121.h"
#include "cCrossCallxDI_121.h"
#define CcRqALTFILESAVEDIALOG 1479
#define CcRqALTFILEOPENDIALOG 1478
//#define CcRqGETBITMAPRESOURCE 1477 /* Get bitmap handle */
#define CcRqSHELLDEFAULT 1476 /* shell execute interface */
#define CcRqALTDIRECTORYDIALOG 1475 /* alternative directory selector */
......@@ -271,6 +275,212 @@ static UINT APIENTRY DirectorySelectorHook (HWND hdlg, UINT uiMsg, WPARAM wParam
return 0;
}
static UINT APIENTRY FileSelectorHook (HWND hdlg, UINT uiMsg, WPARAM wParam, LPARAM lParam)
{
if (uiMsg == WM_INITDIALOG)
{
RECT rect;
int x, y;
GetWindowRect (hdlg, &rect);
x = (GetSystemMetrics (SM_CXSCREEN)>>1) - ((rect.right-rect.left)>>1);
y = (GetSystemMetrics (SM_CYSCREEN)>>1) - ((rect.bottom-rect.top)>>1);
SetWindowPos (hdlg, NULL, x, y, 0, 0, SWP_NOACTIVATE | SWP_NOSIZE | SWP_NOZORDER);
if ((lParam != NULL) && (((LPOPENFILENAME)lParam)->lCustData != NULL))
SendMessage(GetParent(hdlg),CDM_SETCONTROLTEXT,IDOK,((LPOPENFILENAME)lParam)->lCustData);
}
return 0;
}
#define MAXBUF 300
#define MAXFILTERS 10
static LPTSTR lpszFilterString ;
static TCHAR szFilterString[MAXBUF] ;
static TCHAR szFilterInits[MAXFILTERS][30] ;
void InitFilterString(void)
{
int i ;
int nInc = 0 ;
LPTSTR lpStr = szFilterString ;
/* First, zero out this memory just for the sake of sanity */
for (i=0; i<MAXBUF; i++)
szFilterString[i] = 0 ;
/* Now, for each string in the szFilterInits array, concatenate it to
the last one right after the last one's null terminator */
i = 0 ;
while (szFilterInits[i][0] != (TCHAR) 0)
{
lstrcpy(lpStr, &szFilterInits[i][0]) ;
nInc+=lstrlen(&szFilterInits[i][0]) + 1 ; //1 past null term...
lpStr = &szFilterString[nInc] ;
i++ ;
}
szFilterString[nInc] = (TCHAR) 0 ; //double terminator
/* Set the lpszFilterString to point to the memory we just filled in
with the filters because lpszFilterString is what is in
OPENFILENAME->lpstrFilter */
lpszFilterString = szFilterString ;
return ;
}
BOOL IsModernPlatform()
{
OSVERSIONINFOA osvi = {0};
osvi.dwOSVersionInfoSize = sizeof(osvi);
GetVersionExA((OSVERSIONINFOA*)&osvi);
return (5 <= osvi.dwMajorVersion);
}
void EvalCcRqALTFILEOPENDIALOG (CrossCallInfo *pcci) /* no params; bool, textptr result; */
{
OPENFILENAME ofn;
BOOL recent,success;
recent = IsModernPlatform();
lstrcpy(&szFilterInits[0][0], TEXT("All Files (*.*)")) ;
lstrcpy(&szFilterInits[1][0], TEXT("*.*")) ;
szFilterInits[2][0] = (TCHAR) 0 ;
InitFilterString();
if (recent)
{
ofn.lStructSize = sizeof (OPENFILENAME);
}
else
{
ofn.lStructSize = OPENFILENAME_SIZE_VERSION_400;
}
ofn.hwndOwner = GetActiveWindow ();
ofn.hInstance = NULL;
ofn.lpstrFilter = lpszFilterString;
ofn.lpstrCustomFilter = NULL;
ofn.nMaxCustFilter = 0;
ofn.nFilterIndex = 0;
ofn.lpstrFile = (LPSTR) rmalloc (MAX_PATH);
ofn.lpstrFile[0] = '\0';
ofn.nMaxFile = MAX_PATH;
ofn.lpstrFileTitle = NULL;
ofn.nMaxFileTitle = 0;
ofn.lpstrInitialDir = NULL;
ofn.lpstrTitle = NULL;
ofn.Flags = 0x81c24;
//OFN_EXPLORER
// | OFN_FILEMUSTEXIST
// | OFN_HIDEREADONLY
// | OFN_PATHMUSTEXIST;
// | OFN_NODEREFERENCELINKS;
// | OFN_ENABLEHOOK; // PA: OFN_ENABLEHOOK added from Ronny
ofn.lpstrDefExt = NULL;
ofn.lCustData = NULL;
ofn.lpfnHook = &FileSelectorHook; // PA: &FileSelectorHook instead of NULL from Ronny
ofn.lpTemplateName = NULL;
#if (_WIN32_WINNT >= 0x0500)
ofn.pvReserved = NULL;
ofn.dwReserved = 0;
ofn.FlagsEx = 0;
#endif // (_WIN32_WINNT >= 0x0500)
success = GetOpenFileName (&ofn);
if (success)
{
MakeReturn2Cci (pcci, success, (int) ofn.lpstrFile);
/* and have the calling clean function deallocate the filename buffer */
}
else
{
MakeReturn2Cci (pcci, success, (int) NULL);
rfree (ofn.lpstrFile);
}
}
void EvalCcRqALTFILESAVEDIALOG (CrossCallInfo *pcci) /* promptptr, nameptr; bool, textptr result; */
{
OPENFILENAME ofn;
BOOL success;
char *promptptr;
char *nameptr;
char *okptr;
promptptr = (char *) pcci->p1;
nameptr = (char *) pcci->p2;
okptr = (char *) pcci->p3;
if (rstrlen (promptptr) == 0)
promptptr = NULL; /* the calling clean function will
deallocate the memory allocated
for this empty string */
ofn.lStructSize = sizeof (OPENFILENAME);
ofn.hwndOwner = GetActiveWindow ();
ofn.lpstrFilter = NULL;
ofn.lpstrCustomFilter = NULL;
ofn.nMaxCustFilter = 0;
ofn.nFilterIndex = 0;
ofn.lpstrFile = (LPSTR) rmalloc (MAX_PATH);
if (rstrlen (nameptr) < MAX_PATH)
{
rscopy (ofn.lpstrFile, nameptr);
}
else
{
rsncopy (ofn.lpstrFile, nameptr, MAX_PATH - 1);
ofn.lpstrFile[MAX_PATH - 1] = '\0';
}
ofn.nMaxFile = MAX_PATH;
ofn.lpstrFileTitle = NULL;
ofn.nMaxFileTitle = 0;
ofn.lpstrInitialDir = NULL;
ofn.lpstrTitle = promptptr;
ofn.Flags = OFN_EXPLORER
// | OFN_OVERWRITEPROMPT
| OFN_HIDEREADONLY
| OFN_ENABLEHOOK; // PA: OFN_ENABLEHOOK added from Ronny
ofn.lpstrDefExt = NULL;
// ofn.lCustData = 0;
if (rstrlen (okptr) == 0)
okptr = NULL; /* the calling clean function will
deallocate the memory allocated
for this empty string */
ofn.lCustData = okptr;
ofn.lpfnHook = &FileSelectorHook; // PA: &FileSelectorHook instead of NULL from Ronny
ofn.lpTemplateName = NULL;
ofn.pvReserved = NULL;
ofn.dwReserved = 0;
ofn.FlagsEx = 0;
success = GetSaveFileName (&ofn);
if (success)
{
MakeReturn2Cci (pcci, success, (int) ofn.lpstrFile);
/* and have the calling clean function deallocate the filename buffer */
}
else
{
MakeReturn2Cci (pcci, success, (int) NULL);
rfree (ofn.lpstrFile);
}
}
void EvalCcRqALTDIRECTORYDIALOG (CrossCallInfo *pcci) /* no params; bool, textptr result; */
{
char buffer[MAX_PATH];
......@@ -344,6 +554,8 @@ int InstallCrossCallMaarten (int ios)
AddCrossCallEntry (newTable, CcRqSETWINDOWICON, EvalCcRqSETWINDOWICON);
// AddCrossCallEntry (newTable, CcRqGETBITMAPRESOURCE, EvalCcRqGETBITMAPRESOURCE);
AddCrossCallEntry (newTable, CcRqALTDIRECTORYDIALOG, EvalCcRqALTDIRECTORYDIALOG);
AddCrossCallEntry (newTable, CcRqALTFILEOPENDIALOG, EvalCcRqALTFILEOPENDIALOG);
AddCrossCallEntry (newTable, CcRqALTFILESAVEDIALOG, EvalCcRqALTFILESAVEDIALOG);
AddCrossCallEntry (newTable, CcRqSHELLDEFAULT, EvalCcRqSHELLDEFAULT);
AddCrossCallEntries (gCrossCallProcedureTable, newTable);
......
......@@ -26,6 +26,8 @@ GetShortPathName :: !String -> (!Bool,!String);
GetCurrentDirectory :: (!Bool,!String)
selectInputFile` :: !(PSt .l) -> (!Maybe String,!(PSt .l))
selectOutputFile` :: !String !String !String !(PSt .l) -> (!Maybe String,!(PSt .l))
selectDirectory` :: !(PSt .l) -> (!Maybe String,!(PSt .l))
ShellDefault :: !{#Char} !(PSt .l) -> (!Int,!(PSt .l))
......
......@@ -326,6 +326,24 @@ from scheduler import handleOneEventForDevices
from commondef import fatalError
CcRqALTDIRECTORYDIALOG :== 1475
CcRqALTFILEOPENDIALOG :== 1478
CcRqALTFILESAVEDIALOG :== 1479
selectInputFile` :: !(PSt .l) -> (!Maybe String,!(PSt .l))
selectInputFile` pState
# (tb,pState) = accPIO getIOToolbox pState
# tb = osInitialiseFileSelectors tb
# (ok,name,pState,tb) = osSelectinputfile handleOSEvent pState tb
# pState = appPIO (setIOToolbox tb) pState
= (if ok (Just name) Nothing,pState)
selectOutputFile` :: !String !String !String !(PSt .l) -> (!Maybe String,!(PSt .l))
selectOutputFile` prompt filename ok pState
# (tb,pState) = accPIO getIOToolbox pState
# tb = osInitialiseFileSelectors tb
# (ok,name,pState,tb) = osSelectoutputfile handleOSEvent pState prompt filename ok tb
# pState = appPIO (setIOToolbox tb) pState
= (if ok (Just name) Nothing,pState)
selectDirectory` :: !(PSt .l) -> (!Maybe String,!(PSt .l))
selectDirectory` env
......@@ -345,43 +363,85 @@ where
# pState = appPIO (setIOToolbox tb) pState
= (if ok (Just name) Nothing,pState)
// handleOSEvent turns handleOneEventForDevices into the form required by osSelect(in/out)putfile.
handleOSEvent :: !OSEvent !*(PSt .l) -> *PSt .l
handleOSEvent osEvent pState
= thd3 (handleOneEventForDevices (ScheduleOSEvent osEvent []) pState)
osSelectdirectory :: !(OSEvent->.s->.s) !.s !(Maybe String) !*OSToolbox -> (!Bool,!String,!.s,!*OSToolbox)
osSelectdirectory handleOSEvent state initial tb
# (initialptr, tb) = case initial of
Just initial -> winMakeCString initial tb
Nothing -> (0,tb)
# (rcci,state,tb) = issueCleanRequest (callback handleOSEvent) (Rq1Cci CcRqALTDIRECTORYDIALOG initialptr) state tb
# tb = case initialptr of
0 -> tb
_ -> winReleaseCString initialptr tb
# (ok,name,tb) = getinputfilename rcci tb
= (ok,name,state,tb)
where
getinputfilename :: !CrossCallInfo !*OSToolbox -> (!Bool,!String,!*OSToolbox)
getinputfilename {ccMsg=CcRETURN2,p1=ok,p2=ptr} tb
| ok==0
= (False,"",tb)
| otherwise
# (pathname,tb) = winGetCStringAndFree ptr tb
= (True,pathname,tb)
getinputfilename {ccMsg=CcWASQUIT} tb
= (False,"",tb)
getinputfilename {ccMsg} _
= osfileselectFatalError "osSelectdirectory" ("unexpected ccMsg field of return CrossCallInfo ("+++toString ccMsg+++")")
// callback lifts a function::(OSEvent -> .s -> .s) to
// a crosscallfunction::(CrossCallInfo -> .s -> *OSToolbox -> (CrossCallInfo,.s,*OSToolbox))
callback :: !(OSEvent->.s->.s) !CrossCallInfo !.s !*OSToolbox -> (!CrossCallInfo,!.s,!*OSToolbox)
callback handleOSEvent cci state tb = (return0Cci,handleOSEvent cci state,tb)
// handleOSEvent turns handleOneEventForDevices into the form required by osSelect(in/out)putfile.
handleOSEvent :: !OSEvent !*(PSt .l) -> *PSt .l
handleOSEvent osEvent pState
= thd3 (handleOneEventForDevices (ScheduleOSEvent osEvent []) pState)
osfileselectFatalError :: String String -> .x
osfileselectFatalError function error
= fatalError function "osfileselect" error
osSelectinputfile :: !(OSEvent->.s->.s) !.s !*OSToolbox -> (!Bool,!String,!.s,!*OSToolbox)
osSelectinputfile handleOSEvent state tb
# (rcci,state,tb) = issueCleanRequest (callback handleOSEvent) (Rq0Cci CcRqALTFILEOPENDIALOG) state tb
# (ok,name,tb) = getinputfilename rcci tb
= (ok,name,state,tb)
where
getinputfilename :: !CrossCallInfo !*OSToolbox -> (!Bool,!String,!*OSToolbox)
getinputfilename {ccMsg=CcRETURN2,p1=ok,p2=ptr} tb
| ok==0
= (False,"",tb)
| otherwise
# (pathname,tb) = winGetCStringAndFree ptr tb
= (True,pathname,tb)
getinputfilename {ccMsg=CcWASQUIT} tb
= (False,"",tb)
getinputfilename {ccMsg} _
= osfileselectFatalError "osSelectinputfile" ("unexpected ccMsg field of return CrossCallInfo ("+++toString ccMsg+++")")
osSelectoutputfile :: !(OSEvent->.s->.s) !.s !String !String !String !*OSToolbox -> (!Bool,!String,!.s,!*OSToolbox)
osSelectoutputfile handleOSEvent state prompt filename ok tb
# (promptptr, tb) = winMakeCString prompt tb
# (filenameptr,tb) = winMakeCString filename tb
# (okptr,tb) = winMakeCString ok tb
# (rcci,state, tb) = issueCleanRequest (callback handleOSEvent) (Rq3Cci CcRqALTFILESAVEDIALOG promptptr filenameptr okptr) state tb
# tb = winReleaseCString promptptr tb
# tb = winReleaseCString filenameptr tb
# tb = winReleaseCString okptr tb
# (ok,name,tb) = getoutputfilename rcci tb
= (ok,name,state,tb)
where
getoutputfilename :: !CrossCallInfo !*OSToolbox -> (!Bool,!String,!*OSToolbox)
getoutputfilename {ccMsg=CcRETURN2,p1=ok,p2=ptr} tb
| ok==0
= (False,"",tb)
| otherwise
# (path,tb) = winGetCStringAndFree ptr tb
= (True,path,tb)
getoutputfilename {ccMsg=CcWASQUIT} tb
= (False,"",tb)
getoutputfilename {ccMsg} _
= osfileselectFatalError "osSelectoutputfile" ("unexpected ccMsg field of return CrossCallInfo ("+++toString ccMsg+++")")
osSelectdirectory :: !(OSEvent->.s->.s) !.s !(Maybe String) !*OSToolbox -> (!Bool,!String,!.s,!*OSToolbox)
osSelectdirectory handleOSEvent state initial tb
# (initialptr, tb) = case initial of
Just initial -> winMakeCString initial tb
Nothing -> (0,tb)
# (rcci,state,tb) = issueCleanRequest (callback handleOSEvent) (Rq1Cci CcRqALTDIRECTORYDIALOG initialptr) state tb
# tb = case initialptr of
0 -> tb
_ -> winReleaseCString initialptr tb
# (ok,name,tb) = getinputfilename rcci tb
= (ok,name,state,tb)
where
getinputfilename :: !CrossCallInfo !*OSToolbox -> (!Bool,!String,!*OSToolbox)
getinputfilename {ccMsg=CcRETURN2,p1=ok,p2=ptr} tb
| ok==0
= (False,"",tb)
| otherwise
# (pathname,tb) = winGetCStringAndFree ptr tb
= (True,pathname,tb)
getinputfilename {ccMsg=CcWASQUIT} tb
= (False,"",tb)
getinputfilename {ccMsg} _
= osfileselectFatalError "osSelectdirectory" ("unexpected ccMsg field of return CrossCallInfo ("+++toString ccMsg+++")")
// callback lifts a function::(OSEvent -> .s -> .s) to
// a crosscallfunction::(CrossCallInfo -> .s -> *OSToolbox -> (CrossCallInfo,.s,*OSToolbox))
callback :: !(OSEvent->.s->.s) !CrossCallInfo !.s !*OSToolbox -> (!CrossCallInfo,!.s,!*OSToolbox)
callback handleOSEvent cci state tb = (return0Cci,handleOSEvent cci state,tb)
osfileselectFatalError :: String String -> .x
osfileselectFatalError function error
= fatalError function "osaltfileselect" error
//== UNSAFE HACK...
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment