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

implement project templates

parent a81b1b1f
......@@ -241,6 +241,7 @@ fileMenu prefspath {mn_clo,mn_sva,mn_sav,mn_rev,mn_oth,mn_prt,mn_prs,mn_odm,mn_o
[ MenuFunction (noLS pm_new)
, MenuId mPrNewId
]
:+: MenuItem "New Project Using Template..." [MenuFunction (noLS pm_new_project_using_template)]
:+: MenuItem "&Open..."
[ MenuShortKey 'O'
, MenuModsFunction (noLS1 ed_open)
......@@ -460,6 +461,7 @@ projectMenu
]
:+: MenuItem "Project Directory Up" [MenuFunction (noLS project_directory_up)]
:+: MenuItem "Project Directory Down" [MenuFunction (noLS project_directory_down)]
:+: MenuItem "Save Project Template..." [MenuFunction (noLS pm_save_project_as_template)]
:+: MenuItem "Project Defaults..."
[ MenuFunction (noLS projectDefaults)
]
......
......@@ -13,6 +13,8 @@ pm_menu_rem :: !*(PSt *General) -> *PSt *General;
pm_new :: !*(PSt *General) -> *PSt *General;
pm_new_project_using_template :: !*(PSt *General) -> *PSt *General;
pm_open :: !*(PSt *General) -> *PSt *General;
pm_open_path :: !.String !*(PSt *General) -> *PSt *General;
......
......@@ -193,20 +193,20 @@ pm_new ps
# (_,ps) = close_all_project_windows (pm_new` path projectpath) ps
= ps
pm_new` :: !String !String !*(PSt *General) -> (!Bool,!*PSt *General);
pm_new` path projectpath ps
# ps = pm_shut ps // just in case
# (prefs,ps) = getPrefs ps
edo = {newlines=HostNativeNewlineConvention}
eo = {eo = edo, pos_size = NoWindowPosAndSize}
co = prefs.compopts //DefCompilerOptions
go = prefs.cgenopts //DefCodeGenOptions
lo = prefs.linkopts //DefaultLinkOptions
ao = prefs.applopts //DefApplicationOptions
project = PR_NewProject path eo co go ao Nil lo
# ({compopts,cgenopts,linkopts,applopts},ps) = getPrefs ps
eo = {eo = {newlines=HostNativeNewlineConvention}, pos_size = NoWindowPosAndSize}
project = PR_NewProject path eo compopts cgenopts applopts Nil linkopts
ps = setProjectFilePath projectpath ps
project = PR_SetRoot path eo co project // ensure correct root path in project
project = PR_SetRoot path eo compopts project // ensure correct root path in project
ps = appProject (const project) ps
ps = pm_set_window_title projectpath ps
= show_new_project projectpath ps
show_new_project :: !String !*(PSt *General) -> (!Bool,!*PSt *General);
show_new_project projectpath ps
# ps = pm_set_window_title projectpath ps
(tg,ps) = getTargetName ps
ps = setProjectTarget tg ps
ps = pm_update_project_window ps
......@@ -215,6 +215,64 @@ pm_new` path projectpath ps
// # ps = pm_menu_add projectpath ps
= (True,ps)
pm_new_project_using_template :: !*(PSt *General) -> *PSt *General;
pm_new_project_using_template ps
# (path,ps) = sendToActiveWindow msgGetPathName ps
= case path of
Nothing
-> okNotice ["Unable to create new project.","There is no active module window."] ps
Just path
# (prt_s,ps) = selectInputFile ps
-> case prt_s of
Nothing
-> ps
Just prt_path_name
| not (equal_suffix ".prt" (RemovePath prt_path_name))
-> okNotice ["The file \"" +++ prt_path_name +++ "\" is not a project template file (.prt)."] ps
# (startupdir,ps) = getStup ps
((ok,project,err),ps) = accFiles (read_project_template_file prt_path_name startupdir) ps
| not ok
-> okNotice [err] ps
# (mpath,ps) = selectOutputFile "New Project..." (MakeProjectPathname path) ps
-> case mpath of
Nothing
-> ps
Just project_file_path
# (_,ps) = close_all_project_windows (create_new_project_using_template path project_file_path project) ps
-> ps
create_new_project_using_template :: !String !String !Project !*(PSt *General) -> (!Bool,!*PSt *General);
create_new_project_using_template path project_file_path project ps
# ps = pm_shut ps // just in case
template_root_dir = PR_GetRootDir project
({compopts,cgenopts,linkopts,applopts},ps) = getPrefs ps
eo = {eo = {newlines=HostNativeNewlineConvention}, pos_size = NoWindowPosAndSize}
ps = setProjectFilePath project_file_path ps
project = PR_SetRoot path eo compopts project
project = PR_SetExecPath (MakeExecPathname path) project
project = set_root_directory_of_project (RemoveFilename project_file_path) template_root_dir project
ps = appProject (const project) ps
ps = selectProjectTarget getTargets ps
= show_new_project project_file_path ps
where
set_root_directory_of_project :: !{#Char} !{#Char} !Project -> Project
set_root_directory_of_project project_file_dir template_root_dir project
| size project_file_dir<=size template_root_dir || project_file_dir % (0,size template_root_dir-1)<>template_root_dir
= change_root_directory_of_project "." project_file_dir project
# (n_removed_dirs,project_dir) = count_dirs_to_be_removed 0 (size template_root_dir) project_file_dir
| project_dir==template_root_dir
= change_root_directory_of_project (createArray (n_removed_dirs+1) '.') template_root_dir project
= change_root_directory_of_project "." project_file_dir project
count_dirs_to_be_removed :: !Int !Int !{#Char} -> (!Int,!{#Char})
count_dirs_to_be_removed n_removed_dirs template_root_dir_size project_dir
# project_dir_up = RemoveFilename project_dir
| size project_dir_up==size project_dir
= (n_removed_dirs,project_dir)
| size project_dir_up>template_root_dir_size
= count_dirs_to_be_removed (n_removed_dirs+1) template_root_dir_size project_dir_up
= (n_removed_dirs+1,project_dir_up)
pm_open :: !*(PSt *General) -> *PSt *General;
pm_open ps
# (fs,ps) = selectInputFile ps
......
......@@ -30,5 +30,6 @@ pm_save :: !*(PSt *General) -> *PSt *General
pm_save_as :: !*(PSt *General) -> *PSt *General
pm_save_copy_as :: !*(PSt *General) -> *PSt *General
pm_maybe_save :: !Id !*(PSt *General) -> (Bool,*PSt *General)
pm_save_project_as_template :: !*(PSt *General) -> *PSt *General
pm_set_window_title :: .Title !*(PSt *General) -> *PSt *General;
pm_get_projwin_possiz :: *(PSt *General) -> *(.(Vector2,Size),*PSt *General);
......@@ -11,7 +11,6 @@ import PmCleanSystem
import flextextcontrol
import ioutil, morecontrols, colorpickcontrol
import projmen, menubar, colourclip
//from IDE import OpenModule
import Platform, IdePlatform
import PmDirCache, UtilIO
......@@ -949,6 +948,26 @@ pm_maybe_save win ps
= (True,pm_save ps)
= (False,ps)
pm_save_project_as_template :: !*(PSt *General) -> *PSt *General
pm_save_project_as_template ps
# (project,ps) = getProject ps
| not (PR_ProjectSet project)
= okNotice ["No open project"] ps
# (pathname,ps) = getProjectFilePath ps
| size pathname==0
= ps
# (pn,ps) = selectOutputFile "Save Project Template:" "*.prt" ps
= case pn of
Nothing
-> ps
Just prt_path
# (startupdir,ps) = getStup ps
(ok,ps) = accFiles (save_project_template_file prt_path project startupdir) ps
| not ok
-> okNotice [ "The file "+++RemovePath prt_path+++" could not be saved because"
, "of a file I/O error."] ps
-> ps
pm_set_window_title :: .Title !*(PSt *General) -> *PSt *General;
pm_set_window_title pathname ps
# (wId,ps) = getPWW ps
......
......@@ -27,7 +27,7 @@ DefaultABCOptions :: ABCOptions
AC_Init :: ABCCache
Combined ::
ParseABCInfoAndDependencies ::
!Pathname
!DATE
!ABCCache
......
......@@ -70,8 +70,8 @@ Abc64BitsOffset :==10;
MinimumNrOfOptions :== 9;
NrOfOptions :== 11;
Combined :: !Pathname !DATE !ABCCache !Files -> (!((!Bool, !Bool, !Int, !ABCOptions),(!List Modulename, !Maybe ModuleDate, !List ModuleDate, !List LinkObjFileName, !List LinkLibraryName),!ABCCache),!Files)
Combined path date abccache files
ParseABCInfoAndDependencies :: !Pathname !DATE !ABCCache !Files -> (!((!Bool, !Bool, !Int, !ABCOptions),(!List Modulename, !Maybe ModuleDate, !List ModuleDate, !List LinkObjFileName, !List LinkLibraryName),!ABCCache),!Files)
ParseABCInfoAndDependencies path date abccache files
# (opened, file, files) = fopen path FReadData files
| not opened
= ((dummyCinf,dummyDinf,abccache),files)
......
......@@ -341,7 +341,6 @@ step intr (DComp force dircache (Pers inf) Nil ds) ps
# (modpaths,project) = PR_GetModulenames True IclMod project
# ds = {ds & modpaths = modpaths, project = project}
# ps = showInfo (Level1 "Generating...") ps
//XXX = step intr (DGene True newpaths fileinfo libsinfo modpaths modpaths abccache project setproject) ps
# (paths,ds) = ds!modpaths
= step intr (DGene paths SyncCodeGeneration ds) ps
......@@ -808,7 +807,6 @@ step intr (DLink ds=:{ok, newpaths, fileinfo, libsinfo, modpaths, abccache, proj
# ao = PR_GetApplicationOptions project
// possibly patch _system to correct profiling settings...
// # tp = PR_GetProcessor project
# (tp,ps) = getCurrentProc ps
# ((abccache,fileinfo,modinfo),ps)
= FI_GetFileInfo tp full_sys` abccache fileinfo ps
......@@ -852,7 +850,6 @@ step intr (DLink ds=:{ok, newpaths, fileinfo, libsinfo, modpaths, abccache, proj
# ps = showInfo line ps
= continue False newpaths False fileinfo libsinfo modpaths project intr (abccache, ps)
# prj_path` = RemoveFilename prj_path
# execpath = PR_GetExecPath project
# prj_path` = PR_GetRootDir project
# execpath = fulPath app_path prj_path` execpath
......@@ -885,20 +882,6 @@ step intr (DLink ds=:{ok, newpaths, fileinfo, libsinfo, modpaths, abccache, proj
# (defobjs,ps) = getCurrentObjts ps
# ofiles = Concat defobjs ofiles
# lfiles = Concat deflibs lfiles
/* NO: these are stored with full path so need different approach???
# (defobjsOk,defobjs,abcPathsCache)
= GetPathNames defobjs Nil abcPathsCache
# (deflibsOk,deflibs,abcPathsCache)
= GetPathNames deflibs Nil abcPathsCache
| not defobjsOk
# line = Level3 ["Link error: File: '" +++ (Head defobjs) +++ "' not found."]
# ps = showInfo line ps
= continue False newpaths False fileinfo libsinfo abccache modpaths project intr ps
| not deflibsOk
# line = Level3 ["Link error: File: '" +++ (Head deflibs) +++ "' not found."]
# ps = showInfo line ps
= continue False newpaths False fileinfo libsinfo abccache modpaths project intr ps
*/
// clean modules
# (clmodpaths,fileinfo) = FI_GetCleanModules system_obj_path libsinfo fileinfo
......@@ -934,7 +917,7 @@ step intr (DLink ds=:{ok, newpaths, fileinfo, libsinfo, modpaths, abccache, proj
# ofiles = Concat extraObjectModules ofiles
# ofiles` = Concat extraObjectModules ofiles`
# lfiles = Concat lo.libraries lfiles
# (env_static_libs,ps) = getCurrentSlibs ps
#! sfiles = Concat (SL_Libs libsinfo) env_static_libs // only if really used?
#! ofiles = Reverse ofiles
......@@ -1306,11 +1289,9 @@ CTPMcommon /*compileOrCheckSyntax*/ path mn fileinfo abccache project ps0
where
(syspaths,ps1) = getCurrentPaths ps0
(version,ps) = getCurrentVers ps1
//XXX mn = GetModuleName path
//XXX line = Level2 ((if (compileOrCheckSyntax == Compilation) "Compiling '" "Checking '") +++ mn +++ "'.")
ao = PR_GetApplicationOptions project
prjpaths = PR_GetPaths project
// proc = PR_GetProcessor project
typewin :: !String ![String] !*GeneralSt -> *GeneralSt
typewin mn strings ps
# (interact, ps) = getInteract ps
......@@ -1351,10 +1332,9 @@ where
NewPathsDialog :: !String !String !Project !*GeneralSt -> *(*GeneralSt,Project,Bool)
NewPathsDialog module_name path project ps
# (ap,ps) = getStup ps
# (pp,ps) = getProjectFilePath ps
# (defp,ps) = getCurrentPaths ps
# prjpaths = PR_GetPaths project
# pp = RemoveFilename pp
# pp = PR_GetRootDir project
# line = "Where is '" +++ path +++ "' imported by '" +++ module_name +++ "'"
# (backupproject,ps) = getProject ps
# ps = setProject project ps
......@@ -1378,16 +1358,9 @@ ProcessCompilerMsg cstate _ _ path abcpath SyntaxError fileinfo dircache abccach
ProcessCompilerMsg cstate compileOrCheckSyntax co path abcpath CompilerOK fileinfo dircache abccache project ps0
| compileOrCheckSyntax == SyntaxCheck
= (cstate,(ps,fileinfo,dircache,abccache,project,True, False,EmptyPathname,Nil))
#! ((ok,dircache),ps) = case version of
// 916 -> accFiles (PatchABCDates abcpath dircache) ps
_ -> ((True,dircache),ps)
| not ok
# line = Level3 ["Error: Unable to patch '" +++ abcpath +++ "'."]
# ps = showInfo line ps
= (cstate,(ps, fileinfo, dircache,abccache,project, False, False, abcpath,Nil))
# (abcdate,ps) = accFiles (FModified abcpath) ps
(((sys,stack,version,abcoptions),(mods,_,_,objs,libs),abccache), ps)
= accFiles (Combined abcpath abcdate abccache) ps
= accFiles (ParseABCInfoAndDependencies abcpath abcdate abccache) ps
update = \finfo ->
{ finfo
& abcpath = abcpath
......@@ -1398,12 +1371,6 @@ ProcessCompilerMsg cstate compileOrCheckSyntax co path abcpath CompilerOK filein
, abcOptions = abcoptions
}
fileinfo = FI_UpdateFileInfo (MakeImpPathname path) update fileinfo
| not ok // fairly useless, only if unable to open abc...
# line = Level3 ["Error: Unable to open '" +++ abcpath +++ "'."]
# ps = showInfo line ps
= (cstate,(ps, fileinfo, dircache,abccache,project, False, False, abcpath,Nil))
# (ok,paths,dircache) = LookupModulePaths mods dircache
| not ok // NO, should fix with add new paths dialogue...
# line = Level3 ["Error: Unable to find '" +++ (Head paths) +++ "'."]
......
......@@ -10,6 +10,7 @@ import PmTypes
ProjectTable :: OptionsTable ProjectGlobalOptions
project_table :: OptionsTable ProjectGlobalOptions
edit_options_table :: OptionsTable ProjectGlobalOptions
project_template_table :: OptionsTable ProjectGlobalOptions
CompilerOptionsTable :: OptionsTable CompilerOptions
CodeGenOptionsTable :: OptionsTable CodeGenOptions
LinkOptionsTable :: OptionsTable LinkOptions
......
......@@ -101,6 +101,19 @@ ProjectGlobalOptionsTable =
, postlink_option
}
project_template_global_options_table :: OptionsTable ProjectGlobalOptions
project_template_global_options_table =
{ project_root_option
, target_option
, code_gen_option
, application_option
, link_option
, paths_option
, static_option
, precompile_option
, postlink_option
}
instance fromString Bool
where
fromString "False"
......@@ -175,6 +188,10 @@ make_project_table main_module_option other_modules_option
, GroupedOption "Dynamic" DynamicInfoTable (\a->a.pg_dynamic) (\v a->{a & pg_dynamic=v})
}
project_template_table :: OptionsTable ProjectGlobalOptions
project_template_table
= { GroupedOption "Global" project_template_global_options_table id const }
EmptyModInfo :: ModInfo
EmptyModInfo
# defaultEditWdOptions = {eo=DefaultEditOptions,pos_size=NoWindowPosAndSize}
......
......@@ -36,6 +36,10 @@ ReadProjectFile ::
),!*Files // returned filesystem
)
save_project_template_file :: !String !Project !String !*Files -> (!Bool, !*Files)
read_project_template_file :: !String !String !*Files -> (!(!Bool, !Project, !{#Char}),!*Files)
change_root_directory_of_project :: !{#Char} !{#Char} !Project -> Project
getDynamicInfo :: !Project -> (ProjectDynamicInfo,Project)
......
......@@ -792,6 +792,17 @@ SaveProjectFile projectPath project applicationDir files
#! (prp_ok, files) = fclose prp_file files
= (prj_ok && prp_ok, files)
save_project_template_file :: !String !Project !String !*Files -> (!Bool, !*Files);
save_project_template_file projectPath project applicationDir files
# (opened, prt_file, files) = fopen projectPath FWriteText files
| not opened
= (False, files)
#! projectGO = GetProject applicationDir project
#! main_module_dir_path = projectGO.pg_mainModuleInfo.ModInfoAndName.info.dir
# projectGO = {projectGO & pg_projectPaths = [|p \\ p<|-projectGO.pg_projectPaths | p<>main_module_dir_path]}
# prt_file = WriteOptionsFile ProjectFileVersion (PutOptions project_template_table projectGO) prt_file
= fclose prt_file files
sort_modules :: !ProjectGlobalOptions -> ProjectGlobalOptions
sort_modules projectGO=:{pg_projectPaths,pg_otherModules}
# project_paths = {project_path \\ project_path<|-pg_projectPaths}
......@@ -912,6 +923,27 @@ ReadProjectFile projectPath applicationDir files
= ((project, True,"The file \"" +++ projectName +++ "\" could not be closed."), files)
= ((project, True,""), files)
read_project_template_file :: !String !String !*Files -> (!(!Bool, !Project, !{#Char}),!*Files)
read_project_template_file template_file_path applicationDir files
# (opened, file, files) = fopen template_file_path FReadData files
empty_project = PR_InitProject
template_file_name = RemovePath template_file_path
template_file_dir = RemoveFilename template_file_path
| not opened
= ((False,empty_project,"The file \"" +++ template_file_name +++ "\" could not be opened."),files)
# (version, file) = ReadVersion file
| size version==0
# (_, files) = fclose file files
= ((False,empty_project,"The file \"" +++ template_file_name +++ "\" is not a project template and could not be opened."),files)
# (options, file) = ReadOptionsFile file
empty_projectGO = GetProject applicationDir empty_project
projectGO = GetOptions project_template_table options empty_projectGO
project = SetProject applicationDir template_file_dir projectGO
(closed, files) = fclose file files
| not closed
= ((False,empty_project,"Could not read the file \"" +++ template_file_name +++ "\"."), files)
= ((True,project,""), files)
add_edit_options_from_prp_file :: !String !ProjectGlobalOptions !ProjectGlobalOptions !*Files -> (!ProjectGlobalOptions, !*Files)
add_edit_options_from_prp_file prp_path projectGO empty_projectGO files
# (opened, prp_file, files) = fopen prp_path FReadData files
......
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