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

Pm/PmParse.dcl

@@ -55,6 +55,7 @@ FindDefinitionInText ::
 
 /*	Returns True when 1st arg. is a valid Clean identifier. */
 CleanModId :: !String -> Bool;
+is_h_module_name :: !String -> Bool;
 
 /*	Returns True when 1st arg. is a type listed by the Clean compiler. */
 IsTypeSpec :: !String -> Bool;

Util/StdPathname.dcl

@@ -13,4 +13,6 @@ equal_suffix		:: !String !String -> Bool
 IsFullPathname		:: !Pathname -> Bool
 MakeFullPathname	:: !Pathname !String -> Pathname
 
+replace_dots_by_dir_separators :: !{#Char} -> *{#Char};
+
 quoted_string		:: !String -> String

Util/StdPathname.icl

@@ -43,7 +43,7 @@ RemoveSuffix path
 //		suffix				= suf == ".dcl" || suf == ".icl" || suf == ".abc" || suf == ".o" || suf == ".obj" || suf == ".prj";
 		suffix				= isMember suf [".",".dcl",".icl",".hs",".lhs",".abc",".o",".obj",".obj0",".obj1",".obj2",".xo",".cxo",".prj"];
 		last				= dec (size path);
-	
+
 RemoveSuffix` :: !Pathname -> String;
 RemoveSuffix` path
 	| not found		= path;
@@ -54,7 +54,7 @@ RemoveSuffix` path
 //		suf					= path % (position, last);
 //		suffix				= suf == ".dcl" || suf == ".icl" || suf == ".abc" || suf == ".o" || suf == ".prj";
 		last				= dec (size path);
-		
+
 RemoveFilename :: !Pathname -> Pathname;
 RemoveFilename path 
 	# (found,position)	= FindLastChar DirSeparator path (dec (size path));
@@ -76,6 +76,10 @@ IsFullPathname name = LastChar DirSeparator name (dec (size name)) >= 0;
 MakeFullPathname :: !Pathname !String -> Pathname;
 MakeFullPathname path name =  path +++ DirSeparatorString +++ name;
 
+replace_dots_by_dir_separators :: !{#Char} -> *{#Char};
+replace_dots_by_dir_separators module_name
+	= {if (c=='.') DirSeparator c \\ c<-:module_name}
+
 /* Auxilary functions */
 	
 equal_suffix	:: !String !String -> Bool;