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 ...@@ -25,7 +25,7 @@ import ideoptions
import clipboard,typewin,idehelp,PmEnvironment,search import clipboard,typewin,idehelp,PmEnvironment,search
import errwin, messwin, projwin, edfiles import errwin, messwin, projwin, edfiles
import projmen, filehist, ioutil, menubar import projmen, filehist, ioutil, menubar
from PmDirCache import SearchDisk from PmDirCache import SearchDisk,FindHModule
import targetui import targetui
from PmCleanSystem import QuitCleanCompiler from PmCleanSystem import QuitCleanCompiler
import Platform,PlatformObjectIO, IdePlatform import Platform,PlatformObjectIO, IdePlatform
...@@ -760,20 +760,22 @@ ed_open_sel openImp mods ps ...@@ -760,20 +760,22 @@ ed_open_sel openImp mods ps
# (res,ps) = maybe_type_win_message wId msgGetSelection ps # (res,ps) = maybe_type_win_message wId msgGetSelection ps
| isJust res | isJust res
# (sel,_) = fromJust res # (sel,_) = fromJust res
| sel == "" || not (CleanModId sel) | sel == "" || not (is_h_module_name sel)
= open_dlog ps = open_dlog ps
# sel = (if openImp MakeImpPathname MakeDefPathname) sel = open_imp_or_def_module openImp sel ps
= OpenModule sel emptySelection ps
# (msel,ps) = sendToActiveWindow msgGetSelection ps # (msel,ps) = sendToActiveWindow msgGetSelection ps
| isNothing msel | isNothing msel
= open_dlog ps = open_dlog ps
# (sel,_) = fromJust msel # (sel,_) = fromJust msel
| sel == "" || not (CleanModId sel) | sel == "" || not (is_h_module_name sel)
= open_dlog ps = open_dlog ps
# sel = (if openImp MakeImpPathname MakeDefPathname) sel = open_imp_or_def_module openImp sel ps
= OpenModule sel emptySelection ps
where where
open_imp_or_def_module openImp sel ps
| openImp
= open_imp_module sel ps
= open_def_module sel ps
open_dlog pstate open_dlog pstate
# (dlogId,pstate) = openId pstate # (dlogId,pstate) = openId pstate
(textId,pstate) = openId pstate (textId,pstate) = openId pstate
...@@ -843,43 +845,94 @@ ed_open_other pstate ...@@ -843,43 +845,94 @@ ed_open_other pstate
= pstate = 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 # (syspaths,ps) = getCurrentPaths ps
# (prj,ps) = getProject ps # (prj,ps) = getProject ps
# prjpaths = PR_GetPaths prj # prjpaths = PR_GetPaths prj
# srcpaths = AppendLists prjpaths syspaths = (AppendLists prjpaths syspaths, ps)
# srcpaths = case IsABCPathname pathname of
True -> Map MakeSystemPathname srcpaths OpenModuleNoSel pathname ps
_ -> srcpaths # (srcpaths,ps) = get_environment_and_project_paths ps
# srcpaths = if (IsABCPathname pathname)
(Map MakeSystemPathname srcpaths)
srcpaths
# ((ok,fullpath),ps) = accFiles (SearchDisk pathname srcpaths) ps # ((ok,fullpath),ps) = accFiles (SearchDisk pathname srcpaths) ps
| not ok | not ok
= okNotice = could_not_find_file_notice pathname ps
[ "Clean Project Manager"
, "Could not find file:"
, pathname
] ps
# fullpath` = GetLongPathName fullpath # fullpath` = GetLongPathName fullpath
= ed_open_path fullpath` ps = 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 :: !.Modulename !.Selection !*(PSt General) -> *PSt General
OpenModule pathname sel ps OpenModule pathname sel ps
# (syspaths,ps) = getCurrentPaths ps # (srcpaths,ps) = get_environment_and_project_paths ps
# (prj,ps) = getProject ps # srcpaths = if (IsABCPathname pathname)
# prjpaths = PR_GetPaths prj (Map MakeSystemPathname srcpaths)
# srcpaths = AppendLists prjpaths syspaths srcpaths
# srcpaths = case IsABCPathname pathname of # n=n_chars_of_file_ext pathname
True -> Map MakeSystemPathname srcpaths # ((ok,fullpath),ps)
_ -> srcpaths = if (n==0)
# ((ok,fullpath),ps) = accFiles (SearchDisk pathname srcpaths) ps (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 | not ok
= okNotice = could_not_find_file_notice pathname ps
[ "Clean Project Manager"
, "Could not find file:"
, pathname
] ps
# fullpath` = GetLongPathName fullpath # fullpath` = GetLongPathName fullpath
= ed_open_path_sel fullpath` sel ps = 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 //--- edit menu stuff
iniEditLS = iniEditLS =
......
...@@ -14,8 +14,6 @@ import menubar ...@@ -14,8 +14,6 @@ import menubar
import UtilNewlinesFile import UtilNewlinesFile
//import treeparse //P4 //import treeparse //P4
//--
ed_ask_save_all :: !Bool !Bool (*(PSt General) -> *PSt General) !*(PSt General) -> *PSt General ed_ask_save_all :: !Bool !Bool (*(PSt General) -> *PSt General) !*(PSt General) -> *PSt General
ed_ask_save_all close update_in_project cont pstate ed_ask_save_all close update_in_project cont pstate
# (windows,pstate) = accPIO getWindowsStack pstate # (windows,pstate) = accPIO getWindowsStack pstate
...@@ -125,6 +123,9 @@ ed_open_cont pathName cont ps ...@@ -125,6 +123,9 @@ ed_open_cont pathName cont ps
// bring to front...allready done by 'doall' // bring to front...allready done by 'doall'
= cont True (fromJust exists) ps = cont True (fromJust exists) ps
// read the file from disk // 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) # ((errorText,nlConv,readOnly), ps)
= readText pathName ps = readText pathName ps
| isError errorText | isError errorText
...@@ -135,7 +136,6 @@ ed_open_cont pathName cont ps ...@@ -135,7 +136,6 @@ ed_open_cont pathName cont ps
, giveError errorText // for debugging purposes only? , giveError errorText // for debugging purposes only?
] ps ] ps
# text = fromOk errorText # text = fromOk errorText
# modname = GetModuleName pathName
# isDefMod = IsDefPathname pathName # isDefMod = IsDefPathname pathName
# isImpMod = IsImpPathname pathName # isImpMod = IsImpPathname pathName
# (inf,ps) = getFromProject (PR_GetModuleInfo modname) ps # (inf,ps) = getFromProject (PR_GetModuleInfo modname) ps
...@@ -442,7 +442,9 @@ ed_common_close update_in_project win ps ...@@ -442,7 +442,9 @@ ed_common_close update_in_project win ps
= closeEditWindow win ps // this should not occur = closeEditWindow win ps // this should not occur
# pos = fromJust pos # pos = fromJust pos
# (siz,ps) = accPIO (getWindowViewSize win) ps # (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 # isDefmod = IsDefPathname nam
# pos_size = WindowPosAndSize {posx = pos.vx,posy=pos.vy,sizex=siz.w,sizey=siz.Size.h} # 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 # update = \inf=:{mod_edit_options=mod_edit_options=:{defeo,impeo}} -> if isDefmod
......
...@@ -531,7 +531,7 @@ where ...@@ -531,7 +531,7 @@ where
= bf r = bf r
makenice _ _ [] = [] makenice _ _ [] = []
makenice u s l=:[(a,b,_,_):r] makenice u s l=:[(imp_mod_name_with_ext,b,_,_):r]
| s <> b // new directory | s <> b // new directory
# u` = isUnfoldedDir b srcpaths # u` = isUnfoldedDir b srcpaths
dir = symPath appPath prjPath b dir = symPath appPath prjPath b
...@@ -540,93 +540,99 @@ where ...@@ -540,93 +540,99 @@ where
("//--- "+++dir,pm_update_project_window_interactive o updFstate b True,id) ("//--- "+++dir,pm_update_project_window_interactive o updFstate b True,id)
= [pw_separator : makenice u` b l] = [pw_separator : makenice u` b l]
| u | 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 = makenice u s r
where where
f mod = if shift f imp_mod_name_with_ext
(open_def b mod) //(OpenModule (MakeDefPathname mod) emptySelection) = if shift
(open_imp b mod) //(OpenModule (MakeImpPathname mod) emptySelection) (open_def b imp_mod_name_with_ext)
f` mod = if shift (open_imp b imp_mod_name_with_ext)
(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_imp b imp_mod_name_with_ext)
(open_def b imp_mod_name_with_ext)
isUnfoldedDir d Nil = False isUnfoldedDir d Nil = False
isUnfoldedDir d ((u,d`):!ds) isUnfoldedDir d ((u,d`):!ds)
| d == d` = u | d == d` = u
= isUnfoldedDir d ds = isUnfoldedDir d ds
open_def dirpath mod ps open_def dirpath imp_mod_name_with_ext ps
# defpath = MakeDefPathname mod # imp_mod_file_name = replace_dots_by_dir_separators (RemoveSuffix imp_mod_name_with_ext)
# path = dirpath +++ defpath # dcl_file_name = imp_mod_file_name +++ ".dcl"
# (exists,ps) = accFiles (FExists path) ps # path = dirpath +++ dcl_file_name
| exists # (exists,ps) = accFiles (FExists path) ps
= ed_open_path_sel path emptySelection ps | exists
# lhspath = RemoveSuffix mod +++ ".lhs" = ed_open_path_sel path emptySelection ps
# path = dirpath +++ lhspath # hs_file_name = imp_mod_file_name +++ ".hs"
# (exists,ps) = accFiles (FExists path) ps # path = dirpath +++ hs_file_name
| exists # (exists,ps) = accFiles (FExists path) ps
= ed_open_path_sel path emptySelection ps | exists
# hspath = RemoveSuffix mod +++ ".hs" = ed_open_path_sel path emptySelection ps
# path = dirpath +++ hspath # lhs_file_name = imp_mod_file_name +++ ".lhs"
# (exists,ps) = accFiles (FExists path) ps # path = dirpath +++ lhs_file_name
| exists # (exists,ps) = accFiles (FExists path) ps
= ed_open_path_sel path emptySelection ps | exists
= ed_open_path_sel path emptySelection ps
# (exists,path,ps) = exists_module defpath ps # (exists,path,ps) = exists_module imp_mod_file_name ".dcl" ps
| exists | exists
= ed_open_path_sel path emptySelection ps = ed_open_path_sel path emptySelection ps
# (exists,path,ps) = exists_module lhspath ps # (exists,path,ps) = exists_module imp_mod_file_name ".hs" ps
| exists | exists
= ed_open_path_sel path emptySelection ps = ed_open_path_sel path emptySelection ps
# (exists,path,ps) = exists_module hspath ps # (exists,path,ps) = exists_module imp_mod_file_name ".lhs" ps
| exists | exists
= ed_open_path_sel path emptySelection ps = ed_open_path_sel path emptySelection ps
= okNotice = could_not_find_notice dcl_file_name ps
[ "Clean Project Manager"
, "Could not find file:" open_imp dirpath imp_mod_name_with_ext ps
, defpath # imp_mod_file_name = replace_dots_by_dir_separators (RemoveSuffix imp_mod_name_with_ext)
] ps # icl_file_name = imp_mod_file_name +++ ".icl"
# path = dirpath +++ icl_file_name
open_imp dirpath mod ps # (exists,ps) = accFiles (FExists path) ps
# defpath = MakeImpPathname mod | exists
# path = dirpath +++ defpath = ed_open_path_sel path emptySelection ps
# (exists,ps) = accFiles (FExists path) ps # hs_file_name = imp_mod_file_name +++ ".hs"
| exists # path = dirpath +++ hs_file_name
= ed_open_path_sel path emptySelection ps # (exists,ps) = accFiles (FExists path) ps
# lhspath = RemoveSuffix mod +++ ".lhs" | exists
# path = dirpath +++ lhspath = ed_open_path_sel path emptySelection ps
# (exists,ps) = accFiles (FExists path) ps # lhs_file_name = imp_mod_file_name +++ ".lhs"
| exists # path = dirpath +++ lhs_file_name
= ed_open_path_sel path emptySelection ps # (exists,ps) = accFiles (FExists path) ps
# hspath = RemoveSuffix mod +++ ".hs" | exists
# path = dirpath +++ hspath = ed_open_path_sel path emptySelection ps
# (exists,ps) = accFiles (FExists path) ps # (exists,path,ps) = exists_module imp_mod_file_name ".icl" ps
| exists | exists
= ed_open_path_sel path emptySelection ps = ed_open_path_sel path emptySelection ps
# (exists,path,ps) = exists_module defpath ps # (exists,path,ps) = exists_module imp_mod_file_name ".hs" ps
| exists | exists
= ed_open_path_sel path emptySelection ps = ed_open_path_sel path emptySelection ps
# (exists,path,ps) = exists_module lhspath ps # (exists,path,ps) = exists_module imp_mod_file_name ".lhs" ps
| exists | exists
= ed_open_path_sel path emptySelection ps = ed_open_path_sel path emptySelection ps
# (exists,path,ps) = exists_module hspath ps = could_not_find_notice icl_file_name ps
| exists
= ed_open_path_sel path emptySelection ps could_not_find_notice path ps
= okNotice = okNotice
[ "Clean Project Manager" [ "Clean Project Manager"
, "Could not find file:" , "Could not find file:"
, defpath , path
] ps ] ps
exists_module pathname 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 # (syspaths,ps) = getCurrentPaths ps
# (prj,ps) = getProject ps # (prj,ps) = getProject ps
# prjpaths = PR_GetPaths prj # prjpaths = PR_GetPaths prj
# srcpaths = AppendLists prjpaths syspaths = (AppendLists prjpaths syspaths,ps)
# srcpaths = case IsABCPathname pathname of
True -> Map MakeSystemPathname srcpaths
_ -> srcpaths
# ((ok,fullpath),ps) = accFiles (SearchDisk pathname srcpaths) ps
= (ok,GetLongPathName fullpath,ps)
// pm_set: set main module // pm_set: set main module
pm_set :: !*(PSt *General) -> *PSt *General pm_set :: !*(PSt *General) -> *PSt *General
...@@ -777,7 +783,9 @@ pm_copt ps ...@@ -777,7 +783,9 @@ pm_copt ps
# (path,ps) = sendToActiveWindow msgGetPathName ps # (path,ps) = sendToActiveWindow msgGetPathName ps
| isJust path | isJust path
# path = fromJust 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 # minf = PR_GetModuleInfo mod project
| isNothing minf | isNothing minf
// module not found in project... // module not found in project...
...@@ -841,18 +849,14 @@ getActiveModules ps ...@@ -841,18 +849,14 @@ getActiveModules ps
findModule :: !.Modulename !*(PSt General) -> (!Maybe Pathname,!*PSt General) findModule :: !.Modulename !*(PSt General) -> (!Maybe Pathname,!*PSt General)
findModule pathname ps findModule pathname ps
# (syspaths,ps) = getCurrentPaths ps # (srcpaths,ps) = get_project_and_environment_paths ps
# (prj,ps) = getProject ps # srcpaths = if (IsABCPathname pathname)
# prjpaths = PR_GetPaths prj (Map MakeSystemPathname srcpaths)
# srcpaths = AppendLists prjpaths syspaths srcpaths
# srcpaths = case IsABCPathname pathname of # ((ok,fullpath),ps) = accFiles (SearchDisk pathname srcpaths) ps
True -> Map MakeSystemPathname srcpaths
_ -> srcpaths
# ((ok,fullpath),ps) = accFiles (SearchDisk pathname srcpaths) ps
| not ok | not ok
= (Nothing, ps) = (Nothing, ps)
# fullpath` = GetLongPathName fullpath = (Just (GetLongPathName fullpath), ps)
= (Just fullpath`, ps)
DoProcess msg compile cont ps DoProcess msg compile cont ps
# (paths,ps) = getActiveModules ps # (paths,ps) = getActiveModules ps
......
This diff is collapsed.
...@@ -55,6 +55,7 @@ FindDefinitionInText :: ...@@ -55,6 +55,7 @@ FindDefinitionInText ::
/* Returns True when 1st arg. is a valid Clean identifier. */ /* Returns True when 1st arg. is a valid Clean identifier. */
CleanModId :: !String -> Bool; CleanModId :: !String -> Bool;
is_h_module_name :: !String -> Bool;
/* Returns True when 1st arg. is a type listed by the Clean compiler. */ /* Returns True when 1st arg. is a type listed by the Clean compiler. */
IsTypeSpec :: !String -> Bool; IsTypeSpec :: !String -> Bool;
......
This diff is collapsed.
...@@ -13,4 +13,6 @@ equal_suffix :: !String !String -> Bool ...@@ -13,4 +13,6 @@ equal_suffix :: !String !String -> Bool
IsFullPathname :: !Pathname -> Bool IsFullPathname :: !Pathname -> Bool
MakeFullPathname :: !Pathname !String -> Pathname MakeFullPathname :: !Pathname !String -> Pathname
replace_dots_by_dir_separators :: !{#Char} -> *{#Char};
quoted_string :: !String -> String quoted_string :: !String -> String
...@@ -43,7 +43,7 @@ RemoveSuffix path ...@@ -43,7 +43,7 @@ RemoveSuffix path
// suffix = suf == ".dcl" || suf == ".icl" || suf == ".abc" || suf == ".o" || suf == ".obj" || suf == ".prj"; // 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"]; suffix = isMember suf [".",".dcl",".icl",".hs",".lhs",".abc",".o",".obj",".obj0",".obj1",".obj2",".xo",".cxo",".prj"];
last = dec (size path); last = dec (size path);
RemoveSuffix` :: !Pathname -> String; RemoveSuffix` :: !Pathname -> String;
RemoveSuffix` path RemoveSuffix` path
| not found = path; | not found = path;
...@@ -54,7 +54,7 @@ RemoveSuffix` path ...@@ -54,7 +54,7 @@ RemoveSuffix` path
// suf = path % (position, last); // suf = path % (position, last);
// suffix = suf == ".dcl" || suf == ".icl" || suf == ".abc" || suf == ".o" || suf == ".prj"; // suffix = suf == ".dcl" || suf == ".icl" || suf == ".abc" || suf == ".o" || suf == ".prj";
last = dec (size path); last = dec (size path);
RemoveFilename :: !Pathname -> Pathname; RemoveFilename :: !Pathname -> Pathname;
RemoveFilename path RemoveFilename path
# (found,position) = FindLastChar DirSeparator path (dec (size path)); # (found,position) = FindLastChar DirSeparator path (dec (size path));
...@@ -76,6 +76,10 @@ IsFullPathname name = LastChar DirSeparator name (dec (size name)) >= 0; ...@@ -76,6 +76,10 @@ IsFullPathname name = LastChar DirSeparator name (dec (size name)) >= 0;
MakeFullPathname :: !Pathname !String -> Pathname; MakeFullPathname :: !Pathname !String -> Pathname;
MakeFullPathname path name = path +++ DirSeparatorString +++ name; 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 */ /* Auxilary functions */
equal_suffix :: !String !String -> Bool; 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