add support for hierarchical modules

Ide/IDE.icl

@@ -25,7 +25,7 @@ import ideoptions
 import clipboard,typewin,idehelp,PmEnvironment,search
 import errwin, messwin, projwin, edfiles
 import projmen, filehist, ioutil, menubar
-from PmDirCache import SearchDisk
+from PmDirCache import SearchDisk,FindHModule
 import targetui
 from PmCleanSystem import QuitCleanCompiler
 import Platform,PlatformObjectIO, IdePlatform
@@ -760,20 +760,22 @@ ed_open_sel openImp mods ps
 	# (res,ps) = maybe_type_win_message wId msgGetSelection ps
 	| isJust res
 		#	(sel,_)			= fromJust res
-		| sel == "" || not (CleanModId sel)
+		| sel == "" || not (is_h_module_name sel)
 			= open_dlog ps
-		#	sel				= (if openImp MakeImpPathname MakeDefPathname) sel
-		= OpenModule sel emptySelection ps
+			= open_imp_or_def_module openImp sel ps
 	#	(msel,ps)	= sendToActiveWindow msgGetSelection ps
 	| isNothing msel
 		= open_dlog ps
 	#	(sel,_)			= fromJust msel
-	| sel == "" || not (CleanModId sel)
+	| sel == "" || not (is_h_module_name sel)
 		= open_dlog ps
-	#	sel				= (if openImp MakeImpPathname MakeDefPathname) sel
-	= OpenModule sel emptySelection ps
-
+		= open_imp_or_def_module openImp sel ps
 where
+	open_imp_or_def_module openImp sel ps
+		| openImp
+			= open_imp_module sel ps
+			= open_def_module sel ps
+
 	open_dlog pstate
 		#	(dlogId,pstate)		= openId pstate
 			(textId,pstate)		= openId pstate
@@ -843,43 +845,94 @@ ed_open_other pstate
 		= pstate
 	= pstate
 
