Add create project from template to cpm, still need to check and reuse code for IDE

Pm/PmProject.dcl

@@ -38,8 +38,12 @@ ReadProjectFile	::
 
 save_project_template_file :: !String !Project !String !*Files -> (!Bool, !*Files)
 
+//Loads a template file into a (n incomplete) project
 read_project_template_file	:: !String !String !*Files -> (!(!Bool, !Project, !{#Char}),!*Files)
 
+//Creates an actual project from a loaded template
+create_new_project_using_template :: !String !String !CompilerOptions !EditWdOptions !Project !*Files -> ((!Bool, !Project), !*Files)
+
 change_root_directory_of_project :: !{#Char} !{#Char} !Project -> Project
 
 getDynamicInfo	:: !Project -> (ProjectDynamicInfo,Project)

Pm/PmProject.icl

@@ -998,6 +998,33 @@ read_project_template_file template_file_path applicationDir files
 		= ((False,empty_project,"Could not read the file \"" +++ template_file_name +++ "\"."), files)
 	= ((True,project,""), files)
 
+create_new_project_using_template :: !String !String !CompilerOptions !EditWdOptions !Project !*Files -> ((!Bool, !Project), !*Files)
+create_new_project_using_template path project_file_path compopts eo project ps
+	# template_root_dir = PR_GetRootDir project
+	# project = PR_SetRoot path eo compopts project
+	# project = PR_SetExecPath (MakeExecPathname path) project
+	# project = PR_SetByteCodePath (RemoveSuffix path +++ ".bc") project
+	# project = set_root_directory_of_project (RemoveFilename project_file_path) template_root_dir project
+	= ((True, project), 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)
+
 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

cpm/AbsSyn.dcl

@@ -15,7 +15,7 @@ from StdMaybe import :: Maybe
   |  CpmHelp
 
 :: ProjectAction
-  =  CreateProject
+  =  CreateProject (Maybe FilePath)
   |  ShowProject
   |  BuildProject Bool FilePath
   |  Compile [String]

cpm/CpmLogic.icl

@@ -74,29 +74,36 @@ getLine world
  * Execute project-specific actions
  */
 doProjectAction :: String String String ProjectAction *World -> *World
-doProjectAction cleanhome pwd  pn  CreateProject world
-  //Check if main module exists
-  # (exists,world)  = accFiles (FExists mainmodule) world
-  | not exists //       = error ("Main module " +++ mainmodule +++ " does not exist.") world
-    # world         = showLines ["Main module " +++ mainmodule +++ " does not exist. Create it? [y/n]"] world
-    # (line, world) = getLine world
-    | line.[0] == 'y' = mkMainAndProject world
-    | otherwise       = error ("Failed to create project. Need " +++ mainmodule) world
-  | otherwise       = mkProject world
-  where
-  mainmodule   = MakeImpPathname pn
-
-  mkMainAndProject world
-    # world = doModuleAction "" mainmodule (CreateModule ApplicationModule) world
-    = mkProject world
-  mkProject world
-    # edit_options   = {eo={newlines=NewlineConventionUnix},pos_size=NoWindowPosAndSize}
-    //Create project file using the Clean IDE libraries
-    # prj            = PR_NewProject mainmodule edit_options compilerOptions DefCodeGenOptions
-                         DefApplicationOptions [!!] DefaultLinkOptions
-    # project        = PR_SetRoot mainmodule edit_options compilerOptions prj
-    # projectfile    = MakeProjectPathname pn
-    = saveProject cleanhome pwd project projectfile world
+doProjectAction cleanhome pwd  pn  (CreateProject mtemplate) world
+	//Check if main module exists
+	# (exists,world) = accFiles (FExists mainmodule) world
+	| not exists
+		# world = showLines ["Main module " +++ mainmodule +++ " does not exist. Create it? [y/n]"] world
+		# (line, world) = getLine world
+		| line.[0] == 'y' = mkMainAndProject world
+		| otherwise = error ("Failed to create project. Need " +++ mainmodule) world
+	| otherwise = mkProject world
+where
+	mainmodule = MakeImpPathname pn
+
+	mkMainAndProject world
+		# world = doModuleAction "" mainmodule (CreateModule ApplicationModule) world
+		= mkProject world
+	mkProject world
+		# edit_options	 = {eo={newlines=NewlineConventionUnix},pos_size=NoWindowPosAndSize}
+		# projectfile = GetLongPathName (MakeProjectPathname pn)
+		= case mtemplate of
+			Nothing
+				# prj = PR_NewProject mainmodule edit_options compilerOptions DefCodeGenOptions DefApplicationOptions [!!] DefaultLinkOptions
+				# prj = PR_SetRoot mainmodule edit_options compilerOptions prj
+				= saveProject cleanhome pwd prj projectfile world
+			(Just template_file_path)
+				# template_file_path = GetLongPathName template_file_path
+				# ((ok, prj, errmsg), world) = accFiles (read_project_template_file template_file_path cleanhome) world
+				| not ok = error ("Couldn't open project template: " +++ errmsg) world
+				# ((ok, prj), world) = accFiles (create_new_project_using_template (pwd+++DirSeparatorString+++mainmodule) projectfile compilerOptions edit_options prj) world
+				| not ok = error "Couldn't convert project template to project file" world
+				= saveProject cleanhome pwd prj projectfile world
 
 doProjectAction cleanhome pwd  pn  ShowProject world
   # (proj_path, project, ok, world) = openProject pwd pn cleanhome world
@@ -224,7 +231,7 @@ where
 doProjectAction _          _  _   _    world             =
   help "cpm project <projectfile> <action>"
     [  "Where <action> is one of the following"
-    ,  "  create                            : create a new project"
+    ,  "  create [<template.prt>]           : create a new project from an optional template"
     ,  "  compile <modulename> [..]         : compile the given modules"
     ,  "  show                              : show project information"
     ,  "  build [--force] [--envs=filename] : build the project. Optionally force build (default: 'false')"

cpm/Parser.icl

@@ -19,7 +19,8 @@ parse_CpmLogic [project_name:project_build_args] = parse_Project_build_args proj
 parse_CpmLogic _ = CpmHelp;
 
 parse_Project :: ![String] !String -> CpmAction;
-parse_Project ["create"] project_name = Project project_name CreateProject;
+parse_Project ["create"] project_name = Project project_name (CreateProject Nothing);
+parse_Project ["create",s] project_name = Project project_name (CreateProject (Just s));
 parse_Project ["show"] project_name = Project project_name ShowProject;
 parse_Project ["build":project_build_args] project_name
 	= parse_Project_build_args project_build_args False EnvsFileName project_name (Project "" ProjectHelp);