platform abstraction tools options

Ide/ideoptions.icl

@@ -4,22 +4,16 @@ import StdFunc
 import StdWindow
 import StdPStClass
 import IdeState
-import ioutil
+import ioutil, tools
 
 ideOptionsDialog :: !*(PSt *General) -> *(PSt *General)
 ideOptionsDialog ps
 	# (prefs,ps)	= getPrefs ps
 	# (wId,ps)		= openId ps
 	# (okId,ps)		= openId ps
-	# (tpId,ps)		= openId ps
-	# (hpId,ps)		= openId ps
-	# (prId,ps)		= openId ps
 	# iniSWMark		= toMark prefs.switch_close
 	# iniTBMark		= toMark prefs.show_toolbar
 	# iniBVMark		= toMark prefs.be_verbose
-	# iniTPString	= prefs.reg_prefs.tp_path +++ prefs.reg_prefs.tp_name
-	# iniHPString	= prefs.reg_prefs.hp_path +++ prefs.reg_prefs.hp_name
-	# iniPRString	= prefs.reg_prefs.pr_path +++ prefs.reg_prefs.pr_name
 	# (iniNHIndex,iniCVIndex)
 					= case prefs.newline_handling of
 						(LeaveAlone NewlineConventionNone)	-> (1,1)
@@ -31,15 +25,14 @@ ideOptionsDialog ps
 						(AlwaysUse NewlineConventionUnix)	-> (2,3)
 						(AlwaysUse NewlineConventionDos)	-> (2,4)
 	# iniAWMark		= toMark prefs.altgr_workaround
+	# (ti,ps)		= toolData prefs ps
 	# (_,ps)		= openModalDialog Void (ddef iniSWMark iniTBMark iniBVMark iniNHIndex iniCVIndex iniAWMark
-						iniTPString iniHPString iniPRString
-						tpId hpId prId okId wId) ps
+						ti okId wId) ps
 	= ps
 
 ddef
 	iniSWMark iniTBMark iniBVMark iniNHIndex iniCVIndex iniAWMark
-	iniTPString iniHPString iniPRString
-	tpId hpId prId okId wId
+	ti okId wId
 	= Dialog "IDE Options"
 		(	CheckControl
 			[("Switch windows",Nothing,iniSWMark,noLS switchSW)
@@ -67,16 +60,7 @@ ddef
 			(Rows 1)
 			(iniCVIndex)
 			[ControlPos (Left,zero)]
-		:+:	TextControl "Time Profiler:" [ControlPos (Left,zero),ControlWidth (ContentWidth "Theorem Prover:")]
-		:+: EditControl iniTPString (PixelWidth 300) 1 [ControlId tpId,ControlSelectState Unable]
-		:+: ButtonControl "Select..." [ControlFunction (noLS (setTP tpId))]
-		:+: TextControl "Heap Profiler:" [ControlPos (Left,zero),ControlWidth (ContentWidth "Theorem Prover:")]
-		:+: EditControl iniHPString (PixelWidth 300) 1 [ControlId hpId,ControlSelectState Unable]
-		:+: ButtonControl "Select..." [ControlFunction (noLS (setHP hpId))]
-		:+: TextControl "Theorem Prover:" [ControlPos (Left,zero),ControlWidth (ContentWidth "Theorem Prover:")]
-		:+: EditControl iniPRString (PixelWidth 300) 1 [ControlId prId,ControlSelectState Unable]
-		:+: ButtonControl "Select..." [ControlFunction (noLS (setPR prId))]
-		:+: ButtonControl "Clear Registry" [ControlPos (Left,zero),ControlFunction (noLS clearRegistry)]
+		:+: toolOptions ti
 		:+: ButtonControl "OK" [ControlPos (Right,zero), ControlFunction (noLS (closeWindow wId)), ControlId okId]
 		) [WindowClose (noLS (closeWindow wId)), WindowId wId, WindowOk okId, WindowCancel okId]
 
@@ -115,78 +99,3 @@ changeCV cv ps
 						(AlwaysUse _)	-> AlwaysUse cv
 					  }
 	= setPrefs prefs ps