-OpenModuleNoSel pathname ps
+get_environment_and_project_paths :: !(*PSt General) -> (!List {#Char},!*PSt General)
+get_environment_and_project_paths ps
 	# (syspaths,ps)			= getCurrentPaths ps
 	# (prj,ps)				= getProject ps
 	# prjpaths				= PR_GetPaths prj
-	# srcpaths				= AppendLists prjpaths syspaths
-	# srcpaths				= case IsABCPathname pathname of
-		True	-> Map MakeSystemPathname srcpaths
-		_		-> srcpaths
+	= (AppendLists prjpaths syspaths, ps)
+
+OpenModuleNoSel pathname ps
+	# (srcpaths,ps)			= get_environment_and_project_paths ps
+	# srcpaths				= if (IsABCPathname pathname)
+								(Map MakeSystemPathname srcpaths)
+								srcpaths
 	# ((ok,fullpath),ps)	= accFiles (SearchDisk pathname srcpaths) ps
 	| not ok
-		= okNotice
-			[ "Clean Project Manager"
-			, "Could not find file:"
-			, pathname
-			] ps
+		= could_not_find_file_notice pathname ps
 	# fullpath`				= GetLongPathName fullpath
 	= ed_open_path fullpath` ps
 
+n_chars_of_file_ext s
+	# n=size s
+	| n>3 && is_3_char_file_ext (s % (n-4,n-1))
+		= 4
+	| n>2 && is_2_char_file_ext (s % (n-3,n-1))
+		= 3
+		= 0
+where
+	is_3_char_file_ext ".icl" = True
+	is_3_char_file_ext ".dcl" = True
+	is_3_char_file_ext ".lhs" = True
+	is_3_char_file_ext _ = False
+	
+	is_2_char_file_ext ".hs" = True
+	is_2_char_file_ext _ = False
+
+split_string :: !Int !{#Char} -> (!{#Char},!{#Char})
+split_string i s
+	# n=size s
+	# i=n-i
+	= (s % (0,i-1),s % (i,n-1))
+
 OpenModule :: !.Modulename !.Selection !*(PSt General) -> *PSt General
 OpenModule pathname sel ps
-	# (syspaths,ps)			= getCurrentPaths ps
-	# (prj,ps)				= getProject ps
-	# prjpaths				= PR_GetPaths prj
-	# srcpaths				= AppendLists prjpaths syspaths
-	# srcpaths				= case IsABCPathname pathname of
-		True	-> Map MakeSystemPathname srcpaths
-		_		-> srcpaths
-	# ((ok,fullpath),ps)	= accFiles (SearchDisk pathname srcpaths) ps
+	# (srcpaths,ps) = get_environment_and_project_paths ps
+	# srcpaths = if (IsABCPathname pathname)
+					(Map MakeSystemPathname srcpaths)
+					srcpaths
+	# n=n_chars_of_file_ext pathname
+	# ((ok,fullpath),ps)
+		= if (n==0)
+			(accFiles (SearchDisk pathname srcpaths) ps)
+			(let (module_name,file_ext) = split_string n pathname
+			 in accFiles (FindHModule module_name file_ext srcpaths) ps)
 	| not ok
-		= okNotice
-			[ "Clean Project Manager"
-			, "Could not find file:"
-			, pathname
-			] ps
+		= could_not_find_file_notice pathname ps
 	# fullpath`				= GetLongPathName fullpath
 	= ed_open_path_sel fullpath` sel ps
 
+open_def_module :: !Modulename !*(PSt General) -> *PSt General
+open_def_module pathname ps
+	# module_name = RemoveSuffix pathname
+	# (srcpaths,ps) = get_environment_and_project_paths ps
+	# ((ok,fullpath),ps)	= accFiles (FindHModule module_name ".dcl" srcpaths) ps
+	| not ok
+		= could_not_find_file_notice (module_name+++".dcl") ps
+	# fullpath`				= GetLongPathName fullpath
+	= ed_open_path_sel fullpath` emptySelection ps
+
+open_imp_module :: !Modulename !*(PSt General) -> *PSt General
+open_imp_module pathname ps
+	# module_name = RemoveSuffix pathname
+	# (srcpaths,ps) = get_environment_and_project_paths ps
+	# ((ok,fullpath),ps) = accFiles (FindHModule module_name ".icl" srcpaths) ps
+	| ok
+		= open_file fullpath ps
+	| not ok
+		= could_not_find_file_notice (module_name+++".icl") ps
+where
+	open_file fullpath ps
+		# fullpath`				= GetLongPathName fullpath
+		= ed_open_path_sel fullpath` emptySelection ps
+
+could_not_find_file_notice file_name ps
+	= okNotice
+		[ "Clean Project Manager"
+		, "Could not find file:"
+		, file_name
+		] ps
+
 //--- edit menu stuff
 
 iniEditLS =

Ide/edfiles.icl

@@ -14,8 +14,6 @@ import menubar
 import UtilNewlinesFile
 //import treeparse //P4
 
-//--
-
 ed_ask_save_all :: !Bool !Bool (*(PSt General) -> *PSt General) !*(PSt General) -> *PSt General
 ed_ask_save_all close update_in_project cont pstate
 	#	(windows,pstate)	= accPIO getWindowsStack pstate
@@ -125,6 +123,9 @@ ed_open_cont pathName cont ps
 		// bring to front...allready done by 'doall'
 		= cont True (fromJust exists) ps
 	// read the file from disk
+	# (syspaths,ps) = getCurrentPaths ps
+	  (prjpaths,ps) = getFromProject PR_GetPaths ps
+	  ({mdn_name=modname},_) = determine_dir_and_filename pathName (AppendLists prjpaths syspaths)
 	# ((errorText,nlConv,readOnly), ps)
 					= readText pathName ps
 	| isError errorText
@@ -135,7 +136,6 @@ ed_open_cont pathName cont ps
 			, giveError errorText				// for debugging purposes only?
 			] ps
 	# text			= fromOk errorText
-	# modname		= GetModuleName pathName
 	# isDefMod		= IsDefPathname pathName
 	# isImpMod		= IsImpPathname pathName
 	# (inf,ps)		= getFromProject (PR_GetModuleInfo modname) ps
@@ -442,7 +442,9 @@ ed_common_close update_in_project win ps
 		= closeEditWindow win ps	// this should not occur
 	# pos		= fromJust pos
 	# (siz,ps)	= accPIO (getWindowViewSize win) ps
-	# modname	= GetModuleName nam
+	# (syspaths,ps) = getCurrentPaths ps
+	  (prjpaths,ps) = getFromProject PR_GetPaths ps
+	  ({mdn_name=modname},_) = determine_dir_and_filename nam (AppendLists prjpaths syspaths)
 	# isDefmod	= IsDefPathname nam
 	# pos_size	= WindowPosAndSize {posx = pos.vx,posy=pos.vy,sizex=siz.w,sizey=siz.Size.h}
 	# update	= \inf=:{mod_edit_options=mod_edit_options=:{defeo,impeo}} -> if isDefmod

Ide/projwin.icl

@@ -531,7 +531,7 @@ where
 				= bf r
 
 		makenice _ _ [] = []
-		makenice u s l=:[(a,b,_,_):r]
+		makenice u s l=:[(imp_mod_name_with_ext,b,_,_):r]
 			| s <> b	// new directory
 				# u`			= isUnfoldedDir b srcpaths
 				  dir			= symPath appPath prjPath b
@@ -540,93 +540,99 @@ where
 				  					("//--- "+++dir,pm_update_project_window_interactive o updFstate b True,id)
 				= [pw_separator : makenice u` b l]
 			| u
-				= [(GetModuleName a,f a, f` a):makenice u s r]	// add seperators...
+				= [(GetModuleName imp_mod_name_with_ext,f imp_mod_name_with_ext, f` imp_mod_name_with_ext):makenice u s r]	// add seperators...
 				= makenice u s r
 		where
-			f mod	= if shift
-						(open_def b mod)	//(OpenModule (MakeDefPathname mod) emptySelection)
-						(open_imp b mod)	//(OpenModule (MakeImpPathname mod) emptySelection)
-			f` mod	= if shift
-						(open_imp b mod)	//(OpenModule (MakeImpPathname mod) emptySelection)
-						(open_def b mod)	//(OpenModule (MakeDefPathname mod) emptySelection)
+			f imp_mod_name_with_ext
+				= if shift
+					(open_def b imp_mod_name_with_ext)
+					(open_imp b imp_mod_name_with_ext)
+
+			f` imp_mod_name_with_ext
+				= if shift
+					(open_imp b imp_mod_name_with_ext)
+					(open_def b imp_mod_name_with_ext)
+
 			isUnfoldedDir d Nil = False
 			isUnfoldedDir d ((u,d`):!ds)
 				| d == d` = u
 				= isUnfoldedDir d ds
 
-open_def dirpath mod ps
-	# defpath		= MakeDefPathname mod
-	# path			= dirpath +++ defpath
-	# (exists,ps)	= accFiles (FExists path) ps
-	| exists
-		= ed_open_path_sel path emptySelection ps
-	# lhspath		= RemoveSuffix mod  +++ ".lhs"
-	# path			= dirpath +++ lhspath
-	# (exists,ps)	= accFiles (FExists path) ps
-	| exists
-		= ed_open_path_sel path emptySelection ps
-	# hspath		= RemoveSuffix mod  +++ ".hs"
-	# path			= dirpath +++ hspath
-	# (exists,ps)	= accFiles (FExists path) ps
-	| exists
-		= ed_open_path_sel path emptySelection ps
-
-	# (exists,path,ps)	= exists_module defpath ps
-	| exists
-		= ed_open_path_sel path emptySelection ps
-	# (exists,path,ps)	= exists_module lhspath ps
-	| exists
-		= ed_open_path_sel path emptySelection ps
-	# (exists,path,ps)	= exists_module hspath ps
-	| exists
-		= ed_open_path_sel path emptySelection ps
-	= okNotice
-		[ "Clean Project Manager"
-		, "Could not find file:"
-		, defpath
-		] ps
-	
-open_imp dirpath mod ps
-	# defpath		= MakeImpPathname mod
-	# path			= dirpath +++ defpath
-	# (exists,ps)	= accFiles (FExists path) ps
-	| exists
-		= ed_open_path_sel path emptySelection ps
-	# lhspath		= RemoveSuffix mod  +++ ".lhs"
-	# path			= dirpath +++ lhspath
-	# (exists,ps)	= accFiles (FExists path) ps
-	| exists
-		= ed_open_path_sel path emptySelection ps
-	# hspath		= RemoveSuffix mod  +++ ".hs"
-	# path			= dirpath +++ hspath
-	# (exists,ps)	= accFiles (FExists path) ps
-	| exists
-		= ed_open_path_sel path emptySelection ps
-	# (exists,path,ps)	= exists_module defpath ps
-	| exists
-		= ed_open_path_sel path emptySelection ps
-	# (exists,path,ps)	= exists_module lhspath ps
-	| exists
-		= ed_open_path_sel path emptySelection ps
-	# (exists,path,ps)	= exists_module hspath ps
-	| exists
-		= ed_open_path_sel path emptySelection ps
-	= okNotice
-		[ "Clean Project Manager"
-		, "Could not find file:"
-		, defpath
-		] ps
-
-exists_module pathname ps
+	open_def dirpath imp_mod_name_with_ext ps
+		# imp_mod_file_name = replace_dots_by_dir_separators (RemoveSuffix imp_mod_name_with_ext)
+		# dcl_file_name = imp_mod_file_name +++ ".dcl"
+		# path			= dirpath +++ dcl_file_name
+		# (exists,ps)	= accFiles (FExists path) ps
+		| exists
+			= ed_open_path_sel path emptySelection ps
+		# hs_file_name	= imp_mod_file_name +++ ".hs"
+		# path			= dirpath +++ hs_file_name
+		# (exists,ps)	= accFiles (FExists path) ps
+		| exists
+			= ed_open_path_sel path emptySelection ps
+		# lhs_file_name	= imp_mod_file_name +++ ".lhs"
+		# path			= dirpath +++ lhs_file_name
+		# (exists,ps)	= accFiles (FExists path) ps
+		| exists
+			= ed_open_path_sel path emptySelection ps
+		# (exists,path,ps)	= exists_module imp_mod_file_name ".dcl" ps
+		| exists
+			= ed_open_path_sel path emptySelection ps
+		# (exists,path,ps)	= exists_module imp_mod_file_name ".hs" ps
+		| exists
+			= ed_open_path_sel path emptySelection ps
+		# (exists,path,ps)	= exists_module imp_mod_file_name ".lhs" ps
+		| exists
+			= ed_open_path_sel path emptySelection ps
+		= could_not_find_notice dcl_file_name ps
+
+	open_imp dirpath imp_mod_name_with_ext ps
+		# imp_mod_file_name = replace_dots_by_dir_separators (RemoveSuffix imp_mod_name_with_ext)
+		# icl_file_name	= imp_mod_file_name +++ ".icl"
+		# path			= dirpath +++ icl_file_name
+		# (exists,ps)	= accFiles (FExists path) ps
+		| exists
+			= ed_open_path_sel path emptySelection ps
+		# hs_file_name	= imp_mod_file_name +++ ".hs"
+		# path			= dirpath +++ hs_file_name
+		# (exists,ps)	= accFiles (FExists path) ps
+		| exists
+			= ed_open_path_sel path emptySelection ps
+		# lhs_file_name = imp_mod_file_name +++ ".lhs"
+		# path			= dirpath +++ lhs_file_name
+		# (exists,ps)	= accFiles (FExists path) ps
+		| exists
+			= ed_open_path_sel path emptySelection ps
+		# (exists,path,ps)	= exists_module imp_mod_file_name ".icl" ps
+		| exists
+			= ed_open_path_sel path emptySelection ps
+		# (exists,path,ps)	= exists_module imp_mod_file_name ".hs" ps
+		| exists
+			= ed_open_path_sel path emptySelection ps
+		# (exists,path,ps)	= exists_module imp_mod_file_name ".lhs" ps
+		| exists
+			= ed_open_path_sel path emptySelection ps
+		= could_not_find_notice icl_file_name ps
+
+	could_not_find_notice path ps
+		= okNotice
+			[ "Clean Project Manager"
+			, "Could not find file:"
+			, path
+			] ps
+
+	exists_module :: {#Char} {#Char} *(PSt *General) -> *(!Bool,{#Char},!*(PSt *General))
+	exists_module module_name file_ext ps
+		# (srcpaths,ps) = get_project_and_environment_paths ps
+		# ((ok,fullpath),ps) = accFiles (FindHModule module_name file_ext srcpaths) ps
+		= (ok,GetLongPathName fullpath,ps)
+
+get_project_and_environment_paths :: *(PSt *General) -> *(!(List {#Char}),!*(PSt *General))
+get_project_and_environment_paths ps
 	# (syspaths,ps)			= getCurrentPaths ps
 	# (prj,ps)				= getProject ps
 	# prjpaths				= PR_GetPaths prj
-	# srcpaths				= AppendLists prjpaths syspaths
-	# srcpaths				= case IsABCPathname pathname of
-		True	-> Map MakeSystemPathname srcpaths
-		_		-> srcpaths
-	# ((ok,fullpath),ps)	= accFiles (SearchDisk pathname srcpaths) ps
-	= (ok,GetLongPathName fullpath,ps)
+	= (AppendLists prjpaths syspaths,ps)
 
 // pm_set: set main module
 pm_set :: !*(PSt *General) -> *PSt *General
@@ -777,7 +783,9 @@ pm_copt ps
 	# (path,ps)			= sendToActiveWindow msgGetPathName ps
 	| isJust path
 		# path			= fromJust path
-		# mod			= GetModuleName path
+		# (syspaths,ps) = getCurrentPaths ps
+		  (prjpaths,ps) = getFromProject PR_GetPaths ps
+		  ({mdn_name=mod},_) = determine_dir_and_filename path (AppendLists prjpaths syspaths)
 		# minf			= PR_GetModuleInfo mod project
 		| isNothing minf
 			// module not found in project...
@@ -841,18 +849,14 @@ getActiveModules ps
 
 findModule :: !.Modulename !*(PSt General) -> (!Maybe Pathname,!*PSt General)
 findModule pathname ps
-	# (syspaths,ps)			= getCurrentPaths ps
-	# (prj,ps)				= getProject ps
-	# prjpaths				= PR_GetPaths prj
-	# srcpaths				= AppendLists prjpaths syspaths
-	# srcpaths				= case IsABCPathname pathname of
-		True	-> Map MakeSystemPathname srcpaths
-		_		-> srcpaths
-	# ((ok,fullpath),ps)	= accFiles (SearchDisk pathname srcpaths) ps
+	# (srcpaths,ps) = get_project_and_environment_paths ps
+	# srcpaths = if (IsABCPathname pathname)
+					(Map MakeSystemPathname srcpaths)
+					srcpaths
+	# ((ok,fullpath),ps) = accFiles (SearchDisk pathname srcpaths) ps
 	| not ok
 		= (Nothing, ps)
-	# fullpath`				= GetLongPathName fullpath
-	= (Just fullpath`, ps)
+		= (Just (GetLongPathName fullpath), ps)
 
 DoProcess msg compile cont ps
 	# (paths,ps)			= getActiveModules ps

Ide/search.icl

@@ -11,10 +11,9 @@ import PmParse, PmPath
 import ioutil
 import PmPrefs
 from EdText import textToStrings
-from PmDirCache import SearchDisk
+from PmDirCache import SearchDisk,FindHModule
 import morecontrols,colorpickcontrol,colourclip
 
-
 initFindBoxInfo :: !Prefs !*a -> *(.(FindBoxInfo *(PSt General)),*a) | Ids, accScreenPicture a
 initFindBoxInfo prefs pstate
 	# (dlogId,pstate)	= openId pstate
@@ -54,8 +53,6 @@ initFindBoxInfo prefs pstate
 							, recvId		= recvId
 							}
 	= (fbi,pstate)
-
-//--
 	
 sr_find_idi :: !Bool !*(PSt General) -> *PSt General
 sr_find_idi always_dialog pstate		// Find Definition & Implementation & Identifier
@@ -114,8 +111,6 @@ sr_find_def_imp_sel always_dialog selection pathname info=:{cleanid} pstate
  		= fi_dialog info pstate
  	= fi_messagebox info pstate
 
-//--
-
 fi_messagebox info=:{cleanid,dlogId,stringId,msgId,kind,closeId} pstate
 	| isEmpty cleanid
 		= pstate
@@ -157,8 +152,6 @@ where
 		#	ps		= closeWindow dlogId ps
 		= (ls, ps)
 
-//--
-
 fi_dialog info=:{dlogId,msgId,stringId,cleanid,kind,type,verb,export_,closeId,findId,recvId} pstate
 	#	pstate			= closeWindow dlogId pstate
 		(_,pstate)		= openModalDialog info dialog pstate
@@ -276,22 +269,22 @@ recvfun _ (ls=:{is_searching,findId},ps)
 	# ps	= appPIO (setControlText findId "Stop") ps
 	= (ls, ps)
 
-//--
 import StdPathname, Directory
 
 getModulesInPaths ps
 	# (ep,ps) = getCurrentPaths ps
 	# (pp,ps) = getFromProject PR_GetPaths ps
-	# (mods,ps) = accFiles (findmods (Concat pp ep)) ps
-	= (mods,ps)
+	= accFiles (findmods (Concat pp ep)) ps
 where
 	findmods Nil files
 		= ([],files)
 	findmods (path:!paths) files
 		# ((ok,path`),files) = pd_StringToPath path files
-		| not ok = findmods paths files
+		| not ok
+			= findmods paths files
 		# ((err,dir),files)		= getDirectoryContents path` files
-		| err <> NoDirError = findmods paths files
+		| err <> NoDirError
+			= findmods paths files
 		# dir					= map getinfo dir		// only need common fileinfo...
 		# dir					= filter (\(b,n)-> (not b)) dir
 		# dir					= map (\(_,n)->n) dir
@@ -306,43 +299,48 @@ where
 		= (isDirectory,fileName)