convert relative file paths to full file paths using function GetLongPathName,

(written by Mart Lubbers)

cpm/CpmLogic.dcl

 definition module CpmLogic
 
-/**
- * CPM imports
- */
+// CPM imports
 import AbsSyn
 
-/**
- * CleanIDE imports
- */
+// CleanIDE imports
 from PmProject import :: Project
 
-/**
- * Execute a general CPM action
- */
+// Execute a general CPM action
 doCpmAction :: String String !CpmAction !*World -> *World
 
-/**
- * Find all project files in the current working directory and build them
- */
+// Find all project files in the current working directory and build them
 doMake :: String !String !*World -> *World
 
-/**
- * Execute project-specific actions
- */
+// Execute project-specific actions
 doProjectAction :: String String String ProjectAction *World -> *World
 
-/**
- * Execute path-related project actions
- */
-doProjectPathAction :: String String Project PathAction *World -> *World
+// Execute path-related project actions
+doProjectPathAction :: String String String Project PathAction *World -> *World
 
-/**
- * Execute module-related actions
- */
+// Execute module-related actions
 doModuleAction :: String !String !ModuleAction !*World -> *World
 
-/**
- * Turn a project name into a project filename
- */
-mkProjectFile :: !String -> String
+// Modify a project
+withProject :: !String !String !String (Project -> Project) *World -> *World
 
-/**
- * Modify a project
- */
-withProject :: !String !String (Project -> Project) *World -> *World
-
-/**
- * Collect all project paths in a list with an index prefixed
- */
+// Collect all project paths in a list with an index prefixed
 showPaths :: !Project -> [String]
 
-/**
- * Modify the list of paths in a project given a modification function which
- * takes a strict list of project paths and returns a strict list of project
- * paths.
- */
-doModPaths :: !String !String !Project ([!String!] -> [!String!]) *World -> *World
-
-/**
- * Open a project file
- */
-openProject :: !FilePath !FilePath !*World -> (!Project, !*World)
-
-/**
- * Save a project back to its project file
- */
-saveProject :: !FilePath !Project !FilePath !*World -> *World
-
-/**
- * Remove an item from a strict list at a given index. Abort execution if the
- * index is out of bounds.
- */
+/*
+ Modify the list of paths in a project given a modification function which
+ takes a strict list of project paths and returns a strict list of project
+ paths.
+*/
+doModPaths :: !String !String !String !Project ([!String!] -> [!String!]) *World -> *World
+
+// Open a project file
+openProject :: !FilePath !FilePath !FilePath !*World -> (!FilePath, !Project, Bool, !*World)
+
+// Save a project back to its project file
+saveProject :: !FilePath !FilePath !Project !FilePath !*World -> *World
+
+/*
+ Remove an item from a strict list at a given index. Abort execution if the
+ index is out of bounds.
+*/
 rmStrictListIdx :: !Int [!a!] -> [!a!]
 
-/**
- * Move a path at a given index up or down the list of paths. Abort execution
- * if the index is out of bounds.
- */
+/*
+ Move a path at a given index up or down the list of paths. Abort execution
+ if the index is out of bounds.
+*/
 moveStrictListIdx :: !Int PathDirection [!a!] -> [!a!]
 
-/**
- * Show an error message
- */
+// Show an error message
 error :: !String !*World -> *World
 
-/**
- * Show a help message
- */
+// Show a help message
 help :: !String ![String] !*World -> *World
 
-/**
- * Given a list of strings, concatenate them to a single string with newlines
- * in between, then print that new string to console.
- */
+/*
+ Given a list of strings, concatenate them to a single string with newlines
+ in between, then print that new string to console.
+*/
 showLines :: ![String] !*World -> *World

cpm/CpmLogic.icl

@@ -95,15 +95,14 @@ doProjectAction cleanhome pwd  pn  CreateProject world
     # prj            = PR_NewProject mainmodule edit_options compilerOptions DefCodeGenOptions
                          DefApplicationOptions [!!] DefaultLinkOptions
     # project        = PR_SetRoot mainmodule edit_options compilerOptions prj
-    # projectfile    = mkProjectFile basefilename //addExtension basefilename "prj"
-    # (prjok, world) = accFiles (SaveProjectFile projectfile project cleanhome) world
-    | not prjok      = error ("Could not create project file " +++ projectfile) world
-    = world
+    # projectfile    = addExtension basefilename "prj"
+    = saveProject cleanhome pwd project projectfile world
 
 doProjectAction cleanhome pwd  pn  ShowProject world
