Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
C
clean-ide
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
6
Issues
6
List
Boards
Labels
Service Desk
Milestones
Merge Requests
1
Merge Requests
1
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
clean-and-itasks
clean-ide
Commits
bbc8e5a5
Commit
bbc8e5a5
authored
Oct 18, 2010
by
John van Groningen
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
implement Project Directory Up and Down
parent
efa0357e
Changes
9
Hide whitespace changes
Inline
Side-by-side
Showing
9 changed files
with
170 additions
and
138 deletions
+170
-138
Ide/IDE.icl
Ide/IDE.icl
+12
-19
Ide/PmDialogues.dcl
Ide/PmDialogues.dcl
+3
-0
Ide/PmDialogues.icl
Ide/PmDialogues.icl
+40
-9
Ide/projwin.icl
Ide/projwin.icl
+13
-23
Ide/targetui.icl
Ide/targetui.icl
+1
-5
Pm/PmFiles.dcl
Pm/PmFiles.dcl
+1
-0
Pm/PmFiles.icl
Pm/PmFiles.icl
+4
-11
Pm/PmProject.dcl
Pm/PmProject.dcl
+8
-1
Pm/PmProject.icl
Pm/PmProject.icl
+88
-70
No files found.
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
)
=
getProjectFilePath
ps
(
prj_path`
,
ps
)
=
getFromProject
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
)
=
getProjectFilePath
ps
(
prj_path`
,
ps
)
=
getFromProject
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
)
=
accProject
(\
l
->(
l
,
l
)
)
ps
#
(
project
,
ps
)
=
getFromProject
(\
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
)
=
accProject
(\
l
->(
l
,
l
)
)
ps
#
(
project
,
ps
)
=
getFromProject
(\
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
)
=
accProject
(\
l
->(
l
,
l
)
)
ps
#
(
project
,
ps
)
=
getFromProject
(\
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
)
=
accProject
(\
l
->(
l
,
l
)
)
ps
#
(
project
,
ps
)
=
getFromProject
(\
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
)
=
getProjectFilePath
ps
(
prjPath
,
ps
)
=
getFromProject
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
)
=
getProjectFilePath
ps
(
prjPath
,
ps
)
=
getFromProject
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
)
=
getProjectFilePath
ps
#
(
pp
,
ps
)
=
getFromProject
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
GetProject
applicationDir
projectDir
project
#
post_link
=
case
project
.
posl
of
Just
post_link
->
Just
(
SubstitutePath
applicationDir
projectDir
post_link
)
addModules
({
name
,
info
}
:!
t
)
project_dir
project
=
addModules
t
project_dir
(
PR_AddModule
name
(
ExpandModuleInfoPaths
applicationDir
project_dir
info
)
project
)
GetProject
::
!{#
Char
}
!
Project
->
ProjectGlobalOptions
GetProject
applicationDir
project
#
project_dir
=
project
.
root_directory
post_link
=
case
project
.
posl
of
Just
post_link
->
Just
(
SubstitutePath
applicationDir
project_dir
post_link
)
Nothing
->
Nothing
mainModuleInfo
=
getModule
project_dir
mainModuleName
otherModules
=
Map
(
getModule
project_dir
)
(
Filter
((<>)
mainModuleName
)
otherModuleNames
)
linkOptions
=
SubstituteLinkOptionsPaths
applicationDir
project_dir
(
PR_GetLinkOptions
project
)
projectPaths
=
SubstitutePaths
applicationDir
project_dir
(
PR_GetPaths
project
)
staticLibInfo
=
SubstituteStaticLibPaths
applicationDir
project_dir
(
PR_GetStaticLibsInfo
project
)
=
{
pg_built
=
PR_Built
project
,
pg_codegen
=
PR_GetCodeGenOptions
project
,
pg_application
=
PR_GetApplicationOptions
project
...
...
@@ -607,28 +615,26 @@ GetProject applicationDir projectDir project
,
pg_otherModules
=
otherModules
,
pg_staticLibInfo
=
staticLibInfo
,
pg_target
=
target