cleanup for Clean2 release

Pm/PmPrefs.dcl

 definition module PmPrefs
 
-/*
-	The IDE Preferences
-*/
+// The IDE Preferences
 
 from	StdPictureDef		import :: FontDef
 import	StdFile, StdIOBasic
@@ -90,6 +88,21 @@ PrefsFileName :== "IDEPrefs"
 	, be_verbose	:: !Bool						// give extended diagnostics
 	, altgr_workaround	:: !Bool					// temp fix to workaround french azerty keyboard menu shortcuts...
 	, newline_handling	:: !NewlinePrefs
+	
+	, reg_prefs		:: !RegPrefs
+	}
+
+:: RegPrefs =
+	{ rp_flags		:: ![(String,String,String)]
+	// should use registry entries for the following instead of Prefs file...
+	, tp_name		:: !String
+	, tp_path		:: !String
+	, hp_name		:: !String
+	, hp_path		:: !String
+	, pr_name		:: !String
+	, pr_path		:: !String
+	, ve_name		:: !String
+	, ve_path		:: !String
 	}
 
 :: NewlinePrefs

Pm/PmPrefs.icl

@@ -85,9 +85,20 @@ PrefsFileName :== "IDEPrefs"
 	, be_verbose	:: !Bool						// give extended diagnostics
 	, altgr_workaround :: !Bool						// temp fix to workaround french azerty keyboard menu shortcuts...
 	, newline_handling	:: !NewlinePrefs
-// RWS ...
-//	, number_of_processes	:: !Int
-// ... RWS
+	
+	, reg_prefs		:: !RegPrefs
+	}
+
+:: RegPrefs =
+	{ rp_flags		:: ![(String,String,String)]
+	, tp_name		:: !String
+	, tp_path		:: !String
+	, hp_name		:: !String
+	, hp_path		:: !String
+	, pr_name		:: !String
+	, pr_path		:: !String
+	, ve_name		:: !String
+	, ve_path		:: !String
 	}
 
 :: NewlinePrefs
@@ -120,8 +131,21 @@ emptyPrefs =
 	, be_verbose	= False
 	, altgr_workaround = False
 	, newline_handling = LeaveAlone NewlineConventionNone
+	, reg_prefs		= emptyRegPrefs
 	}
 
+emptyRegPrefs =
+	{ rp_flags		= []
+	, tp_name		= "ShowTimeProfile.exe"
+	, tp_path		= "C:\\CLEAN\\TOOLS\\TIMEPR~1\\"
+	, hp_name		= "ShowHeapProfile.exe"
+	, hp_path		= "C:\\CLEAN\\TOOLS\\HEAPPR~1\\"
+	, pr_name		= "Sparkle.exe"
+	, pr_path		= "C:\\CLEAN\\TOOLS\\SPARKLE\\"
+	, ve_name		= ""
+	, ve_path		= ""
+	}
+	
 emptyTypPrefs =
 	{ typewinfont	= NonProportionalFontDef
 	, typewinpos	= {vx=30,vy=30}
@@ -354,6 +378,7 @@ PrefsOptionsTable =
 	, SimpleOption "BeVerbose" (\a->if a.be_verbose "1" "0") (\v a->{a & be_verbose=(if (v=="1") True False)})
 	, SimpleOption "AltGrWorkaround" (\a->if a.altgr_workaround "1" "0") (\v a->{a & altgr_workaround=(if (v=="1") True False)})
 	, SimpleOption "NewlineHandling" writeNLH readNLH
+	, GroupedOption "RegPrefs" RegPrefsOptionsTable (\a->a.reg_prefs) (\v a->{a & reg_prefs = v})
 	}
 where
 	writeNLH {newline_handling}
@@ -378,6 +403,28 @@ where
 			"A3"	-> {a & newline_handling = AlwaysUse NewlineConventionDos}
 			_		-> {a & newline_handling = LeaveAlone NewlineConventionNone}
 
+RegPrefsOptionsTable :: OptionsTable RegPrefs
+RegPrefsOptionsTable =
+	{ ListOption "ClideFlags" FlagOption ("","","") (\a->ListToStrictList a.rp_flags) (\v a->{a & rp_flags=StrictListToList v})
+	, SimpleOption "TimepName" (\a->a.tp_name) (\v a->{a & tp_name=v})
+	, SimpleOption "TimepPath" (\a->a.tp_path) (\v a->{a & tp_path=v})
+	, SimpleOption "HeappName" (\a->a.hp_name) (\v a->{a & hp_name=v})
+	, SimpleOption "HeappPath" (\a->a.hp_path) (\v a->{a & hp_path=v})
+	, SimpleOption "ProofName" (\a->a.pr_name) (\v a->{a & pr_name=v})
+	, SimpleOption "ProofPath" (\a->a.pr_path) (\v a->{a & pr_path=v})
+	, SimpleOption "VisedName" (\a->a.ve_name) (\v a->{a & ve_name=v})
+	, SimpleOption "VisedPath" (\a->a.ve_path) (\v a->{a & ve_path=v})
+	}
+
+FlagOption = GroupedOption "Flags" FlagsOptionsTable id const
+
+FlagsOptionsTable :: OptionsTable (String,String,String)
+FlagsOptionsTable =
+	{ SimpleOption "fName" (\(a,_,_)->a) (\v (a,b,c)->(v,b,c))
+	, SimpleOption "fPath" (\(_,a,_)->a) (\v (a,b,c)->(a,v,c))
+	, SimpleOption "fVers" (\(_,_,a)->a) (\v (a,b,c)->(a,b,v))
+	}
+
 ErrPrefsOptionsTable :: OptionsTable ErrPrefs
 ErrPrefsOptionsTable =
 	{ GroupedOption "EWPos" VectOptionsTable (\a->a.err_pos) (\v a->{a & err_pos=v})

Pm/PmProject.icl

@@ -839,8 +839,7 @@ ReadProjectFile projectPath applicationDir ps
 									(id)
 								) project	// DvA: need to set needs save flag for project;
 /*
-Mooier is om ipv bovenstaande een dialoogje te laten zien met popupje met mogelijke environments.
-Plus button om in htmlHelp in relevante sectie over environments te komen.
+It's better to replace above with a dialog with popup of available environments.
 */
 		project					= SetProject applicationDir projectDir project
 		execpath				= PR_GetExecPath project
@@ -849,7 +848,7 @@ Plus button om in htmlHelp in relevante sectie over environments te komen.
 		(closed, ps)			= fclose file ps
 	| not closed
 		// generate warning?
-		=	((project, True,"The file \"" +++ projectName +++ "\" clould not be closed."), ps)
+		=	((project, True,"The file \"" +++ projectName +++ "\" could not be closed."), ps)
 	=	((project, True,""), ps)
 
 getStaticInfo :: !Project -> (ProjectStaticInfo,Project)

Pm/PmTypes.dcl

 definition module PmTypes
 
-/*	The types for the Project Manager */
+// The types for the Project Manager
 
-
-from StdPathname import :: Pathname
-from UtilNewlinesFile import :: NewlineConvention(..)
-import PmCompilerOptions
-from UtilStrictLists import :: List
-import UtilDate
+from	StdPathname			import :: Pathname
+from	UtilNewlinesFile	import :: NewlineConvention(..)
+import	PmCompilerOptions
+from	UtilStrictLists		import :: List
+import	UtilDate
 
 ::	Modulename			:== String
 
@@ -35,7 +34,7 @@ instance fromString Processor
 
 DefaultLinkOptions		:: LinkOptions
 
-:: LinkMethod
+:: LinkMethod				// => is really project method/type now?
 	= LM_Static
 //	| LM_Eager
 	| LM_Dynamic

Pm/PmTypes.icl

 implementation module PmTypes
 
-/*	The types for the Project Manager */
+// The types for the Project Manager
 
 import StdBool, StdInt
 import UtilStrictLists, UtilDate

Registry/first_run.icl

-module first_run
+implementation module first_run
 
-import StdEnv, StdMaybe, StdDebug
+import StdEnv, StdMaybe
+import StdDebug
 import registry, version
 import UtilIO
-import dodebug
 
 //==
 
@@ -15,18 +15,40 @@ GetLastError = code {
 	}
 
 //==
+
+GetVNP :: (String,String,String)
+GetVNP = (app_vers,app_name,app_path)
+where
+	path		= winGetModulePath
+	long_path	= GetLongPathName path
+	app_name	= GetFileName long_path
+	app_path	= GetFilePath path
+	app_vers	= ReadVersionInfo
+
+//==
 	