-  # projectfile       = mkProjectFile pn
-  # (project, world)  = openProject cleanhome projectfile world
-  = showLines  [  "Content of " +++ projectfile +++ ":"
+  # (proj_path, project, ok, world) = openProject pwd pn cleanhome world
+  | not ok
+	= world
+  = showLines  [  "Content of " +++ proj_path +++ ":"
                ,  "ProjectRoot..: " +++ PR_GetRelativeRootDir project
                ,  "Target.......: " +++ PR_GetTarget project
                ,  "Executable...: " +++ PR_GetExecPath project
@@ -113,9 +112,9 @@ doProjectAction cleanhome pwd  pn  ShowProject world
 
 doProjectAction cleanhome pwd  pn  (BuildProject force ideenvs) world
   # (envs, world)                = readIDEEnvs cleanhome ideenvs world
-  # proj_path                = GetLongPathName (pwd </> pn)
-  # ((proj, ok, err), world) = accFiles (ReadProjectFile proj_path cleanhome) world
-  | not ok || err <> ""      = error ("CPM failed while opening project: " +++ err +++ "\n") world
+  # (proj_path, proj, ok, world) = openProject pwd pn cleanhome world
+  | not ok
+	= world
   # (console, world)             = stdio world
   # iniGeneral                   = initGeneral True compilerOptions cleanhome proj_path proj envs console
   # {ls, gst_world}              = pinit force {ls=iniGeneral,gst_world=world,gst_continue_or_stop=False}
@@ -124,22 +123,23 @@ doProjectAction cleanhome pwd  pn  (BuildProject force ideenvs) world
   pinit force_rebuild gst = BringProjectUptoDate force_rebuild cleanup gst
   cleanup exepath bool1 bool2 ps = abortLog False "" ps
 
-doProjectAction cleanhome  _  pn  (ProjectPath pa) world
-  # projectfile       = mkProjectFile pn
-  # (project, world)  = openProject cleanhome projectfile world
-  = doProjectPathAction cleanhome projectfile project pa world
+doProjectAction cleanhome pwd pn  (ProjectPath pa) world
+  # (proj_path, project, ok, world) = openProject pwd pn cleanhome world
+  | not ok
+	= world
+  = doProjectPathAction cleanhome pwd pn project pa world
 
-doProjectAction cleanhome pwd pn (SetRelativeRoot target) world =
-  withProject cleanhome pn (PR_SetRelativeRootDir target) world
+doProjectAction cleanhome pwd pn (SetRelativeRoot target) world
+  = withProject pwd pn cleanhome (PR_SetRelativeRootDir target) world
 
-doProjectAction cleanhome pwd pn (SetTarget target) world =
-  withProject cleanhome pn (PR_SetTarget target) world
+doProjectAction cleanhome pwd pn (SetTarget target) world
+  = withProject pwd pn cleanhome (PR_SetTarget target) world
 
-doProjectAction cleanhome pwd pn (SetExec exec) world =
-  withProject cleanhome pn (PR_SetExecPath exec) world
+doProjectAction cleanhome pwd pn (SetExec exec) world
+  = withProject pwd pn cleanhome (PR_SetExecPath exec) world
 
 doProjectAction cleanhome pwd pn (SetProjectOptions project_options) world
-	= withProject cleanhome pn (set_project_options project_options) world
+	= withProject pwd pn cleanhome (set_project_options project_options) world
 where
 	set_project_options [project_option:project_options] project
 		# project = set_project_option project_option project
@@ -211,38 +211,34 @@ doEnvironmentAction _          _    _                               world =
     ,  "  setcodegen <envname> <codegenname>    : set codegen for <envname> to <codegenname>"
     ] world
 
-/**
- * Turn a project name into a project filename
- */
-mkProjectFile :: !String -> String
-mkProjectFile pn = addExtension (dropExtension pn) "prj"
-
 /**
  * Modify a project
  */
-withProject :: !String !String (Project -> Project) *World -> *World
-withProject cleanhome pn f world
-  # projectfile      = mkProjectFile pn
-  # (project, world) = openProject cleanhome projectfile world
-  = saveProject cleanhome (f project) projectfile world
+withProject :: !String !String !String (Project -> Project) *World -> *World
+withProject pwd pn cleanhome f world
+  # (project_path, project, ok, world) = openProject pwd pn cleanhome world
+  | not ok
+	= world
+  = saveProject cleanhome pwd (f project) project_path world
 
 /**
  * Execute path-related project actions
  */
-doProjectPathAction :: String String Project PathAction *World -> *World
-doProjectPathAction cleanhome pn project (AddPathAction path) world =
-  doModPaths cleanhome pn project ((:!) path) world
+doProjectPathAction :: String String String Project PathAction *World -> *World
+doProjectPathAction cleanhome pwd pn project (AddPathAction path) world
+  = doModPaths cleanhome pwd pn project ((:!) (GetLongPathName path)) world
 
-doProjectPathAction cleanhome pn project (RemovePathAction i) world =
-  doModPaths cleanhome pn project (rmStrictListIdx i) world
+doProjectPathAction cleanhome pwd pn project (RemovePathAction i) world
+  = doModPaths cleanhome pwd pn project (rmStrictListIdx i) world
 
-doProjectPathAction _ _ project ListPathsAction world = showLines ["Paths for project:" : showPaths project] world
+doProjectPathAction _ _ _ project ListPathsAction world
+  = showLines ["Paths for project:" : showPaths project] world
 
-doProjectPathAction cleanhome pn project (MovePathAction i pdir) world =
-  doModPaths cleanhome pn project (moveStrictListIdx i pdir) world
+doProjectPathAction cleanhome pwd pn project (MovePathAction i pdir) world
+  = doModPaths cleanhome pwd pn project (moveStrictListIdx i pdir) world
 
-doProjectPathAction _         _   _     _  world =
-  help "cpm project <projectname.prj> path <action>"
+doProjectPathAction _          _ _   _     _  world
+  = help "cpm project <projectname.prj> path <action>"
     [  "Where <action> is one of the following"
     ,  "  add <path>          : add a path to the project"
     ,  "  list                : list all project paths and their index"
@@ -261,30 +257,34 @@ showPaths project = map f (zip2 [0..] (StrictListToList (PR_GetPaths project)))
  * takes a strict list of project paths and returns a strict list of project
  * paths.
  */
-doModPaths :: !String !String !Project ([!String!] -> [!String!]) *World -> *World
-doModPaths cleanhome pn project f world
+doModPaths :: !String !String !String !Project ([!String!] -> [!String!]) *World -> *World
+doModPaths cleanhome pwd pn project f world
   # paths = PR_GetPaths project
   # prj   = PR_SetPaths False paths (f paths) project
-  # world = saveProject cleanhome prj pn world
+  # world = saveProject cleanhome pwd prj pn world
   = showLines ["Successfully modified project paths"] world
 
 /**
  * Open a project file
  */
-openProject :: !FilePath !FilePath !*World -> (!Project, !*World)
-openProject cleanhome projectfile world
-  # ((prj, ok, err), world) = accFiles (ReadProjectFile projectfile cleanhome) world
-  | ok        = (prj, world)
-  | otherwise = (prj, error err world)
+openProject :: !FilePath !FilePath !FilePath !*World -> (!FilePath, !Project, Bool, !*World)
+openProject pwd pn cleanhome world
+  # proj_path                = GetLongPathName (pwd </> pn)
+  # ((prj, ok, err), world)  = accFiles (ReadProjectFile proj_path cleanhome) world
+  | not ok || err <> ""
+	= (proj_path, prj, ok, error err world)
+  = (proj_path, prj, ok, world)
 
 /**
  * Save a project back to its project file
  */
-saveProject :: !FilePath !Project !FilePath !*World -> *World
-saveProject cleanhome prj projectfile world
-  # (ok, world) = accFiles (SaveProjectFile projectfile prj cleanhome) world
-  | not ok    = error "Error saving project" world
-  | otherwise = world
+saveProject :: !FilePath !FilePath !Project !FilePath !*World -> *World
+saveProject cleanhome pwd prj projectfile world
+  # proj_path = GetLongPathName projectfile
+  # (ok, world) = accFiles (SaveProjectFile proj_path prj cleanhome) world
+  | not ok
+	= error "Error saving project" world
+  = world
 
 /**
  * Remove an item from a strict list at a given index. Abort execution if the