Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
clean-and-itasks
clean-ide
Commits
bbc8e5a5
Commit
bbc8e5a5
authored
Oct 18, 2010
by
John van Groningen
Browse files
implement Project Directory Up and Down
parent
efa0357e
Changes
9
Hide whitespace changes
Inline
Side-by-side
Ide/IDE.icl
View file @
bbc8e5a5
...
...
@@ -10,13 +10,13 @@ import PmParse
import
PmPath
from
EdKeyMapping
import
macKeyMapping
,
ReadKeyMapFile
,
KeyMapFileName
from
finder
import
sr_find
,
sr_find_next
,
sr_find_sel
,
sr_rep_find
,
sr_goto_cursor
from
finder
import
sr_goto_line
,
sr_goto_selection
from
finder
import
sr_find
,
sr_find_next
,
sr_find_sel
,
sr_rep_find
,
sr_goto_cursor
,
sr_goto_line
,
sr_goto_selection
from
edoptions
import
defaultFontAndTabs
,
optionsKeyMapping
,
editColours
from
EdClient
import
::
EditAction
,
isEditWin
,
msgGetPathName
,
msgSelectAll
from
EdClient
import
emptySelection
,
sendToActiveWindow
,
msgGetSelection
from
EdClient
import
msgUndo
,
msgPaste
,
msgCopy
,
msgCut
,
msgClear
,
msgBalance
,
msgDetab
from
EdClient
import
::
EditAction
,
isEditWin
,
msgGetPathName
,
msgSelectAll
,
emptySelection
,
sendToActiveWindow
,
msgGetSelection
,
msgUndo
,
msgPaste
,
msgCopy
,
msgCut
,
msgClear
,
msgBalance
,
msgDetab
import
prefix
,
tools
import
IdeState
...
...
@@ -88,25 +88,16 @@ Start world
}
#
(
interact
,
force_update
,
proj_path
,
logfile
,
world
)
=
batchOptions
world
#!
(
iniClip
,
pub
,
world
)
=
iniGeneral
prefs
stup
interact
logfile
mTargetId
eTargetId
lbId
#!
(
iniClip
,
pub
,
world
)
=
iniGeneral
prefs
stup
interact
logfile
mTargetId
eTargetId
lbId
(
initEditorState
keymap
)
emptyFindInfo
ffind
mEdUndoId
mMdEdOptId
emptyFindInfo
ffind
mEdUndoId
mMdEdOptId
iniTwi
// winOnly?
iniCons
iniTargets
mProjectId
mPrListId
mPrRecId
mProjectId
mPrListId
mPrRecId
world
#
patt
=
[
ProcessClose
(
Quit
prefspath
)
,
ProcessOpenFiles
openfiles
...
...
@@ -467,6 +458,8 @@ projectMenu
,
MenuId
(
projIds
!!
12
)
,
MenuSelectState
Unable
]
:+:
MenuItem
"Project Directory Up"
[
MenuFunction
(
noLS
project_directory_up
)]
:+:
MenuItem
"Project Directory Down"
[
MenuFunction
(
noLS
project_directory_down
)]
:+:
MenuItem
"Project Defaults..."
[
MenuFunction
(
noLS
projectDefaults
)
]
...
...
Ide/PmDialogues.dcl
View file @
bbc8e5a5
...
...
@@ -6,6 +6,9 @@ import PmTypes, PmProject, IdeState
projectOptions
::
!(
PSt
General
)
->
PSt
General
projectDefaults
::
!(
PSt
General
)
->
PSt
General
project_directory_up
::
!(
PSt
General
)
->
PSt
General
project_directory_down
::
!(
PSt
General
)
->
PSt
General
doPathsDialog
::
// Display a Paths dialogue
!
String
// Dialogue title string
!
Pathname
// Application path
...
...
Ide/PmDialogues.icl
View file @
bbc8e5a5
...
...
@@ -5,8 +5,8 @@ import StdFileSelect,StdPStClass,StdWindow
import
PmTypes
,
PmProject
,
PmPath
,
UtilStrictLists
import
tabcontrol
,
ExtListBox
,
ioutil
,
IdeState
import
ExtNotice
,
UtilObjectIO
import
Platform
,
morecontrols
from
projwin
import
pm_update_project_window
::
PO_LS
=
{
ao
::
!
ApplicationOptions
...
...
@@ -40,8 +40,7 @@ projectDialog actualProject ps`
#(
dp
,
ps
)
=
getCurrentPaths
ps
#
prj
=
PR_SetPaths
False
dp
ret
.
paths
prj
#
(
appPath
,
ps
)
=
getStup
ps
#
(
prjPath
,
ps
)
=
getProjectFilePath
ps
#
prjPath
=
RemoveFilename
prjPath
#
prjPath
=
PR_GetRootDir
prj
#
prj
=
PR_SetExecPath
ret
.
xp
prj
#
prj
=
PR_SetStaticLibsInfo
ret
.
sl
prj
#
(
xxId
,
ps
)
=
getPWX
ps
...
...
@@ -83,15 +82,16 @@ where
(
lbdlibId
,
ps4
)
=
openExtListBoxId
ps3
(
lbslibId
,
ps5
)
=
openExtListBoxId
ps4
(
ap
,
ps6
)
=
getStup
ps5
(
pp
,
ps7
)
=
fix
(
getProjectFilePath
ps6
)
where
fix
(
l
,
r
)
=
(
RemoveFilename
l
,
r
)
pp
=
PR_GetRootDir
project
(
prefs
,
ps
)
=
PlatformDependant
(
getPrefs
ps
7
)
// Win
(
getPrefs
ps
6
)
// Win
(
getPrefs
ps9
)
// Mac
// mac only...
(
fontNames`
,
ps8
)
=
accPIO
(
accScreenPicture
getFontNames
)
ps
7
// filteren naar alleen fixed width fonts....
=
accPIO
(
accScreenPicture
getFontNames
)
ps
6
// filteren naar alleen fixed width fonts....
// (fixed,ps9) = seqList (map (\f->accPIO (accScreenPicture (lisFixedWidth f))) fontNames`) ps8
(
fixed
,
ps9
)
=
accPIO
(
accScreenPicture
(
seqList
(
map
lisFixedWidth
fontNames`
)))
ps8
fontNames
=
lfilter
fixed
fontNames`
fontSizes
=
[
7
,
8
,
9
,
10
,
12
,
14
,
18
,
24
]
inifn
=
ao
.
fn
...
...
@@ -170,7 +170,7 @@ where
setexe
(
ls
,
ps
)
#
(
prjPath
,
ps
)
=
getProjectFilePath
ps
#
prjName
=
RemoveSuffix
(
RemovePath
prjPath
)
#
prjPath
=
RemoveFilename
prjPath
#
prjPath
=
pp
#
(
exename
,
ps
)
=
PlatformDependant
(
selectOutputFile`
"Executable"
"*.exe"
"Set"
ps
)
// win
(
selectOutputFile
"Executable"
prjName
ps
)
// mac
...
...
@@ -395,8 +395,7 @@ where
make_sym_path
name
ps
#
(
appPath
,
ps
)
=
getStup
ps
#
(
prjPath
,
ps
)
=
getProjectFilePath
ps
#
prjPath
=
RemoveFilename
prjPath
prjPath
=
pp
=
(
symPath
appPath
prjPath
name
,
ps
)
objectsPane
=
Pane
"Extra Objects"
...
...
@@ -645,6 +644,38 @@ setCheckControlMark full id io
True
->
markCheckControlItems
id
[
1
]
io
False
->
unmarkCheckControlItems
id
[
1
]
io
project_directory_up
::
!(
PSt
General
)
->
PSt
General
project_directory_up
ps
#
(
project
,
ps
)
=
getProject
ps
|
not
(
PR_ProjectSet
project
)
=
okNotice
[
"No open project"
]
ps
#
(
project_file_path
,
ps
)
=
getProjectFilePath
ps
project_file_dir
=
RemoveFilename
project_file_path
relative_root_dir
=
PR_GetRelativeRootDir
project
parent_project_dir
=
make_project_dir
(
size
relative_root_dir
+1
)
project_file_dir
|
size
parent_project_dir
==
0
||
parent_project_dir
==
PR_GetRootDir
project
=
okNotice
[
"Project directory cannot be moved further up"
]
ps
#
relative_root_dir
=
relative_root_dir
+++
"."
project
=
change_root_directory_of_project
relative_root_dir
parent_project_dir
project
ps
=
setProject
project
ps
=
pm_update_project_window
ps
project_directory_down
::
!(
PSt
General
)
->
PSt
General
project_directory_down
ps
#
(
project
,
ps
)
=
getProject
ps
|
not
(
PR_ProjectSet
project
)
=
okNotice
[
"No open project"
]
ps
#
(
project_file_path
,
ps
)
=
getProjectFilePath
ps
project_file_dir
=
RemoveFilename
project_file_path
relative_root_dir
=
PR_GetRelativeRootDir
project
child_project_dir
=
make_project_dir
(
size
relative_root_dir
-1
)
project_file_dir
|
size
relative_root_dir
<=
1
||
child_project_dir
==
PR_GetRootDir
project
=
okNotice
[
"Project directory cannot be moved further down"
]
ps
#
relative_root_dir
=
relative_root_dir
%
(
0
,
size
relative_root_dir
-2
)
project
=
change_root_directory_of_project
relative_root_dir
child_project_dir
project
ps
=
setProject
project
ps
=
pm_update_project_window
ps
doPathsDialog
::
!
String
!
Pathname
!
Pathname
!(
List
Pathname
)
((
List
Pathname
)
(
PSt
.
l
)
->
(
PSt
.
l
))
(
PSt
.
l
)
->
(
PSt
.
l
)
doPathsDialog
titlestring
ap
pp
lo
set
ps
#
(
wid
,
ps
)
=
openId
ps
...
...
Ide/projwin.icl
View file @
bbc8e5a5
...
...
@@ -13,6 +13,7 @@ import ioutil, morecontrols, colorpickcontrol
import
projmen
,
menubar
,
colourclip
//from IDE import OpenModule
import
Platform
,
IdePlatform
import
PmDirCache
,
UtilIO
//-- Project Window Options...
...
...
@@ -475,8 +476,7 @@ pm_update_project_window_interactive ps
Just
ws
->
getControlViewDomain
lbId
.
controlId
ws
#
(
srcpaths
,
ps
)
=
getProjwinPaths
ps
#
(
appPath
,
ps
)
=
getStup
ps
#
(
prjPath
,
ps
)
=
getProjectFilePath
ps
#
prjPath
=
RemoveFilename
prjPath
(
prjPath
,
ps
)
=
getFromProject
PR_GetRootDir
ps
#
lbItems
=
items
srcpaths
appPath
prjPath
modules
prefs
.
prj_prefs
.
proj_shft
#
ps
=
appendExtListBoxItems
lbId
lbItems
ps
#
ps
=
case
mframe
of
...
...
@@ -499,7 +499,6 @@ where
#
mods
=
filter
isInPaths
mods
#
mods
=
sortBy
(\(
a
,
b
,_,_)
(
c
,
d
,_,_)
->
less
a
b
c
d
)
mods
#
moditems
=
makenice
True
""
mods
// # rootitem = (GetModuleName root, OpenModule (MakeImpPathname root) emptySelection, openif root)
#
rootitem
=
(
GetModuleName
root
,
open_imp
rootdir
(
MakeImpPathname
root
),
openif
rootdir
root
)
=
[
rootitem
:
moditems
]
where
...
...
@@ -516,8 +515,8 @@ where
#
(
exists
,
ps
)
=
accFiles
(
FExists
path
)
ps
|
exists
=
ed_open_path_sel
path
emptySelection
ps
#
imppath
=
MakeImpPathname
root
=
open_imp
rootdir
imppath
ps
=
open_imp
rootdir
(
MakeImpPathname
root
)
ps
less
a
b
c
d
|
before
b
d
=
True
// use < -ordening of searchpaths...
|
b
==
d
...
...
@@ -730,9 +729,8 @@ where
|
not
ok
=
ps
#
(
lo
,
ps
)
=
getFromProject
PR_GetLinkOptions
ps
#
(
prj_path
,
ps
)
=
getProject
FilePath
ps
(
prj_path
`
,
ps
)
=
get
From
Project
PR_GetRootDir
ps
#
(
app_path
,
ps
)
=
getStup
ps
#
prj_path`
=
RemoveFilename
prj_path
#
execpath
=
fulPath
app_path
prj_path`
execpath
|
lo
.
method
==
LM_Dynamic
#
execpath
=
(
RemoveSuffix`
execpath
)
+++.
".bat"
...
...
@@ -742,9 +740,8 @@ where
pm_run
::
!*(
PSt
*
General
)
->
*
PSt
*
General
;
pm_run
ps
#
(
app_path
,
ps
)
=
getStup
ps
#
(
prj_path
,
ps
)
=
getProject
FilePath
ps
(
prj_path
`
,
ps
)
=
get
From
Project
PR_GetRootDir
ps
#
(
execpath
,
ps
)
=
getFromProject
PR_GetExecPath
ps
#
prj_path`
=
RemoveFilename
prj_path
#
execpath
=
fulPath
app_path
prj_path`
execpath
#
(
lo
,
ps
)
=
getFromProject
PR_GetLinkOptions
ps
|
lo
.
method
==
LM_Dynamic
...
...
@@ -785,7 +782,7 @@ pm_copt ps
//-> only for module + ide, now added cursel in projwin
// current active added... (need to check if active is part of project...)
#
(
lbId
,
ps
)
=
getPWI
ps
#
(
project
,
ps
)
=
acc
Project
(\
l
->
(
l
,
l
)
)
ps
#
(
project
,
ps
)
=
getFrom
Project
(\
l
->
l
)
ps
#
(
path
,
ps
)
=
sendToActiveWindow
msgGetPathName
ps
|
isJust
path
#
path
=
fromJust
path
...
...
@@ -842,7 +839,6 @@ getActiveModules ps
#
sel
=
map
(
MakeImpPathname
o
fst
)
sel
#
(
sel
,
ps
)
=
seqList
(
map
findModule
sel
)
ps
#
sel
=
[
fromJust
m
\\
m
<-
sel
|
isJust
m
]
// # ps = trace_n` ("Sel",listToString sel) ps
=
(
sel
,
ps
)
=
([],
ps
)
#
winpath
=
fromJust
winpath
...
...
@@ -850,10 +846,8 @@ getActiveModules ps
=
([
winpath
],
ps
)
|
IsDefPathname
winpath
=
([
MakeImpPathname
winpath
],
ps
)
// = trace_n` ("Regular",winpath) ([winpath],ps)
=
([],
ps
)
import
PmDirCache
,
UtilIO
//import dodebug
findModule
::
!.
Modulename
!*(
PSt
General
)
->
(!
Maybe
Pathname
,!*
PSt
General
)
findModule
pathname
ps
#
(
syspaths
,
ps
)
=
getCurrentPaths
ps
...
...
@@ -865,10 +859,8 @@ findModule pathname ps
_
->
srcpaths
#
((
ok
,
fullpath
),
ps
)
=
accFiles
(
SearchDisk
False
pathname
srcpaths
)
ps
|
not
ok
// = trace_n` ("NotFound",pathname,fullpath) (Nothing, ps)
=
(
Nothing
,
ps
)
#
fullpath`
=
GetLongPathName
fullpath
// = trace_n` ("Found",fullpath`) (Just fullpath`, ps)
=
(
Just
fullpath`
,
ps
)
DoProcess
msg
compile
cont
ps
...
...
@@ -878,7 +870,7 @@ DoProcess msg compile cont ps
=
ps
where
init
paths
ps
#
(
project
,
ps
)
=
acc
Project
(\
l
->
(
l
,
l
)
)
ps
#
(
project
,
ps
)
=
getFrom
Project
(\
l
->
l
)
ps
ps
=
ew_safe_close
ps
ps
=
tw_safe_close
ps
=
okcont
paths
project
ps
...
...
@@ -919,14 +911,14 @@ pm_save_copy_as ps
|
isNothing
pn
=
ps
#
pn
=
fromJust
pn
#
(
project
,
ps
)
=
acc
Project
(\
l
->
(
l
,
l
)
)
ps
#
(
project
,
ps
)
=
getFrom
Project
(\
l
->
l
)
ps
#
(
project
,
ps
)
=
pm_save_common
pn
project
ps
#
ps
=
appProject
(
const
project
)
ps
=
ps
pm_save
::
!*(
PSt
*
General
)
->
*
PSt
*
General
pm_save
ps
#
(
project
,
ps
)
=
acc
Project
(\
l
->
(
l
,
l
)
)
ps
#
(
project
,
ps
)
=
getFrom
Project
(\
l
->
l
)
ps
(
pathname
,
ps
)
=
getProjectFilePath
ps
#
(
project
,
ps
)
=
pm_save_common
pathname
project
ps
#
project
=
PR_SetSaved
project
...
...
@@ -976,8 +968,6 @@ isProjWin win ps
#
(
wId
,
ps
)
=
getPWW
ps
=
(
wId
==
win
,
ps
)
//////////////////////////////////////
extKeyboard
=
ControlKeyboard
keyFilter
Able
keyboard
keyFilter
::
KeyboardState
->
Bool
...
...
@@ -1001,7 +991,7 @@ keyboard (CharKey '+' (KeyDown False)) ((lbState=:{tMargin,listboxId,selection,i
|
not
hasSelection
=
((
lbState
,
ls
),
ps
)
#
(
appPath
,
ps
)
=
getStup
ps
#
(
prjPath
,
ps
)
=
getProject
FilePath
ps
(
prjPath
,
ps
)
=
get
From
Project
PR_GetRootDir
ps
#
ps
=
updFstate`
(
map
(\(
p
,
b
)->
(
fulPath
appPath
prjPath
p
,
b
))
selItems
)
ps
#
ps
=
pm_update_project_window_interactive
ps
=
((
lbState
,
ls
),
ps
)
...
...
@@ -1017,7 +1007,7 @@ keyboard (CharKey '-' (KeyDown False)) ((lbState=:{tMargin,listboxId,selection,i
|
not
hasSelection
=
((
lbState
,
ls
),
ps
)
#
(
appPath
,
ps
)
=
getStup
ps
#
(
prjPath
,
ps
)
=
getProject
FilePath
ps
(
prjPath
,
ps
)
=
get
From
Project
PR_GetRootDir
ps
#
ps
=
updFstate`
(
map
(\(
p
,
b
)->
(
fulPath
appPath
prjPath
p
,
b
))
selItems
)
ps
#
ps
=
pm_update_project_window_interactive
ps
=
((
lbState
,
ls
),
ps
)
...
...
Ide/targetui.icl
View file @
bbc8e5a5
...
...
@@ -389,7 +389,7 @@ buttonWidth = ContentWidth "Append..."
editTargets
getTs
setTs
ps
#
(
ap
,
ps
)
=
getStup
ps
#
(
pp
,
ps
)
=
getProject
FilePath
ps
#
(
pp
,
ps
)
=
get
From
Project
PR_GetRootDir
ps
#
pp
=
RemoveFilename
pp
#
(
ts
,
ps
)
=
getTs
ps
#
(
ct
,
ps
)
=
getCurrentTarget
ps
...
...
@@ -897,8 +897,6 @@ remObject (ls=:{tg,ap,pp,lbobjId},ps)
ps
=
setExtListBoxSelection
lbobjId
[]
ps
=
(
ls
,
ps
)
//--
setCheckControlMarks
ids
full
io
=
seq
[
setCheckControlMark
full
id
\\
id
<-
ids
]
io
setCheckControlMark
full
id
io
...
...
@@ -906,8 +904,6 @@ setCheckControlMark full id io
True
->
markCheckControlItems
id
[
1
]
io
False
->
unmarkCheckControlItems
id
[
1
]
io
//--
FullPath
True
_
_
p
=
p
FullPath
False
ap
pp
l
=
symPath
ap
pp
l
...
...
Pm/PmFiles.dcl
View file @
bbc8e5a5
...
...
@@ -29,6 +29,7 @@ ProjectFileVersion :== "1.4"
,
pg_target
::
String
// specify used environment
,
pg_execpath
::
String
// move to ApplicationOptions
,
pg_dynamic
::
!
ProjectDynamicInfo
,
pg_root_directory
::
!
String
,
pg_precompile
::
!
Maybe
String
// experiment: move to LinkOptions
,
pg_postlink
::
!
Maybe
String
// experiment: move to LinkOptions
}
...
...
Pm/PmFiles.icl
View file @
bbc8e5a5
...
...
@@ -22,6 +22,7 @@ ProjectFileVersion :== "1.4"
,
pg_target
::
String
,
pg_execpath
::
String
,
pg_dynamic
::
!
ProjectDynamicInfo
,
pg_root_directory
::
!
String
,
pg_precompile
::
!
Maybe
String
,
pg_postlink
::
!
Maybe
String
}
...
...
@@ -68,16 +69,16 @@ EmptyUndefModule =
,
path
=
""
}
//--
project_root_option
=
SimpleOption
"ProjectRoot"
(\
a
->
a
.
pg_root_directory
)
(\
v
a
->{
a
&
pg_root_directory
=
v
})
ProjectGlobalOptionsTable
::
OptionsTable
ProjectGlobalOptions
ProjectGlobalOptionsTable
=
{
SimpleOption
"Built"
(\
a
->
a
.
pg_built
)
(\
v
a
->{
a
&
pg_built
=
v
})
{
project_root_option
,
SimpleOption
"Built"
(\
a
->
a
.
pg_built
)
(\
v
a
->{
a
&
pg_built
=
v
})
,
SimpleOption
"Target"
(\
a
->
a
.
pg_target
)
(\
v
a
->{
a
&
pg_target
=
v
})
,
SimpleWithStringConversionOption
convert_exec_path_separators_and_extension
"Exec"
(\
a
->
a
.
pg_execpath
)
(\
v
a
->{
a
&
pg_execpath
=
v
})
,
GroupedOption
"CodeGen"
CodeGenOptionsTable
(\
a
->
a
.
pg_codegen
)
(\
v
a
->{
a
&
pg_codegen
=
v
})
,
GroupedOption
"Application"
ApplicationOptionsTable
(\
a
->
a
.
pg_application
)
(\
v
a
->{
a
&
pg_application
=
v
})
// , GroupedOption "Project" ProjectOptionsTable (\a->a.pg_projectOptions) (\v a->{a & pg_projectOptions=v})
,
GroupedOption
"Link"
LinkOptionsTable
(\
a
->
a
.
pg_link
)
(\
v
a
->{
a
&
pg_link
=
v
})
,
ListOption
"Paths"
PathName
""
(\
a
->
a
.
pg_projectPaths
)
(\
v
a
->{
a
&
pg_projectPaths
=
v
})
,
GroupedOption
"Static"
StaticLibsInfoTable
(\
a
->
a
.
pg_staticLibInfo
)
(\
v
a
->{
a
&
pg_staticLibInfo
=
v
})
...
...
@@ -147,7 +148,6 @@ where
, showsync = True
*/
}
CompilerOptionsTable
::
OptionsTable
CompilerOptions
CompilerOptionsTable
=
{
...
...
@@ -211,13 +211,6 @@ ApplicationOptionsTable =
GroupedOption
"Profile"
ApplicationProfiletOptionsTable
id
const
,
GroupedOption
"Output"
ApplicationOutputOptionsTable
id
const
}
/*
ProjectOptionsTable :: OptionsTable ProjectOptions
ProjectOptionsTable =
{
SimpleOption "Verbose" (\a->a.ProjectOptions.verbose) (\v a->{ProjectOptions | a & verbose=v})
}
*/
PathName
::
OptionsTableEntry
{#
Char
}
PathName
...
...
Pm/PmProject.dcl
View file @
bbc8e5a5
...
...
@@ -22,12 +22,13 @@ SaveProjectFile ::
(
!
Bool
// success
,
!*
Files
// returned filesystem
);
ReadProjectFile
::
!
String
// path to projectfile
!
String
// the application directory
!*
Files
// the filesystem environment
->
((!
Project
// the project
(
!
(!
Project
// the project
,
!
Bool
// success: true if successful except when failed to close
// project file. Then success is true but errmsg (next entry)
// is nonempty.
...
...
@@ -35,6 +36,8 @@ ReadProjectFile ::
),!*
Files
// returned filesystem
)
change_root_directory_of_project
::
!{#
Char
}
!{#
Char
}
!
Project
->
Project
getDynamicInfo
::
!
Project
->
(
ProjectDynamicInfo
,
Project
)
setDynamicInfo
::
!.
ProjectDynamicInfo
!.
Project
->
.
Project
...
...
@@ -64,6 +67,8 @@ PR_GetPaths :: !Project -> List String
PR_GetRootModuleName
::
!
Project
->
String
PR_GetRootPathName
::
!
Project
->
(!
String
,!
Project
)
PR_GetRootModuleDir
::
!
Project
->
String
PR_GetRootDir
::
!
Project
->
String
PR_GetRelativeRootDir
::
!
Project
->
String
PR_GetModulenames
::
!
Bool
!
Def_and_Imp
!
Project
->
(
List
String
,
Project
)
PR_GetOpenModulenames
::
!
Project
->
List
String
PR_GetModuleStuff
::
!
Project
->
List
(
Modulename
,
String
,
Modulename
,
String
)
...
...
@@ -110,3 +115,5 @@ PR_SetPrecompile :: !(Maybe String) !Project -> Project
PR_GetPrecompile
::
!
Project
->
(!
Maybe
String
,
!
Project
)
PR_SetPostlink
::
!(
Maybe
String
)
!
Project
->
Project
PR_GetPostlink
::
!
Project
->
(!
Maybe
String
,
!
Project
)
make_project_dir
::
!
Int
!{#
Char
}
->
{#
Char
}
Pm/PmProject.icl
View file @
bbc8e5a5
...
...
@@ -38,6 +38,8 @@ Unmodified :== False;
,
dynamic_info
::
!
ProjectDynamicInfo
,
relative_root_directory
::
!
String
// string of '.'s, relative to .prj file
,
root_directory
::
!
String
,
execpath
::
!
String
// move to app_opts
,
prec
::
!
Maybe
String
// " (precompile command)
,
posl
::
!
Maybe
String
// " (postlink command)
...
...
@@ -71,6 +73,8 @@ PR_InitProject =
,
staticLibInfo
=
DefStaticLibInfo
,
target
=
""
,
dynamic_info
=
EmptyDynamicInfo
,
relative_root_directory
=
"."
,
root_directory
=
""
,
prec
=
Nothing
,
posl
=
Nothing
}
...
...
@@ -123,6 +127,7 @@ PR_NewProject main_module_file_name eo compilerOptions cgo ao prjpaths linkOptio
,
linkOptions
=
linkOptions
,
staticLibInfo
=
DefStaticLibInfo
,
target
=
"StdEnv"
,
root_directory
=
dirname
}
PR_SetBuilt
::
!(
List
Modulename
)
!.
Project
->
.
Project
;
...
...
@@ -389,30 +394,38 @@ PR_GetRootModuleDir {inflist={mn,info={dir}}:!rest}
=
EmptyPathname
;
=
dir
;
PR_GetRootDir
::
!
Project
->
String
PR_GetRootDir
{
root_directory
}
=
root_directory
;
PR_GetRelativeRootDir
::
!
Project
->
String
PR_GetRelativeRootDir
{
relative_root_directory
}
=
relative_root_directory
PR_GetModulenames
::
!
Bool
!
Def_and_Imp
!
Project
->
(
List
String
,
Project
)
PR_GetModulenames
full
def
project
=:{
inflist
}
=
(
modnames
,
project
)
where
(
modnames
,_)
=
P_
MapR
GetModulenames
inflist
modnames
=
MapR
GetModulenames
inflist
GetModulenames
::
!
InfListItem
->
(!
String
,!
Bool
)
GetModulenames
::
!
InfListItem
->
String
GetModulenames
{
mn
,
info
={
dir
}}
|
full
&&
def
=
(
MakeFullPathname
dir
(
MakeDefPathname
mn
)
,
True
)
|
full
=
(
MakeFullPathname
dir
(
MakeImpPathname
mn
)
,
True
)
=
(
mn
,
True
)
|
full
&&
def
=
MakeFullPathname
dir
(
MakeDefPathname
mn
)
|
full
=
MakeFullPathname
dir
(
MakeImpPathname
mn
)
=
mn
PR_GetOpenModulenames
::
!
Project
->
List
String
PR_GetOpenModulenames
project
=:{
inflist
}
=
FlattenList
modnames
where
(
modnames
,_)
=
P_
MapR
GetModulenames
inflist
GetModulenames
::
!
InfListItem
->
(
List
String
,!
Bool
)
modnames
=
MapR
GetModulenames
inflist
GetModulenames
::
!
InfListItem
->
List
String
GetModulenames
{
mn
,
info
={
dir
,
defopen
,
impopen
}}
|
defopen
&&
impopen
=
((
defname
:!
impname
:!
Nil
),
True
)
|
defopen
=
((
defname
:!
Nil
),
True
)
|
impopen
=
((
impname
:!
Nil
),
True
)
=
(
Nil
,
True
)
|
defopen
&&
impopen
=
defname
:!
impname
:!
Nil
|
defopen
=
defname
:!
Nil
|
impopen
=
impname
:!
Nil
=
Nil
where
defname
=
MakeFullPathname
dir
(
MakeDefPathname
mn
)
impname
=
MakeFullPathname
dir
(
MakeImpPathname
mn
)
...
...
@@ -533,9 +546,7 @@ PR_UpdateModules :: ![Modulename] !(ModInfo -> ModInfo) !Project -> Project
PR_UpdateModules
mn
update
project
=
seq
[(
PR_UpdateModule
m
update
)
\\
m
<-
mn
]
project
// DvA quick hack, not very efficient!
//
// Operations on tables
//
UpdateList
::
!
String
InfUpdate
!
InfList
->
(!
InfList
,!
Bool
)
UpdateList
key
update
list
=
UpdateList2
key
update
list
Nil
...
...
@@ -554,50 +565,47 @@ FindInList key Nil = Nothing
FindInList
key
((
itm
=:{
mn
,
info
}):!
rest
)
|
mn
<>
key
=
FindInList
key
rest
=
Just
itm
//--
SetProject
::
!{#
Char
}
!{#
Char
}
!
ProjectGlobalOptions
->
Project
SetProject
applicationDir
projectDir
{
pg_built
,
pg_codegen
,
pg_application
,
pg_projectPaths
,
pg_link
,
pg_mainModuleInfo
={
name
,
info
},
pg_otherModules
,
pg_target
,
pg_staticLibInfo
,
pg_execpath
,
pg_dynamic
,
pg_precompile
,
pg_postlink
SetProject
applicationDir
project_file_dir
{
pg_built
,
pg_codegen
,
pg_application
,
pg_projectPaths
,
pg_link
,
pg_mainModuleInfo
={
name
,
info
},
pg_otherModules
,
pg_target
,
pg_staticLibInfo
,
pg_execpath
,
pg_dynamic
,
pg_root_directory
,
pg_precompile
,
pg_postlink
}
#
paths
=
ExpandPaths
applicationDir
projectDir
pg_projectPaths
#
linkOptions
=
ExpandLinkOptionsPaths
applicationDir
projectDir
pg_link
#
project
=
PR_AddRootModule
pg_built
pg_codegen
pg_application
paths
linkOptions
name
(
ExpandModuleInfoPaths
applicationDir
projectDir
info
)
#
project
=
addModules
pg_otherModules
project
#
staticLibInfo
=
ExpandStaticLibPaths
applicationDir
projectDir
pg_staticLibInfo
#
project_dir
=
make_project_dir
(
size
pg_root_directory
)
project_file_dir
#
paths
=
ExpandPaths
applicationDir
project_dir
pg_projectPaths
#
linkOptions
=
ExpandLinkOptionsPaths
applicationDir
project_dir
pg_link
#
project
=
PR_AddRootModule
pg_built
pg_codegen
pg_application
paths
linkOptions
name
(
ExpandModuleInfoPaths
applicationDir
project_dir
info
)
#
project
=
addModules
pg_otherModules
project_dir
project
#
staticLibInfo
=
ExpandStaticLibPaths
applicationDir
project_dir
pg_staticLibInfo
#
project
=
PR_SetStaticLibsInfo
staticLibInfo
project
#
project
=
PR_SetTarget
pg_target
project
#
exepath
=
ExpandPath
applicationDir
project
D
ir
pg_execpath
#
exepath
=
ExpandPath
applicationDir
project
_d
ir
pg_execpath
#
project
=
PR_SetExecPath
exepath
project
// # project = PR_SetGenDLL pg_generateDLL project
// # project = PR_SetExpDLL pg_exportedDLL project
// default of used appopts in exe are ok isn't right :-(
#
pg_postlink
=
case
pg_postlink
of
Just
post_link
->
Just
(
ExpandPath
applicationDir
project
D
ir
post_link
)
Just
post_link
->
Just
(
ExpandPath
applicationDir
project
_d
ir
post_link
)
Nothing
->
Nothing
#
project
=
{
project
&
dynamic_info
=
pg_dynamic
}
#
project
=
{
project
&
prec
=
pg_precompile
,
posl
=
pg_postlink
}
=
project
=
{
project
&
relative_root_directory
=
pg_root_directory
,
root_directory
=
project_dir
,
dynamic_info
=
pg_dynamic
,
prec
=
pg_precompile
,
posl
=
pg_postlink
}
where
addModules
Nil
project
addModules
Nil
project
_dir
project
=
project
addModules
({
name
,
info
}
:!
t
)
project
=
addModules
t
(
PR_AddModule
name
(
ExpandModuleInfoPaths
applicationDir
projectDir
info
)
project
)
GetProject
::
!{#
Char
}
!{#
Char
}
!
Project
->
ProjectGlobalOptions