Commit b69907fe authored by John van Groningen's avatar John van Groningen

add support for hierarchical modules

parent 6198c5bc
......@@ -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 =
......
......@@ -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
......
......@@ -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
......
This diff is collapsed.
......@@ -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;
......
This diff is collapsed.
......@@ -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
......@@ -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;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment