switch to alternate file selectors

Ide/PmDialogues.icl

@@ -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)

Ide/ideoptions.icl

@@ -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

Win/PatchConsoleEvents/cCrossCallMaarten.c

+#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);
 

Win/UtilIO.dcl

@@ -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))
 

Win/UtilIO.icl

@@ -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...