-Start w = startIO NDI Void pinit [ProcessClose closeProcess] w
+Start`` w = startIO NDI Void pinit [ProcessClose closeProcess] w
 
 pinit ps
-	# ps = first_run app_vers app_path app_name ps
+	# ((flag_name,flag_path,flag_vers),ps) = read_version_flag ps
+	# flags = [(flag_name,flag_path,flag_vers)]
+	# (res,ps) = first_run ide_vers ide_name ide_path pcl_name pcl_path hcl_name hcl_path flags ps
+	# ps = case res of
+			True	-> write_version_flag (ide_name,ide_path,ide_vers) ps
+			_		-> ps
 	= finish ps
 where
-	app_name = GetFileName long_path
-	app_path = GetFilePath path
-	app_vers = ReadVersionInfo
-	path	 = winGetModulePath
-	long_path= GetLongPathName path
+	path		= winGetModulePath
+	long_path	= GetLongPathName path
+//	ide_name	= GetFileName long_path
+//	ide_path	= GetFilePath path
+	ide_name	= "CleanIDE.exe"
+	ide_path	= "C:\\CLEAN\\"
+	ide_vers	= ReadVersionInfo
+	pcl_name	= "ShowTimeProfile.exe"
+	pcl_path	= "C:\\CLEAN\\TOOLS\\TIMEPR~1\\"
+	hcl_name	= "ShowHeapProfile.exe"
+	hcl_path	= "C:\\CLEAN\\TOOLS\\HEAPPR~1\\"
 
 GetFileName :: !String -> String;
 GetFileName path
@@ -101,7 +123,7 @@ ReadVersionInfo
 	# sptr		= s2i buff
 	# slen		= s2i blen
 //	# info		= toString sptr +++ " :: " +++ toString slen
-	# info		= {read_char p \\ p <- [sptr..] & x <- [1..slen]}
+	# info		= {read_char p \\ p <- [sptr..] & x <- [1..slen-1]}
 	= info
 where
 	path = winGetModulePath+++."\0"
@@ -111,114 +133,124 @@ where
 
 //==
 
-MyEntry		:== 1
-NoEntry		:== 2
-DiffEntry	:== 3
+:: CheckResult
+	= MyEntry
+	| NoEntry
+	| DiffEntry
+	| ErrEntry !String
 
-Yes			:== 1
-No			:== 2
-Never		:== 3
+:: DialogResult
+	= Yes
+	| No
+	| Never
 
-first_run app_vers app_path app_name ps
-	# (run,ps)				= check_flag app_vers app_path app_name ps
+first_run :: !String !String !String !String !String !String !String ![(String,String,String)] !(PSt .ls) -> (!Bool,!PSt .ls)
+first_run ide_vers ide_name ide_path pcl_name pcl_path hcl_name hcl_path flags ps
+	# (run,ps)				= check_flags ide_vers ide_path ide_name flags ps
 	| not run