-
-//import dodebug
-import first_run, UtilIO, PmPath
-
-setTP tpId ps
-	# (prefs,ps)	= getPrefs ps
-	# (result,ps)	= selectOutputFile` "Select time profiler" "*.exe" "Set" ps
-	| isNothing result = ps
-	# full			= fromJust result
-	# name			= GetFileName full
-	# short			= case GetShortPathName full of
-						(True,short)	-> short
-						_				-> full
-	# rpath			= GetFilePath short
-	# (app_path,ps)	= getStup ps
-	# spath			= symAppPath app_path (GetFilePath full)
-	# ps			= appPIO (setControlText tpId (spath +++ name)) ps
-	# prefs			= {prefs & reg_prefs.tp_name = name, reg_prefs.tp_path = spath}
-	# ps			= setPrefs prefs ps
-	# (ide_name,ide_path,ide_vers,errs)
-					= get_ide_from_registry
-	| not (isEmpty errs) || ide_name == "" || ide_path == "" || ide_vers == "" = ps
-	# errs			= change_pcl_registry_fun ide_name ide_path name rpath
-	| errs == []	= ps
-	= ps
-
-setHP hpId ps
-	# (prefs,ps)	= getPrefs ps
-	# (result,ps)	= selectOutputFile` "Select heap profiler" "*.exe" "Set" ps
-	| isNothing result = ps
-	# full			= fromJust result
-	# name			= GetFileName full
-	# short			= case GetShortPathName full of
-						(True,short)	-> short
-						_				-> full
-	# rpath			= GetFilePath short
-	# (app_path,ps)	= getStup ps
-	# spath			= symAppPath app_path (GetFilePath full)
-	# ps			= appPIO (setControlText hpId (spath +++ name)) ps
-	# prefs			= {prefs & reg_prefs.hp_name = name, reg_prefs.hp_path = spath}
-	# ps			= setPrefs prefs ps
-	# (ide_name,ide_path,ide_vers,errs)
-					= get_ide_from_registry
-	| not (isEmpty errs) || ide_name == "" || ide_path == "" || ide_vers == "" = ps
-	# errs			= change_hcl_registry_fun ide_name ide_path name rpath
-	| errs == []	= ps
-	= ps
-
-setPR prId ps
-	# (prefs,ps)	= getPrefs ps
-	# (result,ps)	= selectOutputFile` "Select theorem prover" "*.exe" "Set" ps
-	| isNothing result = ps
-	# full			= fromJust result
-	# name			= GetFileName full
-	# short			= case GetShortPathName full of
-						(True,short)	-> short
-						_				-> full
-	# rpath			= GetFilePath short
-	# (app_path,ps)	= getStup ps
-	# spath			= symAppPath app_path (GetFilePath full)
-	# ps			= appPIO (setControlText prId (spath +++ name)) ps
-	# prefs			= {prefs & reg_prefs.pr_name = name, reg_prefs.pr_path = spath}
-	= setPrefs prefs ps
-
-clearRegistry ps
-	# (errs,ps)		= uninstall ps
-	| errs == [] = ps
-	# (okId,ps)		= openId ps
-	# (dlogId,ps)	= openId ps
-	# (_,ps)		= openModalDialog Void (Dialog "Clear Registry errors"
-						(	TextControl "Clear Registry produced an error:"	[]
-						:+:	TextControl (hd errs) [ControlPos (Left,zero)]
-						:+: ButtonControl "OK" [ControlId okId,ControlFunction (noLS (closeWindow dlogId))]) 
-						[WindowOk okId,WindowId dlogId]) ps
-	= ps

Win/tools.dcl

@@ -12,3 +12,7 @@ shoheapfun :: !*(PSt General) -> *PSt General
 
 provefun :: !*(PSt General) -> *PSt General
 // launch theorem prover for active project
+
+:: ToolInfo
+toolData :: !.Prefs !*(PSt General) -> *(!.ToolInfo,!*PSt General)
+toolOptions :: !.ToolInfo -> (:+: .TextControl (:+: .EditControl (:+: .ButtonControl (:+: .TextControl (:+: .EditControl (:+: .ButtonControl (:+: .TextControl (:+: .EditControl (:+: .ButtonControl .ButtonControl)))))))) .a *(PSt *General))

Win/tools.icl

@@ -95,3 +95,119 @@ provefun ps
 		= openNotice (Notice ["Unable to launch " +++  cps +++ "."] (NoticeButton "OK" id) []) ps
 	= ps
 
