Merge branch 'cpm-project-templates' into 'master'

Cpm project templates

See merge request !19

Ide/projmen.icl

@@ -229,49 +229,29 @@ pm_new_project_using_template 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
+					# (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 (setup_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
+setup_new_project_using_template :: !String !String !Project !*(PSt *General) -> *(!Bool, !*PSt *General);
+setup_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
+	# ((ok, project), ps) = accFiles (create_new_project_using_template path project_file_path compopts eo project) ps
+	| not ok
+		= (False, okNotice ["Unable to create project", "Error setting up project from the given project template"] ps)
+	# 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

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]
@@ -25,6 +25,7 @@ from StdMaybe import :: Maybe
   |  SetExec String
   |  SetBytecode (Maybe String)
   |  SetProjectOptions [ProjectOption]
+  |  ExportTemplate FilePath
   |  ProjectHelp
 
 :: PathAction

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
@@ -163,6 +170,13 @@ where
 doProjectAction cleanhome pwd pn (SetBytecode (Just bcfile)) world
   = withProject pwd pn cleanhome (PR_SetByteCodePath bcfile) world
 
+doProjectAction cleanhome pwd pn (ExportTemplate prt) world
+	# (project_path, project, ok, world) = openProject pwd pn cleanhome world
+	| not ok = error "Error opening project" world
+	# (ok, world) = accFiles (save_project_template_file prt project cleanhome) world
+	| not ok = error "Error saving project template" world
+	= world
+
 doProjectAction cleanhome pwd pn (SetProjectOptions project_options) world
 	= withProject pwd pn cleanhome (set_project_options project_options) world
 where
@@ -224,7 +238,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')"
@@ -235,6 +249,7 @@ doProjectAction _          _  _   _    world             =
     ,  "  target <env>                      : set target environment to <env>"
     ,  "  exec <execname>                   : set executable name to <execname>"
     ,  "  bytecode [bc]                     : set bytecode file to <bcfile> or <execname>.bc if no file given"
+    ,  "  template <template.prt>           : export the given project to a template file"
     ,  "  set <option> [<option>]           : Set one or more of the following options:"
     ,  "                                    : -h SIZE"
     ,  "                                    :     Change the heapsize (e.g. 2M)"

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);
@@ -33,6 +34,7 @@ parse_Project ["target",s] project_name = Project project_name (SetTarget s);
 parse_Project ["exec",s] project_name = Project project_name (SetExec s);
 parse_Project ["bytecode",s] project_name = Project project_name (SetBytecode (Just s));
 parse_Project ["bytecode"] project_name = Project project_name (SetBytecode Nothing);
+parse_Project ["template",s] project_name = Project project_name (ExportTemplate s);
 parse_Project ["set":project_option_args] project_name
 	# (ok,project_options) = parse_Project_options project_option_args;
 	| ok