-		= ps
-	# (res,ps)				= check_registry app_path ps
-	| res == MyEntry
-		= ps
-	| res == NoEntry
-		# (res,ps)			= init_dialog ps
-		| res == Yes
-			# ps			= set_registry app_name app_path ps
-			= ps
-		| res == No
-			= ps
-		| res == Never
-			# ps			= set_flag app_vers app_path app_name ps
-			= ps
-		= abort "Uncaught case in first_run:first_run: [2]\n"
-	| res == DiffEntry
-		# (res,ps)			= delta_dialog ps
-		| res == Yes
-			# ps			= set_registry app_name app_path ps
-			= ps
-		| res == No
-			= ps
-		| res == Never
-			# ps			= set_flag app_vers app_path app_name ps
-			= ps
-		= abort "Uncaught case in first_run:first_run: [3]\n"
-	= abort "Uncaught case in first_run:first_run: [1]\n"
-
-uninstall application_path ps
-	= abort "first_run:uninstall unimplemented.\n"
+		= (False,ps)
+	# (res,ps)				= check_registry ide_name ide_path ide_vers ps
+	= case res of
+		MyEntry				-> (False,ps)
+		NoEntry
+			# (res,ps)		= init_dialog ps
+			-> case res of
+				Yes			# (err,ps)	= set_registry ide_vers ide_name ide_path pcl_name pcl_path hcl_name hcl_path ps
+							| err <> ""
+								# ps	= err_dialog False err ps
+								= (False,ps)
+							= (False,ps)
+				No			-> (False,ps)
+				Never		-> (True,ps)
+		DiffEntry
+			# (res,ps)		= delta_dialog ps
+			-> case res of
+				Yes			# (err,ps)	= set_registry ide_vers ide_name ide_path pcl_name pcl_path hcl_name hcl_path ps
+							| err <> ""
+								# ps	= err_dialog False err ps
+								= (False,ps)
+							= (False,ps)
+				No			-> (False,ps)
+				Never		-> (True,ps)
+		ErrEntry err
+			# ps			= err_dialog True err ps
+			= (False,ps)
+
+uninstall :: !(PSt .ls)	-> (![String],!PSt .ls)
+uninstall ps
+	# (e,rs) = ([],0)
+	# (e,rs) = remove_file_type_from_registry ".icl\0" "iclfile\0" "open\0" e rs
+	# (e,rs) = remove_file_type_from_registry ".dcl\0" "dclfile\0" "open\0" e rs
+	# (e,rs) = remove_file_type_from_registry ".prj\0" "prjfile\0" "open\0" e rs
+	# (e,rs) = remove_file_type_from_registry ".abc\0" "abcfile\0" "open\0" e rs
+	# (e,rs) = remove_file_type_from_registry ".pcl\0" "pclfile\0" "open\0" e rs
+	# (e,rs) = remove_file_type_from_registry ".hcl\0" "hclfile\0" "open\0" e rs
+	# (e,rs) = remove_ide_from_registry e rs
+	= (e,ps)
+
 	
 //==
 
-check_flag app_vers app_path app_name ps
-	// read flag => flag+vers+path+name
-	// compare...
-	// if vers & path & name match => use flag
-	// otherwise run first-run
-	# (ok,file,ps) = fopen "VERSION.txt" FReadText ps
+read_version_flag ps
+	# (ok,file,ps)		= fopen "VERSION.txt" FReadText ps
 	| not ok = abort "no VERSION"
 	# (flag_vers,file)	= freadline file
 	# (flag_name,file)	= freadline file
 	# (flag_path,file)	= freadline file
-	# flag_vers = dropnl flag_vers
-	# flag_name = dropnl flag_name
-	# flag_path = dropnl flag_path
-	# (_,ps) = fclose file ps
-	| app_vers == flag_vers && app_path == flag_path && app_name == flag_name
-		= trace_n` "check=>False" (False,ps)
-	= trace_n` "check=>True" (True,ps)
+	# flag_vers			= dropnl flag_vers
+	# flag_name			= dropnl flag_name
+	# flag_path			= dropnl flag_path
+	# (_,ps)			= fclose file ps
+	= ((flag_name,flag_path,flag_vers),ps)
 where
-	flag_vers	= "2.0.1.42\0"
-	flag_name	= "first_run.exe"
-	flag_path	= "C:\\CLEANTOOLS\\REGISTRY\\"
-	
 	dropnl s = {c \\ c <-: s | c <> '\xA' && c <> '\xD'}
 
-set_flag app_vers app_path app_name ps
-	# ps = trace_n` ("set",app_vers,app_path,app_name) ps
-	# (ok,file,ps) = fopen "VERSION.txt" FWriteText ps
+write_version_flag (flag_name,flag_path,flag_vers) ps
+	# (ok,file,ps)	= fopen "VERSION.txt" FWriteText ps
 	| not ok = abort "set failed"
-	# file = writeln app_vers file
-	# file = writeln app_name file
-	# file = writeln app_path file
-	# (_,ps) = fclose file ps
+	# file			= writeln flag_vers file
+	# file			= writeln flag_name file
+	# file			= writeln flag_path file
+	# (_,ps)		= fclose file ps
 	= ps
 where
 	writeln s f = f <<< s <<< '\n'
 
-check_registry app_path ps
-	# (err,rs)			= ([],7)
-	# (err,found,rs)	= check_file_type_in_registry registry_name command err rs
-	| notEmpty err
-		= abort (hd err +++. "\n")		///////////////!!!!!!!!!!!!!!!!!!!!!
-	| found == ""
+check_flags :: !String !String !String ![(String,String,String)] !(PSt .l) -> (!Bool,!PSt .l)
+check_flags _ _ _ [] ps = (True,ps)
+check_flags app_vers app_path app_name [(flag_name,flag_path,flag_vers):flags] ps
+	| app_vers == flag_vers && app_path == flag_path && app_name == flag_name
+		= (False,ps)
+	= check_flags app_vers app_path app_name flags ps
+
+check_registry :: !String !String !String !(PSt .l) -> (!CheckResult,!PSt .l)
+check_registry app_name app_path app_vers ps
+	# (name,path,vers,errs)	= get_ide_from_registry
+	| notEmpty errs
 		= (NoEntry,ps)
-	# mine				= quoted app_path
-	| found <> mine
+	| name <> app_name || path <> app_path || vers <> app_vers
 		= (DiffEntry,ps)
 	= (MyEntry,ps)
-where
-	registry_name	= "iclfile\0"
-	command			= "open\0"
-
-	quoted string	= "\"" +++ string +++ "\" \"%1\""
 
-set_registry app_name app_path ps
-	# err		= change_ide_registry_fun app_name app_path
-	# err		= change_pcl_registry_fun app_name app_path pcl_name pcl_path
-	# err		= change_hcl_registry_fun app_name app_path hcl_name hcl_path
+set_registry :: !String !String !String !String !String !String !String !(PSt .l) -> (!String,!PSt .l)
+set_registry ide_vers ide_name ide_path pcl_name pcl_path hcl_name hcl_path ps
+	# (err,r)	= enter_ide_in_registry (ide_name+++"\0") (ide_path+++"\0") (ide_vers+++"\0") [] 7
+	| notEmpty err || r <> 7
+		= (hd err,ps)
+	# err		= change_ide_registry_fun ide_name ide_path
 	| notEmpty err
-		= abort (hd err +++. "\n")		///////////////!!!!!!!!!!!!!!!!!!!!!
-	= ps
+		= (hd err,ps)
+	# err		= change_pcl_registry_fun ide_name ide_path pcl_name pcl_path
+	| notEmpty err
+		= (hd err,ps)
+	# err		= change_hcl_registry_fun ide_name ide_path hcl_name hcl_path
+	| notEmpty err
+		= (hd err,ps)
+	= ("",ps)
 
 import StdIO
 
-init_dialog :: !(PSt .l) -> (!Int,!PSt .l)
+init_dialog :: !(PSt .l) -> (!DialogResult,!PSt .l)
 init_dialog ps
 	# (okId,ps)			= openId ps
 	# (cancelId,ps)		= openId ps
@@ -227,7 +259,8 @@ init_dialog ps
 	| err <> NoError || isNothing res
 		= (No,ps)
 	= (fromJust res,ps)
-delta_dialog :: !(PSt .l) -> (!Int,!PSt .l)
+
+delta_dialog :: !(PSt .l) -> (!DialogResult,!PSt .l)
 delta_dialog ps
 	# (okId,ps)			= openId ps
 	# (cancelId,ps)		= openId ps
@@ -284,6 +317,26 @@ ddef okId cancelId dialogId = Dialog "Ide Integration"
 	]
 dfun ret dId (_,ps)
 	= (ret,closeWindow dId ps)
+
+err_dialog wasChecking err ps
+	# (okId,ps)		= openId ps
+	# (dlogId,ps)	= openId ps
+	# (_,ps)		= openModalDialog Void
+						(	Dialog (if wasChecking "Check Registry Failed!" "Setting Registry Failed!")
+							( edef okId dlogId) 
+							[ WindowOk okId
+							, WindowId dlogId
+							]
+						) ps
+	= ps
+where
+	edef okId dlogId
+		=	TextControl (if wasChecking "Checking the windows registry failed:" "Setting the windows registry failed:")
+			[ ControlPos (Left,zero)
+			]
+		:+:	TextControl err [ControlPos (Left,zero)]
+		:+: ButtonControl "OK" [ControlPos (Right,zero),ControlId okId,ControlFunction (noLS (closeWindow dlogId))]
+
 //==
 
 Start`
@@ -313,6 +366,8 @@ import code from "cCrossCall_121.obj", "cCrossCallProcedureTable_121.obj", "cAcc
 				 "util_121.obj"
 import code from library "userExt_library"
 
+// from clCCall_12.dcl...