+:: ToolInfo =
+	{ tpId			:: !Id
+	, tpString		:: !String
+	, hpId			:: !Id
+	, hpString		:: !String
+	, prId			:: !Id
+	, prString		:: !String
+	}
+
+toolData :: !.Prefs !*(PSt General) -> *(!.ToolInfo,!*PSt General)
+toolData prefs ps
+	# (tpId,ps)		= openId ps
+	# (hpId,ps)		= openId ps
+	# (prId,ps)		= openId ps
+	# iniTPString	= prefs.reg_prefs.tp_path +++ prefs.reg_prefs.tp_name
+	# iniHPString	= prefs.reg_prefs.hp_path +++ prefs.reg_prefs.hp_name
+	# iniPRString	= prefs.reg_prefs.pr_path +++ prefs.reg_prefs.pr_name
+	# ti			=
+						{ tpId			= tpId
+						, tpString		= iniTPString
+						, hpId			= hpId
+						, hpString		= iniHPString
+						, prId			= prId
+						, prString		= iniPRString
+						}
+	= (ti,ps)
+
+
+toolOptions :: !.ToolInfo -> (:+: .TextControl (:+: .EditControl (:+: .ButtonControl (:+: .TextControl (:+: .EditControl (:+: .ButtonControl (:+: .TextControl (:+: .EditControl (:+: .ButtonControl .ButtonControl)))))))) .a *(PSt *General))
+toolOptions ti=:{tpId,tpString,hpId,hpString,prId,prString} 
+	=	TextControl "Time Profiler:" [ControlPos (Left,zero),ControlWidth (ContentWidth "Theorem Prover:")]
+	:+: EditControl tpString (PixelWidth 300) 1 [ControlId tpId,ControlSelectState Unable]
+	:+: ButtonControl "Select..." [ControlFunction (noLS (setTP tpId))]
+	:+: TextControl "Heap Profiler:" [ControlPos (Left,zero),ControlWidth (ContentWidth "Theorem Prover:")]
+	:+: EditControl hpString (PixelWidth 300) 1 [ControlId hpId,ControlSelectState Unable]
+	:+: ButtonControl "Select..." [ControlFunction (noLS (setHP hpId))]
+	:+: TextControl "Theorem Prover:" [ControlPos (Left,zero),ControlWidth (ContentWidth "Theorem Prover:")]
+	:+: EditControl prString (PixelWidth 300) 1 [ControlId prId,ControlSelectState Unable]
+	:+: ButtonControl "Select..." [ControlFunction (noLS (setPR prId))]
+	:+: ButtonControl "Clear Registry" [ControlPos (Left,zero),ControlFunction (noLS clearRegistry)]
+
+
+//import dodebug
+import first_run, PmPath, StdList
+
+setTP tpId ps
+	# (prefs,ps)	= getPrefs ps
+	# (result,ps)	= selectOutputFile` "Select time profiler" "*.exe" "Set" ps
+	| isNothing result = ps
+	# full			= fromJust result
+	# name			= GetFileName full
+	# short			= case GetShortPathName full of
+						(True,short)	-> short
+						_				-> full
+	# rpath			= GetFilePath short
+	# (app_path,ps)	= getStup ps
+	# spath			= symAppPath app_path (GetFilePath full)
+	# ps			= appPIO (setControlText tpId (spath +++ name)) ps
+	# prefs			= {prefs & reg_prefs.tp_name = name, reg_prefs.tp_path = spath}
+	# ps			= setPrefs prefs ps
+	# (ide_name,ide_path,ide_vers,errs)
+					= get_ide_from_registry
+	| not (isEmpty errs) || ide_name == "" || ide_path == "" || ide_vers == "" = ps
+	# errs			= change_pcl_registry_fun ide_name ide_path name rpath
+	| errs == []	= ps
+	= ps
+
+setHP hpId ps
+	# (prefs,ps)	= getPrefs ps
+	# (result,ps)	= selectOutputFile` "Select heap profiler" "*.exe" "Set" ps
+	| isNothing result = ps
+	# full			= fromJust result
+	# name			= GetFileName full
+	# short			= case GetShortPathName full of
+						(True,short)	-> short
+						_				-> full
+	# rpath			= GetFilePath short
+	# (app_path,ps)	= getStup ps
+	# spath			= symAppPath app_path (GetFilePath full)
+	# ps			= appPIO (setControlText hpId (spath +++ name)) ps
+	# prefs			= {prefs & reg_prefs.hp_name = name, reg_prefs.hp_path = spath}
+	# ps			= setPrefs prefs ps
+	# (ide_name,ide_path,ide_vers,errs)
+					= get_ide_from_registry
+	| not (isEmpty errs) || ide_name == "" || ide_path == "" || ide_vers == "" = ps
+	# errs			= change_hcl_registry_fun ide_name ide_path name rpath
+	| errs == []	= ps
+	= ps
+
+setPR prId ps
+	# (prefs,ps)	= getPrefs ps
+	# (result,ps)	= selectOutputFile` "Select theorem prover" "*.exe" "Set" ps
+	| isNothing result = ps
+	# full			= fromJust result
+	# name			= GetFileName full
+	# short			= case GetShortPathName full of
+						(True,short)	-> short
+						_				-> full
+	# rpath			= GetFilePath short
+	# (app_path,ps)	= getStup ps
+	# spath			= symAppPath app_path (GetFilePath full)
+	# ps			= appPIO (setControlText prId (spath +++ name)) ps
+	# prefs			= {prefs & reg_prefs.pr_name = name, reg_prefs.pr_path = spath}
+	= setPrefs prefs ps
+
+clearRegistry ps
+	# (errs,ps)		= uninstall ps
+	| errs == [] = ps
+	# (okId,ps)		= openId ps
+	# (dlogId,ps)	= openId ps
+	# (_,ps)		= openModalDialog Void (Dialog "Clear Registry errors"
+						(	TextControl "Clear Registry produced an error:"	[]
+						:+:	TextControl (hd errs) [ControlPos (Left,zero)]
+						:+: ButtonControl "OK" [ControlId okId,ControlFunction (noLS (closeWindow dlogId))]) 
+						[WindowOk okId,WindowId dlogId]) ps
+	= ps