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
71ca6921
Commit
71ca6921
authored
Oct 09, 2001
by
Diederik van Arkel
Browse files
More mods from uniqueness experiment
parent
2d67a49a
Changes
22
Show whitespace changes
Inline
Side-by-side
Ide/IDE.icl
View file @
71ca6921
...
...
@@ -831,23 +831,23 @@ recfun (MSet ss) (ls,ps) = (ss,(ss,ps))
editMenu
altgr_workaround
mEditId
editRecId
mFileSaveId
mFileRevertId
{
mn_und
,
mn_cut
,
mn_cpy
,
mn_pst
,
mn_clr
,
mg_edt
,
searchIds
}
iniClip
=
Menu
"&Edit"
(
MenuItem
"&Undo"
[
MenuShortKey
'Z'
,
MenuFunction
(\(
ls
,
ps
)->(
ls
,
ls
.
zfun
ps
))
,
MenuFunction
(\(
ls
=:{
zfun
}
,
ps
)->(
ls
,
zfun
ps
))
,
MenuSelectState
Unable
,
MenuId
mn_und
]
:+:
MenuItem
"Cu&t"
[
MenuShortKey
'X'
,
MenuFunction
(\(
ls
,
ps
)->(
ls
,
ls
.
xfun
ps
))
,
MenuFunction
(\(
ls
=:{
xfun
}
,
ps
)->(
ls
,
xfun
ps
))
,
MenuId
mn_cut
]
:+:
MenuItem
"&Copy"
[
MenuShortKey
'C'
,
MenuFunction
(\(
ls
,
ps
)->(
ls
,
ls
.
cfun
ps
))
,
MenuFunction
(\(
ls
=:{
cfun
}
,
ps
)->(
ls
,
cfun
ps
))
,
MenuId
mn_cpy
]
:+:
MenuItem
"&Paste"
[
MenuShortKey
'V'
,
MenuFunction
(\(
ls
,
ps
)->(
ls
,
ls
.
vfun
ps
))
,
MenuFunction
(\(
ls
=:{
vfun
}
,
ps
)->(
ls
,
vfun
ps
))
,
MenuId
mn_pst
]
:+:
Receiver2
editRecId
recfun
[]
...
...
Ide/PmDialogues.icl
View file @
71ca6921
...
...
@@ -363,11 +363,11 @@ where
ps
=
closeExtListBoxItems
lbobjId
indexsel
ps
ps
=
setExtListBoxSelection
lbobjId
[]
ps
=
((
full
,
tg
),
ps
)
showFullPaths
((
full
,
tg
),
ps
)
showFullPaths
((
full
,
tg
=:{
lo
}
),
ps
)
#
full
=
not
full
ps
=
appPIO
(
setCheckControlMark
full
c2id
)
ps
ps
=
closeAllExtListBoxItems
lbobjId
ps
ps
=
appendExtListBoxItems
lbobjId
(
zip3
(
FullPaths
full
ap
pp
(
StrictListToList
tg
.
lo
.
extraObjectModules
))(
repeat
id
)(
repeat
id
))
ps
ps
=
appendExtListBoxItems
lbobjId
(
zip3
(
FullPaths
full
ap
pp
(
StrictListToList
lo
.
extraObjectModules
))(
repeat
id
)(
repeat
id
))
ps
=
((
full
,
tg
),
ps
)
slibsPane
=
Pane
"Static Libraries"
{
addLS
=
inifull
...
...
@@ -416,11 +416,11 @@ where
ps
=
closeExtListBoxItems
lbslibId
indexsel
ps
ps
=
setExtListBoxSelection
lbslibId
[]
ps
=
((
full
,
tg
),
ps
)
showFullPaths
((
full
,
tg
),
ps
)
showFullPaths
((
full
,
tg
=:{
sl
}
),
ps
)
#
full
=
not
full
ps
=
appPIO
(
setCheckControlMark
full
c3id
)
ps
ps
=
closeAllExtListBoxItems
lbslibId
ps
ps
=
appendExtListBoxItems
lbslibId
(
zip3
(
FullPaths
full
ap
pp
(
StrictListToList
(
SL_Libs
tg
.
sl
)))(
repeat
id
)(
repeat
id
))
ps
ps
=
appendExtListBoxItems
lbslibId
(
zip3
(
FullPaths
full
ap
pp
(
StrictListToList
(
SL_Libs
sl
)))(
repeat
id
)(
repeat
id
))
ps
=
((
full
,
tg
),
ps
)
dlibsPane
=
Pane
"Dynamic Libraries"
{
addLS
=
inifull
...
...
@@ -469,11 +469,11 @@ where
ps
=
closeExtListBoxItems
lbdlibId
indexsel
ps
ps
=
setExtListBoxSelection
lbdlibId
[]
ps
=
((
full
,
tg
),
ps
)
showFullPaths
((
full
,
tg
),
ps
)
showFullPaths
((
full
,
tg
=:{
lo
}
),
ps
)
#
full
=
not
full
ps
=
appPIO
(
setCheckControlMark
full
c4id
)
ps
ps
=
closeAllExtListBoxItems
lbdlibId
ps
ps
=
appendExtListBoxItems
lbdlibId
(
zip3
(
FullPaths
full
ap
pp
(
StrictListToList
tg
.
lo
.
libraries
))(
repeat
id
)(
repeat
id
))
ps
ps
=
appendExtListBoxItems
lbdlibId
(
zip3
(
FullPaths
full
ap
pp
(
StrictListToList
lo
.
libraries
))(
repeat
id
)(
repeat
id
))
ps
=
((
full
,
tg
),
ps
)
pathsPane
ap
pp
paths
lbpadId
c1id
root_path
...
...
@@ -530,11 +530,11 @@ where
ps
=
closeExtListBoxItems
lbpadId
indexsel
ps
ps
=
setExtListBoxSelection
lbpadId
[]
ps
=
((
full
,
tg
),
ps
)
showFullPaths
((
full
,
tg
),
ps
)
showFullPaths
((
full
,
tg
=:{
paths
}
),
ps
)
#
full
=
not
full
ps
=
appPIO
(
setCheckControlMark
full
c1id
)
ps
ps
=
closeAllExtListBoxItems
lbpadId
ps
ps
=
appendExtListBoxItems
lbpadId
(
zip3
(
FullPaths
full
ap
pp
(
StrictListToList
tg
.
paths
))(
repeat
id
)(
repeat
id
))
ps
ps
=
appendExtListBoxItems
lbpadId
(
zip3
(
FullPaths
full
ap
pp
(
StrictListToList
paths
))(
repeat
id
)(
repeat
id
))
ps
=
((
full
,
tg
),
ps
)
setCheckControlMark
full
id
io
...
...
Ide/balance.icl
View file @
71ca6921
...
...
@@ -154,7 +154,7 @@ beforeParse level line bln bcn text
afterParse level line eln ecn text
*/
/*
sl_balance cl string sel_begin sel_end
= inComment
...
...
@@ -215,3 +215,4 @@ where
| i >= m = i
| funnyChar s.[i] = scanFunny (inc i)
= i
*/
\ No newline at end of file
Ide/conswin.icl
View file @
71ca6921
...
...
@@ -473,33 +473,33 @@ where
=
updateCW
win
(
ls
,
closeWindow
dialogId
ps
)
cancelFun
win
wini
dialogId
(
ls
,
ps
)
=
updateCW
win
(
wini
,
closeWindow
dialogId
ps
)
setBoxCol
cb1id
cb2id
cb3id
cb4id
(
ls
=:{
cur
},
ps
)
setBoxCol
cb1id
cb2id
cb3id
cb4id
(
ls
=:{
cur
,
txt
,
cmt
,
mod
,
bck
},
ps
)
#
(
cId
,
col
)
=
case
cur
of
TXT
->
(
cb1id
,
ls
.
CWC_LS
.
txt
)
CMT
->
(
cb2id
,
ls
.
CWC_LS
.
cmt
)
MOD
->
(
cb3id
,
ls
.
CWC_LS
.
mod
)
BCK
->
(
cb4id
,
ls
.
CWC_LS
.
bck
)
TXT
->
(
cb1id
,
txt
)
CMT
->
(
cb2id
,
cmt
)
MOD
->
(
cb3id
,
mod
)
BCK
->
(
cb4id
,
bck
)
#
ps
=
appPIO
(
SetColourBox`
cId
(
toRGBColour
col
))
ps
=
(
ls
,
ps
)
updateCW
win
(
ls
,
ps
)
updateCW
win
(
ls
=:{
txt
,
cmt
,
mod
,
bck
,
fn
,
fs
}
,
ps
)
#
(
twi
,
ps
)
=
accPLoc
getConsWinInfo
ps
#
sync
=
getConSync
twi
#
sync
=
sc_update
ls
sync
#
(
font
,
ps
)
=
safeOpen
{
fName
=
ls
.
CWC_LS
.
fn
,
fSize
=
ls
.
CWC_LS
.
fs
,
fStyles
=
[]}
ps
#
sync
=
sc_update
sync
#
(
font
,
ps
)
=
safeOpen
{
fName
=
fn
,
fSize
=
fs
,
fStyles
=
[]}
ps
#
twi
=
setConSync
sync
twi
#
twi
=
setConFont
font
twi
#
ps
=
appPLoc
(
setConsWinInfo
twi
)
ps
#
(_,
ps
)
=
maybe_cons_win_message2
(
appFontInfo
(
fi_update
ls
)
)
ps
#
(_,
ps
)
=
maybe_cons_win_message2
(
appFontInfo
fi_update
)
ps
#
(_,
ps
)
=
maybe_cons_win_message2
(
setFont
font
)
ps
#
ps
=
appPIO
(
updateWindow
win
Nothing
)
ps
=
(
ls
,
ps
)
where
fi_update
ls
fi
=
fi_update
fi
=
{
fi
&
syntaxColours
=
sc_update
ls
fi
.
syntaxColours
&
syntaxColours
=
sc_update
fi
.
syntaxColours
}
sc_update
{
txt
,
cmt
,
mod
,
bck
}
sc
=
sc_update
sc
=
{
sc
&
textColour
=
txt
,
commentColour
=
cmt
...
...
Ide/edoptions.icl
View file @
71ca6921
...
...
@@ -99,8 +99,9 @@ editColours ps
(
Just
(
0
,
0
))
(
Just
(
0
,
0
))
ps
#
buttonWidth
=
ContentWidth
"Cancel"
#
(
ilook
,
wloc
)
=
idslook
wloc
#
wdef
=
Dialog
"Editor Colours"
(
RGBColourPickControl`
rgbid
(
prefs
.
syncols
.
textColour
)
(
idslook
wloc
)
Nothing
(
RGBColourPickControl`
rgbid
(
prefs
.
syncols
.
textColour
)
ilook
Nothing
:+:
ButtonControl
"&Copy"
[
ControlFunction
(
copyFun
wId
)
,
ControlWidth
buttonWidth
...
...
@@ -176,13 +177,13 @@ editColours ps
#
(_,
ps
)
=
openModalDialog
wloc
wdef
ps
=
ps
where
copyFun
wId
(
ls
,
ps
)
copyFun
wId
(
ls
=:{
cls
,
act
}
,
ps
)
// get active colour control
// and put in clipboard
#
cur
=
ls
.
cls
!!
ls
.
act
#
cur
=
cls
!!
act
#
ps
=
setClipboard
[
toClipboard
(
toString
cur
)]
ps
=
(
ls
,
ps
)
pasteFun
wId
rId
(
ls
,
ps
)
pasteFun
wId
rId
(
ls
=:{
cls
,
act
}
,
ps
)
// get clipboard
// and put in active colour control
#
(
its
,
ps
)
=
getClipboard
ps
...
...
@@ -195,9 +196,10 @@ where
#
it
=
fromJust
(
hd
its
)
|
it
<>
toStringC
(
fromString
it
)
=
(
ls
,
ps
)
#
ls
=
{
ls
&
cls
=
updateAt
ls
.
act
(
fromString
it
)
ls
.
cls
}
#
ls
=
{
ls
&
cls
=
updateAt
act
(
fromString
it
)
cls
}
#
(
ls
,
ps
)
=
setBoxCol
(
ls
,
ps
)
#
ps
=
setColourBoxColour`
rId
(
clslook
ls
)
ps
#
(
clook
,
ls
)=
clslook
ls
#
ps
=
setColourBoxColour`
rId
clook
ps
=
(
ls
,
ps
)
ColourBoxControl``
rgbid
lsid
cls
ids
x
p
=
ColourBoxControl`
(
toRGBColour
(
cls
!!
x
))
(
ids
!!
x
)
(
mstuff
rgbid
lsid
x
)
p
...
...
@@ -209,18 +211,24 @@ where
=
updateActiveInLS
rgbid
lsid
cont
(
ls
,
ps
)
where
cont
(
ls
,
ps
)
#
ps
=
appPIO
(
SetColourBox
(
idslook
ls
)
(
toRGBColour
(
clslook
ls
)))
ps
#
(
ilook
,
ls
)
=
idslook
ls
#
(
clook
,
ls
)
=
clslook
ls
#
ps
=
appPIO
(
SetColourBox
ilook
(
toRGBColour
clook
))
ps
#
ls
=
{
ls
&
act
=
x
}
#
ps
=
appPIO
(
SetColourBox`
(
idslook
ls
)
(
toRGBColour
(
clslook
ls
)))
ps
#
ps
=
setColourBoxId
rgbid
(
idslook
ls
)
ps
#
ps
=
setColourBoxColour`
rgbid
(
clslook
ls
)
ps
#
(
ilook
,
ls
)
=
idslook
ls
#
(
clook
,
ls
)
=
clslook
ls
#
ps
=
appPIO
(
SetColourBox`
ilook
(
toRGBColour
clook
))
ps
#
ps
=
setColourBoxId
rgbid
ilook
ps
#
ps
=
setColourBoxColour`
rgbid
clook
ps
=
(
ls
,
ps
)
setBoxCol
(
ls
,
ps
)
#
ps
=
appPIO
(
SetColourBox`
(
idslook
ls
)
(
toRGBColour
(
clslook
ls
)))
ps
#
(
ilook
,
ls
)
=
idslook
ls
#
(
clook
,
ls
)
=
clslook
ls
#
ps
=
appPIO
(
SetColourBox`
ilook
(
toRGBColour
clook
))
ps
=
(
ls
,
ps
)
idslook
{
ids
,
act
}
=
ids
!!
act
clslook
{
cls
,
act
}
=
cls
!!
act
idslook
ls
=:
{
ids
,
act
}
=
(
ids
!!
act
,
ls
)
clslook
ls
=:
{
cls
,
act
}
=
(
cls
!!
act
,
ls
)
toStringC
::
!
Colour
->
String
toStringC
c
=
toString
c
lsfun
f
(
ls
,
ps
)
=
f
(
ls
,
ps
)
...
...
@@ -234,8 +242,8 @@ where
#
col
=
fromJust
col
#
(_,
ps
)
=
asyncSend
lsid
(
cont2
col
)
ps
=
ps
cont2
col
(
ls
,
ps
)
#
ls
=
{
ls
&
cls
=
updateAt
ls
.
act
col
ls
.
cls
}
cont2
col
(
ls
=:{
act
,
cls
}
,
ps
)
#
ls
=
{
ls
&
cls
=
updateAt
act
col
cls
}
=
cont3
(
ls
,
ps
)
okFun
rgbid
lsid
wId
(
ls
,
ps
)
...
...
@@ -252,37 +260,37 @@ where
applyFun
rgbid
lsid
(
ls
,
ps
)
=
updateActiveInLS
rgbid
lsid
apply
(
ls
,
ps
)
apply
(
ls
,
ps
)
apply
(
ls
=:{
cls
}
,
ps
)
#
(
prefs
,
ps
)
=
getPrefs
ps
#
syncols`
=
{
prefs
.
syncols
&
textColour
=
ls
.
cls
!!
0
,
tabColour
=
ls
.
cls
!!
3
,
commentColour
=
ls
.
cls
!!
6
,
stringColour
=
ls
.
cls
!!
9
,
charColour
=
ls
.
cls
!!
12
,
backgroundColour
=
ls
.
cls
!!
15
,
keywordColour
=
ls
.
cls
!!
18
&
textColour
=
cls
!!
0
,
tabColour
=
cls
!!
3
,
commentColour
=
cls
!!
6
,
stringColour
=
cls
!!
9
,
charColour
=
cls
!!
12
,
backgroundColour
=
cls
!!
15
,
keywordColour
=
cls
!!
18
}
#
defcols`
=
{
prefs
.
defcols
&
textColour
=
ls
.
cls
!!
1
,
tabColour
=
ls
.
cls
!!
4
,
commentColour
=
ls
.
cls
!!
7
,
stringColour
=
ls
.
cls
!!
10
,
charColour
=
ls
.
cls
!!
13
,
backgroundColour
=
ls
.
cls
!!
16
,
keywordColour
=
ls
.
cls
!!
19
&
textColour
=
cls
!!
1
,
tabColour
=
cls
!!
4
,
commentColour
=
cls
!!
7
,
stringColour
=
cls
!!
10
,
charColour
=
cls
!!
13
,
backgroundColour
=
cls
!!
16
,
keywordColour
=
cls
!!
19
}
#
impcols`
=
{
prefs
.
impcols
&
textColour
=
ls
.
cls
!!
2
,
tabColour
=
ls
.
cls
!!
5
,
commentColour
=
ls
.
cls
!!
8
,
stringColour
=
ls
.
cls
!!
11
,
charColour
=
ls
.
cls
!!
14
,
backgroundColour
=
ls
.
cls
!!
17
,
keywordColour
=
ls
.
cls
!!
20
&
textColour
=
cls
!!
2
,
tabColour
=
cls
!!
5
,
commentColour
=
cls
!!
8
,
stringColour
=
cls
!!
11
,
charColour
=
cls
!!
14
,
backgroundColour
=
cls
!!
17
,
keywordColour
=
cls
!!
20
}
#
prefs
=
{
prefs
&
syncols
=
syncols`
,
defcols
=
defcols`
,
impcols
=
impcols`
}
#
ps
=
setPrefs
prefs
ps
...
...
Ide/errwin.icl
View file @
71ca6921
...
...
@@ -439,10 +439,10 @@ where
#
(
ls
,
ps
)
=
setBoxCol
fcid
bcid
(
ls
,
ps
)
#
ps
=
setColourBoxColour`
rgbId
col
ps
=
(
ls
,
ps
)
setBoxCol
fcid
bcid
(
ls
=:{
cur
},
ps
)
setBoxCol
fcid
bcid
(
ls
=:{
cur
,
fc
,
bc
},
ps
)
#
(
cId
,
col
)
=
case
cur
of
TXT
->
(
fcid
,
ls
.
fc
)
BCK
->
(
bcid
,
ls
.
bc
)
TXT
->
(
fcid
,
fc
)
BCK
->
(
bcid
,
bc
)
#
ps
=
appPIO
(
SetColourBox`
cId
(
toRGBColour
col
))
ps
=
(
ls
,
ps
)
mfilter
(
MouseDown
_
_
_)
=
True
...
...
@@ -490,10 +490,10 @@ where
TXT
->
{
ls
&
fc
=
col
,
cur
=
act
}
BCK
->
{
ls
&
bc
=
col
,
cur
=
act
}
=
(
ls
,
ps
)
apply
(
ls
=:{
fc
,
bc
},
ps
)
apply
(
ls
=:{
fc
,
bc
,
fn
,
fs
},
ps
)
#
(
errinf
,
ps
)
=
getErrInfo
ps
#
lbId
=
errinf
.
infoId
#
(
fnt
,
ps
)
=
accScreenPicture
(
safeOpenFixedFont
{
fName
=
ls
.
EWO
.
fn
,
fSize
=
ls
.
EWO
.
fs
,
fStyles
=
[]})
ps
#
(
fnt
,
ps
)
=
accScreenPicture
(
safeOpenFixedFont
{
fName
=
fn
,
fSize
=
fs
,
fStyles
=
[]})
ps
#
pen
=
[
PenFont
fnt
,
PenColour
fc
,
PenBack
bc
]
#
ps
=
setFilteredListBoxPen
lbId
pen
ps
#
errinf
=
{
errinf
&
err_font
=
fnt
,
err_forg
=
fc
,
err_back
=
bc
}
...
...
Ide/projwin.icl
View file @
71ca6921
...
...
@@ -211,11 +211,11 @@ where
FC
->
{
ls
&
fc
=
col
,
cr
=
ac
}
BC
->
{
ls
&
bc
=
col
,
cr
=
ac
}
=
(
ls
,
ps
)
setBoxCol
hcId
fcId
bcId
(
ls
=:{
cr
},
ps
)
setBoxCol
hcId
fcId
bcId
(
ls
=:{
cr
,
hc
,
fc
,
bc
},
ps
)
#
(
cId
,
col
)
=
case
cr
of
HC
->
(
hcId
,
ls
.
hc
)
FC
->
(
fcId
,
ls
.
fc
)
BC
->
(
bcId
,
ls
.
bc
)
HC
->
(
hcId
,
hc
)
FC
->
(
fcId
,
fc
)
BC
->
(
bcId
,
bc
)
#
ps
=
appPIO
(
SetColourBox`
cId
(
toRGBColour
col
))
ps
=
(
ls
,
ps
)
applyFun
rgbid
lsid
(
ls
,
ps
)
...
...
@@ -244,24 +244,24 @@ where
BC
->
{
ls
&
bc
=
col
}
#
(
ls
,
ps
)
=
apply
(
ls
,
ps
)
=
finish
(
ls
,
ps
)
apply
(
ls
,
ps
)
apply
(
ls
=:{
fn
,
fs
,
fc
,
bc
,
hc
,
shift
}
,
ps
)
#
(
lbId
,
ps
)
=
getPWI
ps
#
((
fnt_ok
,
fnt
),
ps
)
=
accScreenPicture
(
openFont
{
fName
=
ls
.
PWO
.
fn
,
fSize
=
ls
.
PWO
.
fs
,
fStyles
=
[]})
ps
#
((
fnt_ok
,
fnt
),
ps
)
=
accScreenPicture
(
openFont
{
fName
=
fn
,
fSize
=
fs
,
fStyles
=
[]})
ps
#
pen2
=
if
fnt_ok
[
PenFont
fnt
]
[]
#
pen
=
[
PenColour
(
ls
.
fc
)
,
PenBack
(
ls
.
bc
)
:
pen2
]
#
pen
=
[
PenColour
fc
,
PenBack
bc
:
pen2
]
#
ps
=
closeAllExtListBoxItems
lbId
ps
#
ps
=
setExtListBoxPen
lbId
pen
ps
#
(
wId
,
ps
)
=
getPWW
ps
#
ps
=
appPIO
(
setWindowLook
wId
True
(
True
,(\_
{
newFrame
}
->
fill
newFrame
o
setPenColour
(
ls
.
hc
)))
)
ps
#
ps
=
appPIO
(
setWindowLook
wId
True
(
True
,(\_
{
newFrame
}
->
fill
newFrame
o
setPenColour
hc
)))
ps
#
(
prefs
,
ps
)
=
getPrefs
ps
#
prefs
=
{
prefs
&
prj_prefs
.
proj_forc
=
ls
.
fc
,
prj_prefs
.
proj_bacc
=
ls
.
bc
,
prj_prefs
.
proj_topc
=
ls
.
hc
,
prj_prefs
.
proj_font
=
{
prefs
.
prj_prefs
.
proj_font
&
fName
=
ls
.
PWO
.
fn
,
fSize
=
ls
.
PWO
.
fs
}
,
prj_prefs
.
proj_shft
=
ls
.
shift
&
prj_prefs
.
proj_forc
=
fc
,
prj_prefs
.
proj_bacc
=
bc
,
prj_prefs
.
proj_topc
=
hc
,
prj_prefs
.
proj_font
=
{
prefs
.
prj_prefs
.
proj_font
&
fName
=
fn
,
fSize
=
fs
}
,
prj_prefs
.
proj_shft
=
shift
}
#
ps
=
setPrefs
prefs
ps
|
not
fnt_ok
...
...
@@ -392,7 +392,7 @@ where
,
ControlPen
pen
,
ControlHMargin
10
10
,
ControlVMargin
3
3
,
ControlMouse
mouseFilter
Able
mouseFunction
//
, ControlMouse mouseFilter Able mouseFunction
]
top_controls
lbId
localId
local2Id
local3Id
xxId
mmId
pw_main
pw_exec
butw
fnt
=
...
...
@@ -653,7 +653,7 @@ pm_copt ps
=
okNotice
[
"This module is not part of the current project."
]
ps
#
minf
=
fromJust
minf
#
projco
=
minf
.
compilerOptions
#
setco
=
\
a
o
->
appProject
(\
l
->
PR_UpdateModule
mod
(\
mi
->{
mi
&
compilerOptions
=
a
o
})
l
)
#
setco
=
\
c
o
->
appProject
(\
l
->
PR_UpdateModule
mod
(\
mi
->{
mi
&
compilerOptions
=
c
o
})
l
)
=
doCompilerOptionsDialog
"Module Options"
projco
setco
ps
// should check if project window is active...
// otherwise this behaviour is unintuitive
...
...
@@ -671,7 +671,7 @@ pm_copt ps
=
ps
#
minf
=
fromJust
minf
#
projco
=
minf
.
compilerOptions
#
setco
=
\
a
o
->
appProject
(\
l
->
PR_UpdateModules
sel
(\
mi
->{
mi
&
compilerOptions
=
a
o
})
l
)
#
setco
=
\
c
o
->
appProject
(\
l
->
PR_UpdateModules
sel
(\
mi
->{
mi
&
compilerOptions
=
c
o
})
l
)
=
doCompilerOptionsDialog
"Module Options"
projco
setco
ps
// work op nothing... ?!
=
ps
...
...
Ide/search.icl
View file @
71ca6921
...
...
@@ -75,7 +75,7 @@ sr_find_idi always_dialog pstate // Find Definition & Implementation & Identifi
#
(
selection
,_)
=
fromJust
maybesel
#
fbi
=
{
fbi
&
cleanid
=
removeDup
[
selection
:
fbi
.
cleanid
],
pathname
=
pathname
}
#
pstate
=
setFBI
fbi
pstate
=
fi_messagebox
fbi
(
sr_find_worker
fbi
)
pstate
=
fi_messagebox
fbi
pstate
sr_find_def
::
!
Bool
!*(
PSt
General
)
->
*
PSt
General
sr_find_def
always_dialog
pstate
...
...
@@ -112,11 +112,11 @@ sr_find_def_imp_sel always_dialog selection pathname info=:{cleanid} pstate
#
pstate
=
setFBI
info
pstate
|
size
selection
==
0
||
not
(
CleanModId
selection
)
||
always_dialog
=
fi_dialog
info
pstate
=
fi_messagebox
info
(
sr_find_worker
info
)
pstate
=
fi_messagebox
info
pstate
//--
fi_messagebox
info
=:{
cleanid
,
dlogId
}
work
pstate
fi_messagebox
info
=:{
cleanid
,
dlogId
,
stringId
,
msgId
,
kind
,
closeId
}
pstate
|
isEmpty
cleanid
=
pstate
#
pstate
=
closeWindow
dlogId
pstate
...
...
@@ -125,41 +125,41 @@ fi_messagebox info=:{cleanid,dlogId} work pstate
=
pstate
where
dialog
=
Dialog
(
case
info
.
kind
of
(
case
kind
of
Definition
->
"Find Definition"
Implementation
->
"Find Implementation"
Identifier
->
"Find Identifier"
)
(
TextControl
""
[
ControlId
info
.
msgId
[
ControlId
msgId
,
ControlWidth
(
PixelWidth
300
)
]
// area to show messages
:+:
TextControl
"Find:"
[
ControlPos
(
Left
,
zero
)
]
:+:
EditControl
(
hd
info
.
cleanid
)
(
PixelWidth
300
)
1
:+:
EditControl
(
hd
cleanid
)
(
PixelWidth
300
)
1
[
ControlPos
(
Left
,
zero
)
,
ControlId
info
.
stringId
,
ControlId
stringId
]
:+:
ButtonControl
"Close"
[
ControlFunction
closefun
,
ControlPos
(
Left
,
zero
)
,
ControlId
info
.
closeId
,
ControlId
closeId
]
)
[
WindowId
info
.
dlogId
,
WindowCancel
info
.
closeId
,
WindowOk
info
.
closeId
[
WindowId
dlogId
,
WindowCancel
closeId
,
WindowOk
closeId
,
WindowClose
closefun
,
WindowInit
(
noLS
work
)
,
WindowInit
sr_find_
work
er
]
closefun
(
ls
,
ps
)
#
ps
=
closeWindow
info
.
dlogId
ps
#
ps
=
closeWindow
dlogId
ps
=
(
ls
,
ps
)
//--
fi_dialog
info
=:{
dlogId
}
pstate
fi_dialog
info
=:{
dlogId
,
msgId
,
stringId
,
cleanid
,
kind
,
type
,
verb
,
export_
,
closeId
,
findId
,
recvId
}
pstate
#
pstate
=
closeWindow
dlogId
pstate
(_,
pstate
)
=
openModalDialog
info
dialog
pstate
=
pstate
...
...
@@ -167,15 +167,15 @@ where
dialog
=
Dialog
"Find..."
(
TextControl
""
[
ControlId
info
.
msgId
[
ControlId
msgId
,
ControlWidth
(
PixelWidth
300
)
]
// area to show messages
:+:
TextControl
"Find:"
[
ControlPos
(
Left
,
zero
)
]
:+:
PopUpControl
[(
ci
,
id
)
\\
ci
<-
info
.
cleanid
]
0
:+:
PopUpControl
[(
ci
,
id
)
\\
ci
<-
cleanid
]
0
[
ControlPos
(
Left
,
zero
)
,
ControlId
info
.
stringId
,
ControlId
stringId
,
ControlKeyboard
filterReturnKeys
Able
(
noLS1
(\_->
stringKey
))
,
ControlDeactivate
(
noLS
stringKey
)
,
ControlWidth
(
PixelWidth
300
)
...
...
@@ -185,7 +185,7 @@ where
,(
"Find Implementation"
,
Nothing
,
noPS
(\
l
->{
l
&
kind
=
Implementation
}))
,(
"Find Identifiers"
,
Nothing
,
noPS
(\
l
->{
l
&
kind
=
Identifier
}))
]
(
Columns
1
)
(
case
info
.
kind
of
(
case
kind
of
Definition
->
1
Implementation
->
2
Identifier
->
3
...
...
@@ -197,7 +197,7 @@ where
,(
"Search in Paths"
,
Nothing
,
noPS
(\
l
->{
l
&
type
=
SearchPaths
}))
,(
"Search in Project"
,
Nothing
,
noPS
(\
l
->{
l
&
type
=
SearchProject
}))
]
(
Columns
1
)
(
case
info
.
type
of
(
case
type
of
SearchImports
->
1
SearchPaths
->
2
SearchProject
->
3
...
...
@@ -205,37 +205,37 @@ where
[
]
:+:
CheckControl
[(
"Be Verbose"
,
Nothing
,
toMark
info
.
verb
,
noPS
(\
l
->{
l
&
verb
=
not
l
.
verb
}))
,(
"Exported Identifiers Only"
,
Nothing
,
toMark
info
.
export_
,
noPS
(\
l
->{
l
&
export_
=
not
l
.
export_
}))
[(
"Be Verbose"
,
Nothing
,
toMark
verb
,
noPS
(\
l
->{
l
&
verb
=
not
l
.
verb
}))
,(
"Exported Identifiers Only"
,
Nothing
,
toMark
export_
,
noPS
(\
l
->{
l
&
export_
=
not
l
.
export_
}))
]
(
Columns
1
)
[
ControlPos
(
Left
,
zero
)
]
:+:
ButtonControl
"Close"
[
ControlFunction
closefun
,
ControlPos
(
Left
,
zero
)
,
ControlId
info
.
closeId
,
ControlId
closeId
]
:+:
ButtonControl
"Find"
[
ControlId
info
.
findId
[
ControlId
findId
,
ControlFunction
findfun
]
:+:
Receiver
info
.
recvId
recvfun
:+:
Receiver
recvId
recvfun
[
]
)
[
WindowId
info
.
dlogId
,
WindowOk
info
.
findId
,
WindowCancel
info
.
closeId
[
WindowId
dlogId
,
WindowOk
findId
,
WindowCancel
closeId
,
WindowClose
closefun
]
stringKey
ps
=:{
io
}
#
(
wst
,
io
)
=
getWindow
info
.
dlogId
io
title
=
fromJust
(
snd
(
hd
(
getControlTexts
[
info
.
stringId
]
(
fromJust
wst
))))
#
io
=
openPopUpControlItems
info
.
stringId
0
[(
title
,
id
)]
io
#
io
=
selectPopUpControlItem
info
.
stringId
0
io
#
(
wst
,
io
)
=
getWindow
dlogId
io
title
=
fromJust
(
snd
(
hd
(
getControlTexts
[
stringId
]
(
fromJust
wst
))))
#
io
=
openPopUpControlItems
stringId
0
[(
title
,
id
)]
io
#
io
=
selectPopUpControlItem
stringId
0
io
=
{
ps
&
io
=
io
}
savefun
(
ls
=:{
dlogId
,
stringId
},
ps
)
savefun
(
ls
=:{
dlogId
,
stringId
,
cleanid
},
ps
)
#
(
wdef
,
ps
)
=
accPIO
(
getWindow
dlogId
)
ps
|
isNothing
wdef
// = trace_n "Fatal error in Find Identifier Dialog: 1" (ls,ps)
...
...
@@ -249,7 +249,7 @@ savefun (ls=:{dlogId,stringId},ps)
// = trace_n "Fatal error in Find Identifier Dialog: 3" (ls,ps)
=
(
ls
,
ps
)
#
ss
=