Skip to content
GitLab
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
e5008729
Commit
e5008729
authored
Oct 11, 2005
by
John van Groningen
Browse files
support error messages of more than one line
parent
f5dd40b7
Changes
3
Hide whitespace changes
Inline
Side-by-side
Ide/errwin.icl
View file @
e5008729
...
...
@@ -38,17 +38,14 @@ where
//--- Error window handling
isErr
Error
=
True
isErr
_
=
False
isWrn
Warning
=
True
isWrn
_
=
False
isInf
Info
=
True
isInf
_
=
False
countnums
[]
nums
=
nums
countnums
[
Error
:
ts
]
(
e
,
w
,
i
)
=
countnums
ts
(
inc
e
,
w
,
i
)
countnums
[
Warning
:
ts
]
(
e
,
w
,
i
)
=
countnums
ts
(
e
,
inc
w
,
i
)
countnums
[
Info
:
ts
]
(
e
,
w
,
i
)
=
countnums
ts
(
e
,
w
,
inc
i
)
countnums
[
message
:
messages
]
(
e
,
w
,
i
)
|
IsErrorMsg
message
=
countnums
(
dropWhile
first_char_is_space
messages
)
(
inc
e
,
w
,
i
)
|
IsWarningMsg
message
=
countnums
messages
(
e
,
inc
w
,
i
)
=
countnums
messages
(
e
,
w
,
inc
i
)
countnums
[]
nums
=
nums
checkWindowExistence
id
io
#
(
st
,
io
)
=
getWindowsStack
io
...
...
@@ -71,9 +68,8 @@ updateErrorWindowInteractive messages ps
True
->
ps
_
->
err_open
errinfo
ps
#!
ps
=
appendFilteredListBoxItems
errinfo
.
infoId
messages
ps
#!
types
=
map
TypeErrorMsg
messages
#!
(
numerr
,
numwrn
,
numinf
)
=
countnums
typ
es
(
errinfo
.
err_count
,
errinfo
.
wrn_count
,
errinfo
.
inf_count
)
=
countnums
messag
es
(
errinfo
.
err_count
,
errinfo
.
wrn_count
,
errinfo
.
inf_count
)
#
err
=
(
errinfo
.
err_countId
,
toString
numerr
)
#
wrn
=
(
errinfo
.
wrn_countId
,
toString
numwrn
)
#
inf
=
(
errinfo
.
inf_countId
,
toString
numinf
)
...
...
@@ -198,17 +194,30 @@ where
#
ps
=
setErrInfo
{
ei
&
inf
=
inf
}
ps
#
ps
=
setFilter
ei
.
infoId
(
makeFilter
err
wrn
inf
)
ps
=
((
err
,
wrn
,
inf
),
ps
)
makeFilter
err
wrn
inf
str
#
msg
=
TypeErrorMsg
str
|
isErr
msg
&&
not
err
=
False
|
isWrn
msg
&&
not
wrn
=
False
|
isInf
msg
&&
not
inf
=
False
=
True
makeFilter
err
wrn
inf
[
str
:
strings
]
|
IsErrorMsg
str
|
err
#
(
error_strings
,
strings
)
=
span
first_char_is_space
strings
=
[
str
:
error_strings
++
makeFilter
err
wrn
inf
strings
]
=
makeFilter
err
wrn
inf
(
dropWhile
first_char_is_space
strings
)
|
IsWarningMsg
str
|
wrn
=
[
str
:
makeFilter
err
wrn
inf
strings
]
=
makeFilter
err
wrn
inf
strings
|
inf
=
[
str
:
makeFilter
err
wrn
inf
strings
]
=
makeFilter
err
wrn
inf
strings
makeFilter
err
wrn
inf
[]
=
[]
err_resize
ih
oc
ow
nw
=
{
w
=
nw
.
w
,
h
=
nw
.
Size
.
h
-
ih
}
inf_resize
oc
ow
nw
=
{
oc
&
w
=
nw
.
w
}
first_char_is_space
s
=
size
s
>
0
&&
s
.[
0
]==
' '
ew_activate
cId
ps
#
({
mn_cut
,
mn_cpy
,
mn_pst
,
mn_clr
,
mg_edt
,
searchIds
},
ps
=:{
io
})
=
getMenuIds
ps
...
...
@@ -563,34 +572,37 @@ err_shut info
}
=
prefs
//
// Extract module name and line number from error message.
//
::
MessageType
=
Error
|
Warning
|
Info
TypeErrorMsg
::
!
String
->
MessageType
TypeErrorMsg
msg
=
type
IsErrorMsg
::
!
String
->
Bool
IsErrorMsg
msg
=
type
where
msglen
=
size
msg
type
|
msglen
>
5
&&
msg
%(
0
,
4
)
==
"Error"
=
True
|
msglen
>
12
&&
msg
%(
0
,
11
)
==
"Syntax error"
=
True
|
msglen
>
11
&&
msg
%(
0
,
10
)
==
"Parse error"
=
True
|
msglen
>
11
&&
msg
%(
0
,
10
)
==
"Check error"
=
True
|
msglen
>
11
&&
msg
%(
0
,
10
)
==
"Check Error"
=
True
|
msglen
>
10
&&
msg
%(
0
,
9
)
==
"Type error"
=
True
|
msglen
>
10
&&
msg
%(
0
,
9
)
==
"Link error"
=
True
|
msglen
>
12
&&
msg
%(
0
,
11
)
==
"Linker error"
=
True
|
msglen
>
16
&&
msg
%(
0
,
15
)
==
"Uniqueness error"
=
True
|
msglen
>
16
&&
msg
%(
0
,
15
)
==
"Undefined symbol"
=
True
|
msglen
>
17
&&
msg
%(
0
,
16
)
==
"Overloading error"
=
True
=
False
IsWarningMsg
::
!
String
->
Bool
IsWarningMsg
msg
=
type
where
msglen
=
size
msg
type
|
msglen
>
5
&&
msg
%(
0
,
4
)
==
"Error"
=
Error
|
msglen
>
12
&&
msg
%(
0
,
11
)
==
"Syntax error"
=
Error
|
msglen
>
11
&&
msg
%(
0
,
10
)
==
"Parse error"
=
Error
|
msglen
>
11
&&
msg
%(
0
,
10
)
==
"Check error"
=
Error
|
msglen
>
11
&&
msg
%(
0
,
10
)
==
"Check Error"
=
Error
|
msglen
>
10
&&
msg
%(
0
,
9
)
==
"Type error"
=
Error
|
msglen
>
10
&&
msg
%(
0
,
9
)
==
"Link error"
=
Error
|
msglen
>
12
&&
msg
%(
0
,
11
)
==
"Linker error"
=
Error
|
msglen
>
16
&&
msg
%(
0
,
15
)
==
"Uniqueness error"
=
Error
|
msglen
>
16
&&
msg
%(
0
,
15
)
==
"Undefined symbol"
=
Error
|
msglen
>
17
&&
msg
%(
0
,
16
)
==
"Overloading error"
=
Error
|
msglen
>
7
&&
msg
%(
0
,
6
)
==
"Warning"
=
Warning
|
msglen
>
12
&&
msg
%(
0
,
11
)
==
"Type warning"
=
Warning
|
msglen
>
13
&&
msg
%(
0
,
12
)
==
"Parse warning"
=
Warning
|
msglen
>
12
&&
msg
%(
0
,
11
)
==
"Link warning"
=
Warning
|
msglen
>
14
&&
msg
%(
0
,
13
)
==
"Linker warning"
=
Warning
=
Info
|
msglen
>
7
&&
msg
%(
0
,
6
)
==
"Warning"
=
True
|
msglen
>
12
&&
msg
%(
0
,
11
)
==
"Type warning"
=
True
|
msglen
>
13
&&
msg
%(
0
,
12
)
==
"Parse warning"
=
True
|
msglen
>
12
&&
msg
%(
0
,
11
)
==
"Link warning"
=
True
|
msglen
>
14
&&
msg
%(
0
,
13
)
==
"Linker warning"
=
True
=
False
//
// Extract module name and line number from error message.
//
ParseErrorMsg
::
!
String
->
(!
Modulename
,
!
Int
);
ParseErrorMsg
msg
...
...
Util/FilteredListBox.dcl
View file @
e5008729
...
...
@@ -26,7 +26,7 @@ flbKeyboard :: ({#Char} -> .(*(PSt .a) -> *PSt .a)) -> .ControlAttribute *((Filt
::
FilteredListBoxState
setFilter
::
!
FilteredListBoxId
(
String
->
Bool
)
!(
PSt
.
l
)
->
PSt
.
l
getFilter
::
!
FilteredListBoxId
!(
PSt
.
l
)
->
(!
String
->
Bool
,
PSt
.
l
)
setFilter
::
!
FilteredListBoxId
(
[
String
]
->
[
String
]
)
!(
PSt
.
l
)
->
PSt
.
l
getFilter
::
!
FilteredListBoxId
!(
PSt
.
l
)
->
(!
[
String
]
->
[
String
]
,
PSt
.
l
)
getFilteredListBoxSelection
::
!
FilteredListBoxId
!(
PSt
.
l
)
->
(!(!
Bool
,![(
String
,!
Index
)]),!
PSt
.
l
)
Util/FilteredListBox.icl
View file @
e5008729
implementation
module
FilteredListBox
import
StdBool
,
StdEnum
,
StdList
,
StdMisc
,
StdOrdList
,
StdTuple
,
StdFunc
import
StdBool
,
StdEnum
,
StdList
,
StdMisc
,
StdOrdList
,
StdTuple
,
StdFunc
,
StdArray
import
StdControl
,
StdControlReceiver
,
StdId
,
StdPicture
,
StdPSt
,
StdReceiver
,
StdWindow
import
StdControlAttribute
import
ioutil
...
...
@@ -14,7 +14,7 @@ from commondef import strictSeq
,
lineHeight
::
!
Int
,
initHeight
::
!
Int
,
pen
::
![
PenAttribute
]
,
ifilter
::
!
{#
Char
}
->
Bool
// the item filter
,
ifilter
::
!
[
String
]
->
[
String
]
// the item filter
,
aitems
::
![
String
]
// all items (unfiltered)
,
domain
::
!
Rectangle
}
...
...
@@ -38,7 +38,7 @@ openFilteredListBoxId env
|
FInCloseAllItems
// Request to remove all current items
|
FInSetPen
[
PenAttribute
]
// Request to set control pen
|
FInGetPen
// Request to get control pen
|
FInSetFilter
(
String
->
Bool
)
|
FInSetFilter
(
[
String
]
->
[
String
]
)
|
FInGetFilter
::
FilteredMessageOut
...
...
@@ -50,7 +50,7 @@ openFilteredListBoxId env
|
FOutSetPen
// Reply to set the control pen
|
FOutGetPen
[
PenAttribute
]
// Reply to get the control pen
|
FOutSetFilter
|
FOutGetFilter
(
String
->
Bool
)
|
FOutGetFilter
(
[
String
]
->
[
String
]
)
::
FilteredListBoxItem
:==
String
...
...
@@ -97,7 +97,7 @@ where
,
lineHeight
=
lineHeight
,
initHeight
=
initHeight
,
pen
=
penAtts
,
ifilter
=
const
True
,
ifilter
=
id
,
aitems
=
items
,
domain
=
domain
}
...
...
@@ -132,7 +132,7 @@ where
receiver
(
FInSetFilter
filt
)
((
listboxState
=:{
pen
,
aitems
},
ls
),
ps
)
#
items
=
filter
filt
aitems
#
items
=
filt
aitems
#
listboxState
=
{
listboxState
&
ifilter
=
filt
,
items
=
items
}
// refresh...
#
(
newDomain
,
ps
)
=
calcControlDomain
pen
items
ps
...
...
@@ -154,31 +154,11 @@ where
receiver
(
FInSetSelection
newSelection
)
((
listboxState
=:{
lineHeight
,
initHeight
},
ls
),
ps
)
#
listboxState
=
{
FilteredListBoxState
|
listboxState
&
selection
=
newSelection
}
#
(
newLook
,
listboxState
)=
customlook
listboxState
#!
ps
=
scrolltosel
ps
#!
ps
=
scroll
_
to
_
sel
ection
newSelection
lineHeight
customId
ps
#!
ps
=
appPIO
(
setControlLooks
[(
customId
,
True
,(
True
,
newLook
))])
ps
=
(
FOutSetSelection
,((
listboxState
,
ls
),
ps
))
where
customId
=
listboxState
.
listboxId
.
fcontrolId
singlesel
=
length
newSelection
==
1
selitem
=
hd
newSelection
scrolltosel
ps
|
not
singlesel
=
ps
#
top
=
(
selitem
-1
)
*
lineHeight
#
bot
=
selitem
*
lineHeight
#
(
wdef
,
ps
)
=
accPIO
(
getParentWindow
customId
)
ps
|
isNothing
wdef
=
ps
#
wdef
=
fromJust
wdef
#
(
exists
,
frame
)
=
getControlViewFrame
customId
wdef
|
not
exists
=
ps
|
isNothing
frame
=
ps
#
frame
=
fromJust
frame
#
delta
=
top
-
frame
.
corner1
.
y
|
delta
<
0
=
appPIO
(
moveControlViewFrame
customId
{
vx
=
0
,
vy
=
delta
})
ps
#
delta
=
bot
-
frame
.
corner2
.
y
|
delta
>
0
=
appPIO
(
moveControlViewFrame
customId
{
vx
=
0
,
vy
=
delta
})
ps
=
ps
// Return the current elements:
...
...
@@ -202,7 +182,7 @@ where
=
(
FOutAppendItems
,((
listboxState
,
ls
),
ps
))
where
customId
=
listboxState
.
listboxId
.
fcontrolId
filteredNewItems
=
filter
ifilter
newItems
filteredNewItems
=
ifilter
newItems
allFilteredItems
=
items
++
filteredNewItems
scrolltoend
dom
=:{
corner2
={
y
=
bot
}}
wdef
...
...
@@ -274,6 +254,26 @@ where
#
height
=
oldHeight
+
nrItems
*(
fontLineHeight
metrics
)
#
newDomain
=
{
corner1
=
zero
,
corner2
={
x
=
maxWidth
,
y
=
height
}}
// calculate new domain...
=
(
newDomain
,
pic
)
scroll_to_selection
newSelection
lineHeight
customId
ps
#
first_item
=
hd
newSelection
#
last_item
=
last
newSelection
#
top
=
(
first_item
-1
)
*
lineHeight
#
bot
=
last_item
*
lineHeight
#
(
wdef
,
ps
)
=
accPIO
(
getParentWindow
customId
)
ps
|
isNothing
wdef
=
ps
#
wdef
=
fromJust
wdef
#
(
exists
,
frame
)
=
getControlViewFrame
customId
wdef
|
not
exists
=
ps
|
isNothing
frame
=
ps
#
frame
=
fromJust
frame
#
delta
=
top
-
frame
.
corner1
.
y
|
delta
<
0
||
(
bot
-
top
)
>
(
frame
.
corner2
.
y
-
frame
.
corner1
.
y
)
=
appPIO
(
moveControlViewFrame
customId
{
vx
=
0
,
vy
=
delta
})
ps
#
delta
=
bot
-
frame
.
corner2
.
y
|
delta
>
0
=
appPIO
(
moveControlViewFrame
customId
{
vx
=
0
,
vy
=
delta
})
ps
=
ps
removeDupAtt
[
x
:
xs
]
=
[
x
:
removeDupAtt
(
filter
(
diff
x
)
xs
)]
where
...
...
@@ -300,12 +300,26 @@ where
|
y
<
min_y
||
y
-
lineHeight
>
max_y
=
(
y
+
lineHeight
,
p
)
=
(
y
+
lineHeight
,
drawAt
{
x
=
0
,
y
=
y
}
line
p
)
#
pict
=
strictSeq
[
drawsel
sel
\\
sel
<-
selection
]
pict
#
pict
=
hilite_selections
selection
pict
=
pict
where
x1
=
newFrame
.
corner1
.
x
x2
=
newFrame
.
corner2
.
x
drawsel
i
=
hilite
{
corner1
={
x
=
x1
,
y
=(
i
-1
)*
lineHeight
},
corner2
={
x
=
x2
,
y
=
i
*
lineHeight
-1
}}
hilite_selections
[
selection
:
selections
]
pict
#
(
last_line_n
,
selections
)
=
determine_last_line_of_rectangle
selection
selections
#
pict
=
drawsel
selection
last_line_n
pict
=
hilite_selections
selections
pict
with
determine_last_line_of_rectangle
line_n
[
next_line_n
:
next_lines
]
|
next_line_n
==
line_n
+1
=
determine_last_line_of_rectangle
next_line_n
next_lines
determine_last_line_of_rectangle
line_n
lines
=
(
line_n
,
lines
)
hilite_selections
[]
pict
=
pict
;
drawsel
i
j
=
hilite
{
corner1
={
x
=
x1
,
y
=(
i
-1
)*
lineHeight
},
corner2
={
x
=
x2
,
y
=
j
*
lineHeight
-1
}}
//--
...
...
@@ -317,7 +331,7 @@ flbKeyboard efun = ControlKeyboard keyFilter Able (keyboard efun)
keyFilter
::
KeyboardState
->
Bool
keyFilter
(
SpecialKey
_
(
KeyDown
_)
_)
=
True
keyFilter
_
=
False
keyFilter
_
=
False
keyboard
efun
(
SpecialKey
key
(
KeyDown
repeat
)
{
shiftDown
,
controlDown
})
((
lbState
=:{
selection
,
items
,
lineHeight
},
ls
),
ps
)
|
key
==
enterKey
...
...
@@ -336,11 +350,11 @@ keyboard efun (SpecialKey key (KeyDown repeat) {shiftDown,controlDown}) ((lbStat
// if shift - extend selection one up
// if control ...
// if control-shift ...
#
newSelection
=
if
hasSelection
(
max
1
(
lastSelection
-
1
)
)
1
#
lbState
=
{
lbState
&
selection
=
[
newSelection
]
}
#
newSelection
=
if
hasSelection
[
max
1
(
lastSelection
-
1
)
]
[
1
]
#
lbState
=
{
lbState
&
selection
=
newSelection
}
#
(
newLook
,
lbState
)
=
customlook
lbState
#
ps
=
scrolltoselection
True
newSelection
ps
#
ps
=
scroll
_
to
_
selection
newSelection
lineHeight
customId
ps
#
ps
=
appPIO
(
setControlLooks
[(
customId
,
True
,(
True
,
newLook
))])
ps
=
((
lbState
,
ls
),
ps
)
|
key
==
downKey
...
...
@@ -348,11 +362,11 @@ keyboard efun (SpecialKey key (KeyDown repeat) {shiftDown,controlDown}) ((lbStat
// if shift - extend selection one up
// if control ...
// if control-shift ...
#
newSelection
=
if
hasSelection
(
min
nrItems
(
lastSelection
+
1
))
nrItems
#
lbState
=
{
lbState
&
selection
=
[
newSelection
]
}
#
newSelection
=
[
if
hasSelection
(
min
nrItems
(
lastSelection
+
1
))
nrItems
]
#
lbState
=
{
lbState
&
selection
=
newSelection
}
#
(
newLook
,
lbState
)
=
customlook
lbState
#
ps
=
scrolltoselection
True
newSelection
ps
#
ps
=
scroll
_
to
_
selection
newSelection
lineHeight
customId
ps
#
ps
=
appPIO
(
setControlLooks
[(
customId
,
True
,(
True
,
newLook
))])
ps
=
((
lbState
,
ls
),
ps
)
|
key
==
beginKey
...
...
@@ -360,11 +374,11 @@ keyboard efun (SpecialKey key (KeyDown repeat) {shiftDown,controlDown}) ((lbStat
// if shift - extend selection one up
// if control ...
// if control-shift ...
#
newSelection
=
1
#
lbState
=
{
lbState
&
selection
=
[
newSelection
]
}
#
newSelection
=
[
1
]
#
lbState
=
{
lbState
&
selection
=
newSelection
}
#
(
newLook
,
lbState
)
=
customlook
lbState
#
ps
=
scrolltoselection
True
newSelection
ps
#
ps
=
scroll
_
to
_
selection
newSelection
lineHeight
customId
ps
#
ps
=
appPIO
(
setControlLooks
[(
customId
,
True
,(
True
,
newLook
))])
ps
=
((
lbState
,
ls
),
ps
)
|
key
==
endKey
...
...
@@ -372,11 +386,11 @@ keyboard efun (SpecialKey key (KeyDown repeat) {shiftDown,controlDown}) ((lbStat
// if shift - extend selection one up
// if control ...
// if control-shift ...
#
newSelection
=
nrItems
#
lbState
=
{
lbState
&
selection
=
[
newSelection
]
}
#
newSelection
=
[
nrItems
]
#
lbState
=
{
lbState
&
selection
=
newSelection
}
#
(
newLook
,
lbState
)
=
customlook
lbState
#
ps
=
scrolltoselection
True
newSelection
ps
#
ps
=
scroll
_
to
_
selection
newSelection
lineHeight
customId
ps
#
ps
=
appPIO
(
setControlLooks
[(
customId
,
True
,(
True
,
newLook
))])
ps
=
((
lbState
,
ls
),
ps
)
#
(
wstate
,
ps
)
=
accPIO
(
getParentWindow
customId
)
ps
...
...
@@ -398,14 +412,14 @@ keyboard efun (SpecialKey key (KeyDown repeat) {shiftDown,controlDown}) ((lbStat
#
top
=
(
lastSelection
-2
)
*
lineHeight
#
newSelection
=
if
hasSelection
(
if
(
top
<=
frame
.
corner1
.
y
)
//topLine
(
max
1
(
lastSelection
-
linesOnPage
)
)
(
2
+
(
frame
.
corner1
.
y
/
lineHeight
)
)
//topOfPage
[
max
1
(
lastSelection
-
linesOnPage
)
]
[
2
+
(
frame
.
corner1
.
y
/
lineHeight
)
]
//topOfPage
)
1
#
lbState
=
{
lbState
&
selection
=
[
newSelection
]
}
[
1
]
#
lbState
=
{
lbState
&
selection
=
newSelection
}
#
(
newLook
,
lbState
)
=
customlook
lbState
#
ps
=
scrolltoselection
True
newSelection
ps
#
ps
=
scroll
_
to
_
selection
newSelection
lineHeight
customId
ps
#
ps
=
appPIO
(
setControlLooks
[(
customId
,
True
,(
True
,
newLook
))])
ps
=
((
lbState
,
ls
),
ps
)
|
key
==
pgDownKey
...
...
@@ -416,14 +430,14 @@ keyboard efun (SpecialKey key (KeyDown repeat) {shiftDown,controlDown}) ((lbStat
#
bot
=
(
inc
lastSelection
)
*
lineHeight
#
newSelection
=
if
hasSelection
(
if
(
bot
>=
frame
.
corner2
.
y
)
//bottomLine
(
min
nrItems
(
lastSelection
+
linesOnPage
)
)
(
frame
.
corner2
.
y
/
lineHeight
)
//bottomOfPage
[
min
nrItems
(
lastSelection
+
linesOnPage
)
]
[
frame
.
corner2
.
y
/
lineHeight
]
//bottomOfPage
)
nrItems
#
lbState
=
{
lbState
&
selection
=
[
newSelection
]
}
[
nrItems
]
#
lbState
=
{
lbState
&
selection
=
newSelection
}
#
(
newLook
,
lbState
)
=
customlook
lbState
#
ps
=
scrolltoselection
True
newSelection
ps
#
ps
=
scroll
_
to
_
selection
newSelection
lineHeight
customId
ps
#
ps
=
appPIO
(
setControlLooks
[(
customId
,
True
,(
True
,
newLook
))])
ps
=
((
lbState
,
ls
),
ps
)
=
((
lbState
,
ls
),
ps
)
...
...
@@ -434,24 +448,6 @@ where
|
isEmpty
selection
=
False
=
True
lastSelection
=
hd
selection
scrolltoselection
singlesel
selitem
ps
|
not
singlesel
=
ps
#
top
=
(
selitem
-1
)
*
lineHeight
#
bot
=
selitem
*
lineHeight
#
(
wdef
,
ps
)
=
accPIO
(
getParentWindow
customId
)
ps
|
isNothing
wdef
=
ps
#
wdef
=
fromJust
wdef
#
(
exists
,
frame
)
=
getControlViewFrame
customId
wdef
|
not
exists
=
ps
|
isNothing
frame
=
ps
#
frame
=
fromJust
frame
#
delta
=
top
-
frame
.
corner1
.
y
|
delta
<
0
=
appPIO
(
moveControlViewFrame
customId
{
vx
=
0
,
vy
=
delta
})
ps
#
delta
=
bot
-
frame
.
corner2
.
y
|
delta
>
0
=
appPIO
(
moveControlViewFrame
customId
{
vx
=
0
,
vy
=
delta
})
ps
=
ps
keyboard
_
_
_
=
abort
"FilteredListBox: unsupported keyboard action"
// The mouse responds only to MouseDowns:
...
...
@@ -478,12 +474,12 @@ where
newSelection
|
shiftDown
|
hasSelection
=
remove
Dup
[
newIndex
:
listSelection
++
s
election
]
=
remove
Members
selection
listSelection
++
listS
election
=
[
newIndex
]
|
controlDown
|
isMember
newIndex
selection
=
removeMember
s
selection
[
newIndex
]
=
[
newIndex
:
selection
]
=
removeMember
newIndex
selection
=
selection
++[
newIndex
]
=
[
newIndex
]
okSelection
=
filter
(
isBetween
1
nrItems
)
newSelection
customId
=
listboxState
.
listboxId
.
fcontrolId
...
...
@@ -547,17 +543,17 @@ setFilteredListBoxPen :: !FilteredListBoxId ![PenAttribute] !(PSt .l) -> PSt .l
setFilteredListBoxPen
{
freceiverId
}
pen
ps
=
snd
(
syncSend2
freceiverId
(
FInSetPen
pen
)
ps
)
setFilter
::
!
FilteredListBoxId
(
String
->
Bool
)
!(
PSt
.
l
)
->
PSt
.
l
setFilter
::
!
FilteredListBoxId
(
[
String
]
->
[
String
]
)
!(
PSt
.
l
)
->
PSt
.
l
setFilter
{
freceiverId
}
flt
ps
=
snd
(
syncSend2
freceiverId
(
FInSetFilter
flt
)
ps
)
getFilter
::
!
FilteredListBoxId
!(
PSt
.
l
)
->
(!
String
->
Bool
,
PSt
.
l
)
getFilter
::
!
FilteredListBoxId
!(
PSt
.
l
)
->
(!
[
String
]
->
[
String
]
,
PSt
.
l
)
getFilter
{
freceiverId
}
ps
#
((_,
out
),
ps
)
=
(
syncSend2
freceiverId
(
FInGetFilter
)
ps
)
|
isNothing
out
=
(
const
True
,
ps
)
|
isNothing
out
=
(
id
,
ps
)
#
out
=
case
(
fromJust
out
)
of
(
FOutGetFilter
filt
)
->
filt
_
->
const
True
_
->
id
=
(
out
,
ps
)
exec_next_filtered
::
!
Bool
!
FilteredListBoxId
(
String
(
PSt
.
l
)
->
(
PSt
.
l
))
!(
PSt
.
l
)
->
(
PSt
.
l
)
...
...
@@ -566,29 +562,56 @@ exec_next_filtered next lbId efun ps
|
not
ok
=
ps
#
((
ok
,
lst
),
ps
)
=
getFilteredListBoxItems
lbId
ps
|
not
ok
=
ps
|
length
lst
==
0
=
ps
#
idx
=
(
if
(
isEmpty
sel
)
(
firsti
)
(
nexti
(
snd
(
hd
sel
))
lst
))
#
ps
=
setFilteredListBoxSelection
lbId
[
idx
]
ps
#
l
=
length
lst
|
l
==
0
=
ps
#
selected_line_numbers
=
if
(
isEmpty
sel
)
(
lines_from
1
lst
l
)
(
next_selected_line_numbers
(
snd
(
hd
sel
))
lst
l
)
#
ps
=
setFilteredListBoxSelection
lbId
selected_line_numbers
ps
#
((
ok
,
sel
),
ps
)
=
getFilteredListBoxSelection
lbId
ps
|
not
ok
=
ps
|
isEmpty
sel
=
ps
#
path
=
fst
(
hd
sel
)
=
efun
path
ps
where
firsti
=
1
nexti
idx
lst
#
idx
=
fun
idx
#
idx
=
normalise
idx
1
l
l
=
idx
where
l
=
length
lst
fun
|
next
=
inc
=
dec
normalise
num
min
max
incr
|
num
<
min
=
normalise
(
num
+
incr
)
min
max
incr
|
num
>
max
=
normalise
(
num
-
incr
)
min
max
incr
=
num
next_selected_line_numbers
line_n
lst
l
|
next
#
line_n
=
inc
line_n
|
line_n
>
l
=
lines_from
1
lst
l
=
next_if_string_begins_with_space
line_n
lst
l
#
line_n
=
dec
line_n
|
line_n
<
1
=
move_up_while_string_begins_with_space
l
lst
l
=
next_if_string_begins_with_space
line_n
lst
l
next_if_string_begins_with_space
line_n
lst
l
#
s
=
lst
!!(
line_n
-1
)
|
size
s
>
0
&&
s
.[
0
]==
' '
=
next_selected_line_numbers
line_n
lst
l
=
lines_from
line_n
lst
l
move_up_while_string_begins_with_space
line_n
lst
l
|
line_n
==
1
=
lines_from
1
lst
l
#
s
=
lst
!!(
line_n
-1
)
|
size
s
>
0
&&
s
.[
0
]==
' '
=
move_up_while_string_begins_with_space
(
dec
line_n
)
lst
l
=
lines_from
line_n
lst
l
lines_from
line_n
lst
l
#
s
=
lst
!!(
line_n
-1
)
|
size
s
>
0
&&
s
.[
0
]==
' '
=
[
line_n
]
=
[
line_n
:
lines_beginning_with_space
(
line_n
+1
)
lst
l
]
lines_beginning_with_space
line_n
lst
l
|
line_n
>
l
=
[]
#
s
=
lst
!!(
line_n
-1
)
|
size
s
>
0
&&
s
.[
0
]==
' '
=
[
line_n
:
lines_beginning_with_space
(
line_n
+1
)
lst
l
]
=
[]
// Auxiliary functions:
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment