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
Show whitespace changes
Inline
Side-by-side
Ide/IDE.icl
View file @
bbc8e5a5
...
@@ -10,13 +10,13 @@ import PmParse
...
@@ -10,13 +10,13 @@ import PmParse
import
PmPath
import
PmPath
from
EdKeyMapping
import
macKeyMapping
,
ReadKeyMapFile
,
KeyMapFileName
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_find
,
sr_find_next
,
sr_find_sel
,
sr_rep_find
,
sr_goto_cursor
,
from
finder
import
sr_goto_line
,
sr_goto_selection
sr_goto_line
,
sr_goto_selection
from
edoptions
import
defaultFontAndTabs
,
optionsKeyMapping
,
editColours
from
edoptions
import
defaultFontAndTabs
,
optionsKeyMapping
,
editColours
from
EdClient
import
::
EditAction
,
isEditWin
,
msgGetPathName
,
msgSelectAll
from
EdClient
import
::
EditAction
,
isEditWin
,
msgGetPathName
,
msgSelectAll
,
from
EdClient
import
emptySelection
,
sendToActiveWindow
,
msgGetSelection
emptySelection
,
sendToActiveWindow
,
msgGetSelection
,
from
EdClient
import
msgUndo
,
msgPaste
,
msgCopy
,
msgCut
,
msgClear
,
msgBalance
,
msgDetab
msgUndo
,
msgPaste
,
msgCopy
,
msgCut
,
msgClear
,
msgBalance
,
msgDetab
import
prefix
,
tools
import
prefix
,
tools
import
IdeState
import
IdeState
...
@@ -88,25 +88,16 @@ Start world
...
@@ -88,25 +88,16 @@ Start world
}
}
#
(
interact
,
force_update
,
proj_path
,
logfile
,
world
)
#
(
interact
,
force_update
,
proj_path
,
logfile
,
world
)
=
batchOptions
world
=
batchOptions
world
#!
(
iniClip
,
pub
,
world
)
=
iniGeneral
#!
(
iniClip
,
pub
,
world
)
=
iniGeneral
prefs
stup
interact
logfile
prefs
mTargetId
eTargetId
lbId
stup
interact
logfile
mTargetId
eTargetId
lbId
(
initEditorState
keymap
)
(
initEditorState
keymap
)
emptyFindInfo
emptyFindInfo
ffind
ffind
mEdUndoId
mMdEdOptId
mEdUndoId
mMdEdOptId
iniTwi
iniTwi
// winOnly?
// winOnly?
iniCons
iniCons
iniTargets
iniTargets
mProjectId
mProjectId
mPrListId
mPrRecId
mPrListId
mPrRecId
world
world
#
patt
=
[
ProcessClose
(
Quit
prefspath
)
#
patt
=
[
ProcessClose
(
Quit
prefspath
)
,
ProcessOpenFiles
openfiles
,
ProcessOpenFiles
openfiles
...
@@ -467,6 +458,8 @@ projectMenu
...
@@ -467,6 +458,8 @@ projectMenu
,
MenuId
(
projIds
!!
12
)
,
MenuId
(
projIds
!!
12
)
,
MenuSelectState
Unable
,
MenuSelectState
Unable
]
]
:+:
MenuItem
"Project Directory Up"
[
MenuFunction
(
noLS
project_directory_up
)]
:+:
MenuItem
"Project Directory Down"
[
MenuFunction
(
noLS
project_directory_down
)]
:+:
MenuItem
"Project Defaults..."
:+:
MenuItem
"Project Defaults..."
[
MenuFunction
(
noLS
projectDefaults
)
[
MenuFunction
(
noLS
projectDefaults
)
]
]
...
...
Ide/PmDialogues.dcl
View file @
bbc8e5a5
...
@@ -6,6 +6,9 @@ import PmTypes, PmProject, IdeState
...
@@ -6,6 +6,9 @@ import PmTypes, PmProject, IdeState
projectOptions
::
!(
PSt
General
)
->
PSt
General
projectOptions
::
!(
PSt
General
)
->
PSt
General
projectDefaults
::
!(
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
doPathsDialog
::
// Display a Paths dialogue
!
String
// Dialogue title string
!
String
// Dialogue title string
!
Pathname
// Application path
!
Pathname
// Application path
...
...
Ide/PmDialogues.icl
View file @
bbc8e5a5
...
@@ -5,8 +5,8 @@ import StdFileSelect,StdPStClass,StdWindow
...
@@ -5,8 +5,8 @@ import StdFileSelect,StdPStClass,StdWindow
import
PmTypes
,
PmProject
,
PmPath
,
UtilStrictLists
import
PmTypes
,
PmProject
,
PmPath
,
UtilStrictLists
import
tabcontrol
,
ExtListBox
,
ioutil
,
IdeState
import
tabcontrol
,
ExtListBox
,
ioutil
,
IdeState
import
ExtNotice
,
UtilObjectIO
import
ExtNotice
,
UtilObjectIO
import
Platform
,
morecontrols
import
Platform
,
morecontrols
from
projwin
import
pm_update_project_window
::
PO_LS
=
::
PO_LS
=
{
ao
::
!
ApplicationOptions
{
ao
::
!
ApplicationOptions
...
@@ -40,8 +40,7 @@ projectDialog actualProject ps`
...
@@ -40,8 +40,7 @@ projectDialog actualProject ps`
#(
dp
,
ps
)
=
getCurrentPaths
ps
#(
dp
,
ps
)
=
getCurrentPaths
ps
#
prj
=
PR_SetPaths
False
dp
ret
.
paths
prj
#
prj
=
PR_SetPaths
False
dp
ret
.
paths
prj
#
(
appPath
,
ps
)
=
getStup
ps
#
(
appPath
,
ps
)
=
getStup
ps
#
(
prjPath
,
ps
)
=
getProjectFilePath
ps
#
prjPath
=
PR_GetRootDir
prj
#
prjPath
=
RemoveFilename
prjPath
#
prj
=
PR_SetExecPath
ret
.
xp
prj
#
prj
=
PR_SetExecPath
ret
.
xp
prj
#
prj
=
PR_SetStaticLibsInfo
ret
.
sl
prj
#
prj
=
PR_SetStaticLibsInfo
ret
.
sl
prj
#
(
xxId
,
ps
)
=
getPWX
ps
#
(
xxId
,
ps
)
=
getPWX
ps
...
@@ -83,15 +82,16 @@ where
...
@@ -83,15 +82,16 @@ where
(
lbdlibId
,
ps4
)
=
openExtListBoxId
ps3
(
lbdlibId
,
ps4
)
=
openExtListBoxId
ps3
(
lbslibId
,
ps5
)
=
openExtListBoxId
ps4
(
lbslibId
,
ps5
)
=
openExtListBoxId
ps4
(
ap
,
ps6
)
=
getStup
ps5
(
ap
,
ps6
)
=
getStup
ps5
(
pp
,
ps7
)
=
fix
(
getProjectFilePath
ps6
)
where
fix
(
l
,
r
)
=
(
RemoveFilename
l
,
r
)
pp
=
PR_GetRootDir
project
(
prefs
,
ps
)
=
PlatformDependant
(
prefs
,
ps
)
=
PlatformDependant
(
getPrefs
ps
7
)
// Win
(
getPrefs
ps
6
)
// Win
(
getPrefs
ps9
)
// Mac
(
getPrefs
ps9
)
// Mac
// mac only...
// mac only...
(
fontNames`
,
ps8
)
(
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) = seqList (map (\f->accPIO (accScreenPicture (lisFixedWidth f))) fontNames`) ps8
(
fixed
,
ps9
)
=
accPIO
(
accScreenPicture
(
seqList
(
map
lisFixedWidth
fontNames`
)))
ps8
(
fixed
,
ps9
)
=
accPIO
(
accScreenPicture
(
seqList
(
map
lisFixedWidth
fontNames`
)))
ps8
fontNames
=
lfilter
fixed
fontNames`
fontNames
=
lfilter
fixed
fontNames`
fontSizes
=
[
7
,
8
,
9
,
10
,
12
,
14
,
18
,
24
]
fontSizes
=
[
7
,
8
,
9
,
10
,
12
,
14
,
18
,
24
]
inifn
=
ao
.
fn
inifn
=
ao
.
fn
...
@@ -170,7 +170,7 @@ where
...
@@ -170,7 +170,7 @@ where
setexe
(
ls
,
ps
)
setexe
(
ls
,
ps
)
#
(
prjPath
,
ps
)
=
getProjectFilePath
ps
#
(
prjPath
,
ps
)
=
getProjectFilePath
ps
#
prjName
=
RemoveSuffix
(
RemovePath
prjPath
)
#
prjName
=
RemoveSuffix
(
RemovePath
prjPath
)
#
prjPath
=
RemoveFilename
prjPath
#
prjPath
=
pp
#
(
exename
,
ps
)
=
PlatformDependant
#
(
exename
,
ps
)
=
PlatformDependant
(
selectOutputFile`
"Executable"
"*.exe"
"Set"
ps
)
// win
(
selectOutputFile`
"Executable"
"*.exe"
"Set"
ps
)
// win
(
selectOutputFile
"Executable"
prjName
ps
)
// mac
(
selectOutputFile
"Executable"
prjName
ps
)
// mac
...
@@ -395,8 +395,7 @@ where
...
@@ -395,8 +395,7 @@ where
make_sym_path
name
ps
make_sym_path
name
ps
#
(
appPath
,
ps
)
=
getStup
ps
#
(
appPath
,
ps
)
=
getStup
ps
#
(
prjPath
,
ps
)
=
getProjectFilePath
ps
prjPath
=
pp
#
prjPath
=
RemoveFilename
prjPath
=
(
symPath
appPath
prjPath
name
,
ps
)
=
(
symPath
appPath
prjPath
name
,
ps
)
objectsPane
=
Pane
"Extra Objects"
objectsPane
=
Pane
"Extra Objects"
...
@@ -645,6 +644,38 @@ setCheckControlMark full id io
...
@@ -645,6 +644,38 @@ setCheckControlMark full id io
True
->
markCheckControlItems
id
[
1
]
io
True
->
markCheckControlItems
id
[
1
]
io
False
->
unmarkCheckControlItems
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
::
!
String
!
Pathname
!
Pathname
!(
List
Pathname
)
((
List
Pathname
)
(
PSt
.
l
)
->
(
PSt
.
l
))
(
PSt
.
l
)
->
(
PSt
.
l
)
doPathsDialog
titlestring
ap
pp
lo
set
ps
doPathsDialog
titlestring
ap
pp
lo
set
ps
#
(
wid
,
ps
)
=
openId
ps
#
(
wid
,
ps
)
=
openId
ps
...
...
Ide/projwin.icl
View file @
bbc8e5a5
...
@@ -13,6 +13,7 @@ import ioutil, morecontrols, colorpickcontrol
...
@@ -13,6 +13,7 @@ import ioutil, morecontrols, colorpickcontrol
import
projmen
,
menubar
,
colourclip
import
projmen
,
menubar
,
colourclip
//from IDE import OpenModule
//from IDE import OpenModule
import
Platform
,
IdePlatform
import
Platform
,
IdePlatform
import
PmDirCache
,
UtilIO
//-- Project Window Options...
//-- Project Window Options...
...
@@ -475,8 +476,7 @@ pm_update_project_window_interactive ps
...
@@ -475,8 +476,7 @@ pm_update_project_window_interactive ps
Just
ws
->
getControlViewDomain
lbId
.
controlId
ws
Just
ws
->
getControlViewDomain
lbId
.
controlId
ws
#
(
srcpaths
,
ps
)
=
getProjwinPaths
ps
#
(
srcpaths
,
ps
)
=
getProjwinPaths
ps
#
(
appPath
,
ps
)
=
getStup
ps
#
(
appPath
,
ps
)
=
getStup
ps
#
(
prjPath
,
ps
)
=
getProjectFilePath
ps
(
prjPath
,
ps
)
=
getFromProject
PR_GetRootDir
ps
#
prjPath
=
RemoveFilename
prjPath
#
lbItems
=
items
srcpaths
appPath
prjPath
modules
prefs
.
prj_prefs
.
proj_shft
#
lbItems
=
items
srcpaths
appPath
prjPath
modules
prefs
.
prj_prefs
.
proj_shft
#
ps
=
appendExtListBoxItems
lbId
lbItems
ps
#
ps
=
appendExtListBoxItems
lbId
lbItems
ps
#
ps
=
case
mframe
of
#
ps
=
case
mframe
of
...
@@ -499,7 +499,6 @@ where
...
@@ -499,7 +499,6 @@ where
#
mods
=
filter
isInPaths
mods
#
mods
=
filter
isInPaths
mods
#
mods
=
sortBy
(\(
a
,
b
,_,_)
(
c
,
d
,_,_)
->
less
a
b
c
d
)
mods
#
mods
=
sortBy
(\(
a
,
b
,_,_)
(
c
,
d
,_,_)
->
less
a
b
c
d
)
mods
#
moditems
=
makenice
True
""
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
=
(
GetModuleName
root
,
open_imp
rootdir
(
MakeImpPathname
root
),
openif
rootdir
root
)
=
[
rootitem
:
moditems
]
=
[
rootitem
:
moditems
]
where
where
...
@@ -516,8 +515,8 @@ where
...
@@ -516,8 +515,8 @@ where
#
(
exists
,
ps
)
=
accFiles
(
FExists
path
)
ps
#
(
exists
,
ps
)
=
accFiles
(
FExists
path
)
ps
|
exists
|
exists
=
ed_open_path_sel
path
emptySelection
ps
=
ed_open_path_sel
path
emptySelection
ps
#
imppath
=
MakeImpPathname
root
=
open_imp
rootdir
(
MakeImpPathname
root
)
ps
=
open_imp
rootdir
imppath
ps
less
a
b
c
d
less
a
b
c
d
|
before
b
d
=
True
// use < -ordening of searchpaths...
|
before
b
d
=
True
// use < -ordening of searchpaths...
|
b
==
d
|
b
==
d
...
@@ -730,9 +729,8 @@ where
...
@@ -730,9 +729,8 @@ where
|
not
ok
|
not
ok
=
ps
=
ps
#
(
lo
,
ps
)
=
getFromProject
PR_GetLinkOptions
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
#
(
app_path
,
ps
)
=
getStup
ps
#
prj_path`
=
RemoveFilename
prj_path
#
execpath
=
fulPath
app_path
prj_path`
execpath
#
execpath
=
fulPath
app_path
prj_path`
execpath
|
lo
.
method
==
LM_Dynamic
|
lo
.
method
==
LM_Dynamic
#
execpath
=
(
RemoveSuffix`
execpath
)
+++.
".bat"
#
execpath
=
(
RemoveSuffix`
execpath
)
+++.
".bat"
...
@@ -742,9 +740,8 @@ where
...
@@ -742,9 +740,8 @@ where
pm_run
::
!*(
PSt
*
General
)
->
*
PSt
*
General
;
pm_run
::
!*(
PSt
*
General
)
->
*
PSt
*
General
;
pm_run
ps
pm_run
ps
#
(
app_path
,
ps
)
=
getStup
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
#
(
execpath
,
ps
)
=
getFromProject
PR_GetExecPath
ps
#
prj_path`
=
RemoveFilename
prj_path
#
execpath
=
fulPath
app_path
prj_path`
execpath
#
execpath
=
fulPath
app_path
prj_path`
execpath
#
(
lo
,
ps
)
=
getFromProject
PR_GetLinkOptions
ps
#
(
lo
,
ps
)
=
getFromProject
PR_GetLinkOptions
ps
|
lo
.
method
==
LM_Dynamic
|
lo
.
method
==
LM_Dynamic
...
@@ -785,7 +782,7 @@ pm_copt ps
...
@@ -785,7 +782,7 @@ pm_copt ps
//-> only for module + ide, now added cursel in projwin
//-> only for module + ide, now added cursel in projwin
// current active added... (need to check if active is part of project...)
// current active added... (need to check if active is part of project...)
#
(
lbId
,
ps
)
=
getPWI
ps
#
(
lbId
,
ps
)
=
getPWI
ps
#
(
project
,
ps
)
=
acc
Project
(\
l
->
(
l
,
l
)
)
ps
#
(
project
,
ps
)
=
getFrom
Project
(\
l
->
l
)
ps
#
(
path
,
ps
)
=
sendToActiveWindow
msgGetPathName
ps
#
(
path
,
ps
)
=
sendToActiveWindow
msgGetPathName
ps
|
isJust
path
|
isJust
path
#
path
=
fromJust
path
#
path
=
fromJust
path
...
@@ -842,7 +839,6 @@ getActiveModules ps
...
@@ -842,7 +839,6 @@ getActiveModules ps
#
sel
=
map
(
MakeImpPathname
o
fst
)
sel
#
sel
=
map
(
MakeImpPathname
o
fst
)
sel
#
(
sel
,
ps
)
=
seqList
(
map
findModule
sel
)
ps
#
(
sel
,
ps
)
=
seqList
(
map
findModule
sel
)
ps
#
sel
=
[
fromJust
m
\\
m
<-
sel
|
isJust
m
]
#
sel
=
[
fromJust
m
\\
m
<-
sel
|
isJust
m
]
// # ps = trace_n` ("Sel",listToString sel) ps
=
(
sel
,
ps
)
=
(
sel
,
ps
)
=
([],
ps
)
=
([],
ps
)
#
winpath
=
fromJust
winpath
#
winpath
=
fromJust
winpath
...
@@ -850,10 +846,8 @@ getActiveModules ps
...
@@ -850,10 +846,8 @@ getActiveModules ps
=
([
winpath
],
ps
)
=
([
winpath
],
ps
)
|
IsDefPathname
winpath
|
IsDefPathname
winpath
=
([
MakeImpPathname
winpath
],
ps
)
=
([
MakeImpPathname
winpath
],
ps
)
// = trace_n` ("Regular",winpath) ([winpath],ps)
=
([],
ps
)
=
([],
ps
)
import
PmDirCache
,
UtilIO
//import dodebug
findModule
::
!.
Modulename
!*(
PSt
General
)
->
(!
Maybe
Pathname
,!*
PSt
General
)
findModule
::
!.
Modulename
!*(
PSt
General
)
->
(!
Maybe
Pathname
,!*
PSt
General
)
findModule
pathname
ps
findModule
pathname
ps
#
(
syspaths
,
ps
)
=
getCurrentPaths
ps
#
(
syspaths
,
ps
)
=
getCurrentPaths
ps
...
@@ -865,10 +859,8 @@ findModule pathname ps
...
@@ -865,10 +859,8 @@ findModule pathname ps
_
->
srcpaths
_
->
srcpaths
#
((
ok
,
fullpath
),
ps
)
=
accFiles
(
SearchDisk
False
pathname
srcpaths
)
ps
#
((
ok
,
fullpath
),
ps
)
=
accFiles
(
SearchDisk
False
pathname
srcpaths
)
ps
|
not
ok
|
not
ok
// = trace_n` ("NotFound",pathname,fullpath) (Nothing, ps)
=
(
Nothing
,
ps
)
=
(
Nothing
,
ps
)
#
fullpath`
=
GetLongPathName
fullpath
#
fullpath`
=
GetLongPathName
fullpath
// = trace_n` ("Found",fullpath`) (Just fullpath`, ps)
=
(
Just
fullpath`
,
ps
)
=
(
Just
fullpath`
,
ps
)
DoProcess
msg
compile
cont
ps
DoProcess
msg
compile
cont
ps
...
@@ -878,7 +870,7 @@ DoProcess msg compile cont ps
...
@@ -878,7 +870,7 @@ DoProcess msg compile cont ps
=
ps
=
ps
where
where
init
paths
ps
init
paths
ps
#
(
project
,
ps
)
=
acc
Project
(\
l
->
(
l
,
l
)
)
ps
#
(
project
,
ps
)
=
getFrom
Project
(\
l
->
l
)
ps
ps
=
ew_safe_close
ps
ps
=
ew_safe_close
ps
ps
=
tw_safe_close
ps
ps
=
tw_safe_close
ps
=
okcont
paths
project
ps
=
okcont
paths
project
ps
...
@@ -919,14 +911,14 @@ pm_save_copy_as ps
...
@@ -919,14 +911,14 @@ pm_save_copy_as ps
|
isNothing
pn
|
isNothing
pn
=
ps
=
ps
#
pn
=
fromJust
pn
#
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
#
(
project
,
ps
)
=
pm_save_common
pn
project
ps
#
ps
=
appProject
(
const
project
)
ps
#
ps
=
appProject
(
const
project
)
ps
=
ps
=
ps
pm_save
::
!*(
PSt
*
General
)
->
*
PSt
*
General
pm_save
::
!*(
PSt
*
General
)
->
*
PSt
*
General
pm_save
ps
pm_save
ps
#
(
project
,
ps
)
=
acc
Project
(\
l
->
(
l
,
l
)
)
ps
#
(
project
,
ps
)
=
getFrom
Project
(\
l
->
l
)
ps
(
pathname
,
ps
)
=
getProjectFilePath
ps
(
pathname
,
ps
)
=
getProjectFilePath
ps
#
(
project
,
ps
)
=
pm_save_common
pathname
project
ps
#
(
project
,
ps
)
=
pm_save_common
pathname
project
ps
#
project
=
PR_SetSaved
project
#
project
=
PR_SetSaved
project
...
@@ -976,8 +968,6 @@ isProjWin win ps
...
@@ -976,8 +968,6 @@ isProjWin win ps
#
(
wId
,
ps
)
=
getPWW
ps
#
(
wId
,
ps
)
=
getPWW
ps
=
(
wId
==
win
,
ps
)
=
(
wId
==
win
,
ps
)
//////////////////////////////////////
extKeyboard
=
ControlKeyboard
keyFilter
Able
keyboard
extKeyboard
=
ControlKeyboard
keyFilter
Able
keyboard
keyFilter
::
KeyboardState
->
Bool
keyFilter
::
KeyboardState
->
Bool
...
@@ -1001,7 +991,7 @@ keyboard (CharKey '+' (KeyDown False)) ((lbState=:{tMargin,listboxId,selection,i
...
@@ -1001,7 +991,7 @@ keyboard (CharKey '+' (KeyDown False)) ((lbState=:{tMargin,listboxId,selection,i
|
not
hasSelection
|
not
hasSelection
=
((
lbState
,
ls
),
ps
)
=
((
lbState
,
ls
),
ps
)
#
(
appPath
,
ps
)
=
getStup
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
=
updFstate`
(
map
(\(
p
,
b
)->
(
fulPath
appPath
prjPath
p
,
b
))
selItems
)
ps
#
ps
=
pm_update_project_window_interactive
ps
#
ps
=
pm_update_project_window_interactive
ps
=
((
lbState
,
ls
),
ps
)
=
((
lbState
,
ls
),
ps
)
...
@@ -1017,7 +1007,7 @@ keyboard (CharKey '-' (KeyDown False)) ((lbState=:{tMargin,listboxId,selection,i
...
@@ -1017,7 +1007,7 @@ keyboard (CharKey '-' (KeyDown False)) ((lbState=:{tMargin,listboxId,selection,i
|
not
hasSelection
|
not
hasSelection
=
((
lbState
,
ls
),
ps
)
=
((
lbState
,
ls
),
ps
)
#
(
appPath
,
ps
)
=
getStup
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
=
updFstate`
(
map
(\(
p
,
b
)->
(
fulPath
appPath
prjPath
p
,
b
))
selItems
)
ps
#
ps
=
pm_update_project_window_interactive
ps
#
ps
=
pm_update_project_window_interactive
ps
=
((
lbState
,
ls
),
ps
)
=
((
lbState
,
ls
),
ps
)
...
...
Ide/targetui.icl
View file @
bbc8e5a5
...
@@ -389,7 +389,7 @@ buttonWidth = ContentWidth "Append..."
...
@@ -389,7 +389,7 @@ buttonWidth = ContentWidth "Append..."
editTargets
getTs
setTs
ps
editTargets
getTs
setTs
ps
#
(
ap
,
ps
)
=
getStup
ps
#
(
ap
,
ps
)
=
getStup
ps
#
(
pp
,
ps
)
=
getProject
FilePath
ps
#
(
pp
,
ps
)
=
get
From
Project
PR_GetRootDir
ps
#
pp
=
RemoveFilename
pp
#
pp
=
RemoveFilename
pp
#
(
ts
,
ps
)
=
getTs
ps
#
(
ts
,
ps
)
=
getTs
ps
#
(
ct
,
ps
)
=
getCurrentTarget
ps
#
(
ct
,
ps
)
=
getCurrentTarget
ps
...
@@ -897,8 +897,6 @@ remObject (ls=:{tg,ap,pp,lbobjId},ps)
...
@@ -897,8 +897,6 @@ remObject (ls=:{tg,ap,pp,lbobjId},ps)
ps
=
setExtListBoxSelection
lbobjId
[]
ps
ps
=
setExtListBoxSelection
lbobjId
[]
ps
=
(
ls
,
ps
)
=
(
ls
,
ps
)
//--
setCheckControlMarks
ids
full
io
setCheckControlMarks
ids
full
io
=
seq
[
setCheckControlMark
full
id
\\
id
<-
ids
]
io
=
seq
[
setCheckControlMark
full
id
\\
id
<-
ids
]
io
setCheckControlMark
full
id
io
setCheckControlMark
full
id
io
...
@@ -906,8 +904,6 @@ setCheckControlMark full id io
...
@@ -906,8 +904,6 @@ setCheckControlMark full id io
True
->
markCheckControlItems
id
[
1
]
io
True
->
markCheckControlItems
id
[
1
]
io
False
->
unmarkCheckControlItems
id
[
1
]
io
False
->
unmarkCheckControlItems
id
[
1
]
io
//--
FullPath
True
_
_
p
=
p
FullPath
True
_
_
p
=
p
FullPath
False
ap
pp
l
=
symPath
ap
pp
l
FullPath
False
ap
pp
l
=
symPath
ap
pp
l
...
...
Pm/PmFiles.dcl
View file @
bbc8e5a5
...
@@ -29,6 +29,7 @@ ProjectFileVersion :== "1.4"
...
@@ -29,6 +29,7 @@ ProjectFileVersion :== "1.4"
,
pg_target
::
String
// specify used environment
,
pg_target
::
String
// specify used environment
,
pg_execpath
::
String
// move to ApplicationOptions
,
pg_execpath
::
String
// move to ApplicationOptions
,
pg_dynamic
::
!
ProjectDynamicInfo
,
pg_dynamic
::
!
ProjectDynamicInfo
,
pg_root_directory
::
!
String
,
pg_precompile
::
!
Maybe
String
// experiment: move to LinkOptions
,
pg_precompile
::
!
Maybe
String
// experiment: move to LinkOptions
,
pg_postlink
::
!
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"
...
@@ -22,6 +22,7 @@ ProjectFileVersion :== "1.4"
,
pg_target
::
String
,
pg_target
::
String
,
pg_execpath
::
String
,
pg_execpath
::
String
,
pg_dynamic
::
!
ProjectDynamicInfo
,
pg_dynamic
::
!
ProjectDynamicInfo
,
pg_root_directory
::
!
String
,
pg_precompile
::
!
Maybe
String
,
pg_precompile
::
!
Maybe
String
,
pg_postlink
::
!
Maybe
String
,
pg_postlink
::
!
Maybe
String
}
}
...
@@ -68,16 +69,16 @@ EmptyUndefModule =
...
@@ -68,16 +69,16 @@ EmptyUndefModule =
,
path
=
""
,
path
=
""
}
}
//--
project_root_option
=
SimpleOption
"ProjectRoot"
(\
a
->
a
.
pg_root_directory
)
(\
v
a
->{
a
&
pg_root_directory
=
v
})
ProjectGlobalOptionsTable
::
OptionsTable
ProjectGlobalOptions
ProjectGlobalOptionsTable
::
OptionsTable
ProjectGlobalOptions
ProjectGlobalOptionsTable
=
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
})
,
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
})
,
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
"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
"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
})
,
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
})
,
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
})
,
GroupedOption
"Static"
StaticLibsInfoTable
(\
a
->
a
.
pg_staticLibInfo
)
(\
v
a
->{
a
&
pg_staticLibInfo
=
v
})
...
@@ -147,7 +148,6 @@ where
...
@@ -147,7 +148,6 @@ where
, showsync = True
, showsync = True
*/
}
*/
}
CompilerOptionsTable
::
OptionsTable
CompilerOptions
CompilerOptionsTable
::
OptionsTable
CompilerOptions
CompilerOptionsTable
=
CompilerOptionsTable
=
{
{
...
@@ -211,13 +211,6 @@ ApplicationOptionsTable =
...
@@ -211,13 +211,6 @@ ApplicationOptionsTable =
GroupedOption
"Profile"
ApplicationProfiletOptionsTable
id
const
,
GroupedOption
"Profile"
ApplicationProfiletOptionsTable
id
const
,
GroupedOption
"Output"
ApplicationOutputOptionsTable
id
const
GroupedOption
"Output"
ApplicationOutputOptionsTable
id
const
}
}
/*
ProjectOptionsTable :: OptionsTable ProjectOptions
ProjectOptionsTable =
{
SimpleOption "Verbose" (\a->a.ProjectOptions.verbose) (\v a->{ProjectOptions | a & verbose=v})