Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
7
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Open sidebar
clean-and-itasks
clean-ide
Commits
e5008729
Commit
e5008729
authored
Oct 11, 2005
by
John van Groningen
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
support error messages of more than one line
parent
f5dd40b7
Changes
3
Show whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
176 additions
and
141 deletions
+176
-141
Ide/errwin.icl
Ide/errwin.icl
+56
-44
Util/FilteredListBox.dcl
Util/FilteredListBox.dcl
+2
-2
Util/FilteredListBox.icl
Util/FilteredListBox.icl
+118
-95
No files found.
Ide/errwin.icl
View file @
e5008729
...
@@ -38,17 +38,14 @@ where
...
@@ -38,17 +38,14 @@ where
//--- Error window handling
//--- Error window handling
isErr
Error
=
True
countnums
[
message
:
messages
]
(
e
,
w
,
i
)
isErr
_
=
False
|
IsErrorMsg
message
isWrn
Warning
=
True
=
countnums
(
dropWhile
first_char_is_space
messages
)
(
inc
e
,
w
,
i
)
isWrn
_
=
False
|
IsWarningMsg
message
isInf
Info
=
True
=
countnums
messages
(
e
,
inc
w
,
i
)
isInf
_
=
False
=
countnums
messages
(
e
,
w
,
inc
i
)
countnums
[]
nums
countnums
[]
nums
=
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
)
checkWindowExistence
id
io
checkWindowExistence
id
io
#
(
st
,
io
)
=
getWindowsStack
io
#
(
st
,
io
)
=
getWindowsStack
io
...
@@ -71,9 +68,8 @@ updateErrorWindowInteractive messages ps
...
@@ -71,9 +68,8 @@ updateErrorWindowInteractive messages ps
True
->
ps
True
->
ps
_
->
err_open
errinfo
ps
_
->
err_open
errinfo
ps
#!
ps
=
appendFilteredListBoxItems
errinfo
.
infoId
messages
ps
#!
ps
=
appendFilteredListBoxItems
errinfo
.
infoId
messages
ps
#!
types
=
map
TypeErrorMsg
messages
#!
(
numerr
,
numwrn
,
numinf
)
#!
(
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
)
#
err
=
(
errinfo
.
err_countId
,
toString
numerr
)
#
wrn
=
(
errinfo
.
wrn_countId
,
toString
numwrn
)
#
wrn
=
(
errinfo
.
wrn_countId
,
toString
numwrn
)
#
inf
=
(
errinfo
.
inf_countId
,
toString
numinf
)
#
inf
=
(
errinfo
.
inf_countId
,
toString
numinf
)
...
@@ -198,17 +194,30 @@ where
...
@@ -198,17 +194,30 @@ where
#
ps
=
setErrInfo
{
ei
&
inf
=
inf
}
ps
#
ps
=
setErrInfo
{
ei
&
inf
=
inf
}
ps
#
ps
=
setFilter
ei
.
infoId
(
makeFilter
err
wrn
inf
)
ps
#
ps
=
setFilter
ei
.
infoId
(
makeFilter
err
wrn
inf
)
ps
=
((
err
,
wrn
,
inf
),
ps
)
=
((
err
,
wrn
,
inf
),
ps
)
makeFilter
err
wrn
inf
str
#
msg
=
TypeErrorMsg
str
makeFilter
err
wrn
inf
[
str
:
strings
]
|
isErr
msg
&&
not
err
=
False
|
IsErrorMsg
str
|
isWrn
msg
&&
not
wrn
=
False
|
err
|
isInf
msg
&&
not
inf
=
False
#
(
error_strings
,
strings
)
=
span
first_char_is_space
strings
=
True
=
[
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
err_resize
ih
oc
ow
nw
=
{
w
=
nw
.
w
,
h
=
nw
.
Size
.
h
-
ih
}
=
{
w
=
nw
.
w
,
h
=
nw
.
Size
.
h
-
ih
}
inf_resize
oc
ow
nw
inf_resize
oc
ow
nw
=
{
oc
&
w
=
nw
.
w
}
=
{
oc
&
w
=
nw
.
w
}
first_char_is_space
s
=
size
s
>
0
&&
s
.[
0
]==
' '
ew_activate
cId
ps
ew_activate
cId
ps
#
({
mn_cut
,
mn_cpy
,
mn_pst
,
mn_clr
,
mg_edt
,
searchIds
},
ps
=:{
io
})
#
({
mn_cut
,
mn_cpy
,
mn_pst
,
mn_clr
,
mg_edt
,
searchIds
},
ps
=:{
io
})
=
getMenuIds
ps
=
getMenuIds
ps
...
@@ -563,34 +572,37 @@ err_shut info
...
@@ -563,34 +572,37 @@ err_shut info
}
}
=
prefs
=
prefs
//
IsErrorMsg
::
!
String
->
Bool
// Extract module name and line number from error message.
IsErrorMsg
msg
=
type
//
where
msglen
=
size
msg
::
MessageType
=
Error
|
Warning
|
Info
type
|
msglen
>
5
&&
msg
%(
0
,
4
)
==
"Error"
=
True
TypeErrorMsg
::
!
String
->
MessageType
|
msglen
>
12
&&
msg
%(
0
,
11
)
==
"Syntax error"
=
True
TypeErrorMsg
msg
=
type
|
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
where
msglen
=
size
msg
msglen
=
size
msg
type
type
|
msglen
>
5
&&
msg
%(
0
,
4
)
==
"Error"
=
Error
|
msglen
>
7
&&
msg
%(
0
,
6
)
==
"Warning"
=
True
|
msglen
>
12
&&
msg
%(
0
,
11
)
==
"Syntax error"
=
Error
|
msglen
>
12
&&
msg
%(
0
,
11
)
==
"Type warning"
=
True
|
msglen
>
11
&&
msg
%(
0
,
10
)
==
"Parse error"
=
Error
|
msglen
>
13
&&
msg
%(
0
,
12
)
==
"Parse warning"
=
True
|
msglen
>
11
&&
msg
%(
0
,
10
)
==
"Check error"
=
Error
|
msglen
>
12
&&
msg
%(
0
,
11
)
==
"Link warning"
=
True
|
msglen
>
11
&&
msg
%(
0
,
10
)
==
"Check Error"
=
Error
|
msglen
>
14
&&
msg
%(
0
,
13
)
==
"Linker warning"
=
True
|
msglen
>
10
&&
msg
%(
0
,
9
)
==
"Type error"
=
Error
=
False
|
msglen
>
10
&&
msg
%(
0
,
9
)
==
"Link error"
=
Error
//
|
msglen
>
12
&&
msg
%(
0
,
11
)
==
"Linker error"
=
Error
// Extract module name and line number from error message.
|
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
ParseErrorMsg
::
!
String
->
(!
Modulename
,
!
Int
);
ParseErrorMsg
::
!
String
->
(!
Modulename
,
!
Int
);
ParseErrorMsg
msg
ParseErrorMsg
msg
...
...
Util/FilteredListBox.dcl
View file @
e5008729
...
@@ -26,7 +26,7 @@ flbKeyboard :: ({#Char} -> .(*(PSt .a) -> *PSt .a)) -> .ControlAttribute *((Filt
...
@@ -26,7 +26,7 @@ flbKeyboard :: ({#Char} -> .(*(PSt .a) -> *PSt .a)) -> .ControlAttribute *((Filt
::
FilteredListBoxState
::
FilteredListBoxState
setFilter
::
!
FilteredListBoxId
(
String
->
Bool
)
!(
PSt
.
l
)
->
PSt
.
l
setFilter
::
!
FilteredListBoxId
(
[
String
]
->
[
String
]
)
!(
PSt
.
l
)
->
PSt
.
l
getFilter
::
!
FilteredListBoxId
!(
PSt
.
l
)
->
(!
String
->
Bool
,
PSt
.
l
)
getFilter
::
!
FilteredListBoxId
!(
PSt
.
l
)
->
(!
[
String
]
->
[
String
]
,
PSt
.
l
)
getFilteredListBoxSelection
::
!
FilteredListBoxId
!(
PSt
.
l
)
->
(!(!
Bool
,![(
String
,!
Index
)]),!
PSt
.
l
)
getFilteredListBoxSelection
::
!
FilteredListBoxId
!(
PSt
.
l
)
->
(!(!
Bool
,![(
String
,!
Index
)]),!
PSt
.
l
)
Util/FilteredListBox.icl
View file @
e5008729
implementation
module
FilteredListBox
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
StdControl
,
StdControlReceiver
,
StdId
,
StdPicture
,
StdPSt
,
StdReceiver
,
StdWindow
import
StdControlAttribute
import
StdControlAttribute
import
ioutil
import
ioutil
...
@@ -14,7 +14,7 @@ from commondef import strictSeq
...
@@ -14,7 +14,7 @@ from commondef import strictSeq
,
lineHeight
::
!
Int
,
lineHeight
::
!
Int
,
initHeight
::
!
Int
,
initHeight
::
!
Int
,
pen
::
![
PenAttribute
]
,
pen
::
![
PenAttribute
]
,
ifilter
::
!
{#
Char
}
->
Bool
// the item filter
,
ifilter
::
!
[
String
]
->
[
String
]
// the item filter
,
aitems
::
![
String
]
// all items (unfiltered)
,
aitems
::
![
String
]
// all items (unfiltered)
,
domain
::
!
Rectangle
,
domain
::
!
Rectangle
}
}
...
@@ -38,7 +38,7 @@ openFilteredListBoxId env
...
@@ -38,7 +38,7 @@ openFilteredListBoxId env
|
FInCloseAllItems
// Request to remove all current items
|
FInCloseAllItems
// Request to remove all current items
|
FInSetPen
[
PenAttribute
]
// Request to set control pen
|
FInSetPen
[
PenAttribute
]
// Request to set control pen
|
FInGetPen
// Request to get control pen
|
FInGetPen
// Request to get control pen
|
FInSetFilter
(
String
->
Bool
)
|
FInSetFilter
(
[
String
]
->
[
String
]
)
|
FInGetFilter
|
FInGetFilter
::
FilteredMessageOut
::
FilteredMessageOut
...
@@ -50,7 +50,7 @@ openFilteredListBoxId env
...
@@ -50,7 +50,7 @@ openFilteredListBoxId env
|
FOutSetPen
// Reply to set the control pen
|
FOutSetPen
// Reply to set the control pen
|
FOutGetPen
[
PenAttribute
]
// Reply to get the control pen
|
FOutGetPen
[
PenAttribute
]
// Reply to get the control pen
|
FOutSetFilter
|
FOutSetFilter
|
FOutGetFilter
(
String
->
Bool
)
|
FOutGetFilter
(
[
String
]
->
[
String
]
)
::
FilteredListBoxItem
:==
String
::
FilteredListBoxItem
:==
String
...
@@ -97,7 +97,7 @@ where
...
@@ -97,7 +97,7 @@ where
,
lineHeight
=
lineHeight
,
lineHeight
=
lineHeight
,
initHeight
=
initHeight
,
initHeight
=
initHeight
,
pen
=
penAtts
,
pen
=
penAtts
,
ifilter
=
const
True
,
ifilter
=
id
,
aitems
=
items
,
aitems
=
items
,
domain
=
domain
,
domain
=
domain
}
}
...
@@ -132,7 +132,7 @@ where
...
@@ -132,7 +132,7 @@ where
receiver
(
FInSetFilter
filt
)
((
listboxState
=:{
pen
,
aitems
},
ls
),
ps
)
receiver
(
FInSetFilter
filt
)
((
listboxState
=:{
pen
,
aitems
},
ls
),
ps
)
#
items
=
filter
filt
aitems
#
items
=
filt
aitems
#
listboxState
=
{
listboxState
&
ifilter
=
filt
,
items
=
items
}
#
listboxState
=
{
listboxState
&
ifilter
=
filt
,
items
=
items
}
// refresh...
// refresh...
#
(
newDomain
,
ps
)
=
calcControlDomain
pen
items
ps
#
(
newDomain
,
ps
)
=
calcControlDomain
pen
items
ps
...
@@ -154,31 +154,11 @@ where
...
@@ -154,31 +154,11 @@ where
receiver
(
FInSetSelection
newSelection
)
((
listboxState
=:{
lineHeight
,
initHeight
},
ls
),
ps
)
receiver
(
FInSetSelection
newSelection
)
((
listboxState
=:{
lineHeight
,
initHeight
},
ls
),
ps
)
#
listboxState
=
{
FilteredListBoxState
|
listboxState
&
selection
=
newSelection
}
#
listboxState
=
{
FilteredListBoxState
|
listboxState
&
selection
=
newSelection
}
#
(
newLook
,
listboxState
)=
customlook
listboxState
#
(
newLook
,
listboxState
)=
customlook
listboxState
#!
ps
=
scrolltosel
ps
#!
ps
=
scroll
_
to
_
sel
ection
newSelection
lineHeight
customId
ps
#!
ps
=
appPIO
(
setControlLooks
[(
customId
,
True
,(
True
,
newLook
))])
ps
#!
ps
=
appPIO
(
setControlLooks
[(
customId
,
True
,(
True
,
newLook
))])
ps
=
(
FOutSetSelection
,((
listboxState
,
ls
),
ps
))
=
(
FOutSetSelection
,((
listboxState
,
ls
),
ps
))
where
where
customId
=
listboxState
.
listboxId
.
fcontrolId
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:
// Return the current elements:
...
@@ -202,7 +182,7 @@ where
...
@@ -202,7 +182,7 @@ where
=
(
FOutAppendItems
,((
listboxState
,
ls
),
ps
))
=
(
FOutAppendItems
,((
listboxState
,
ls
),
ps
))
where
where
customId
=
listboxState
.
listboxId
.
fcontrolId
customId
=
listboxState
.
listboxId
.
fcontrolId
filteredNewItems
=
filter
ifilter
newItems
filteredNewItems
=
ifilter
newItems
allFilteredItems
=
items
++
filteredNewItems
allFilteredItems
=
items
++
filteredNewItems
scrolltoend
dom
=:{
corner2
={
y
=
bot
}}
wdef
scrolltoend
dom
=:{
corner2
={
y
=
bot
}}
wdef
...
@@ -275,6 +255,26 @@ where
...
@@ -275,6 +255,26 @@ where
#
newDomain
=
{
corner1
=
zero
,
corner2
={
x
=
maxWidth
,
y
=
height
}}
// calculate new domain...
#
newDomain
=
{
corner1
=
zero
,
corner2
={
x
=
maxWidth
,
y
=
height
}}
// calculate new domain...
=
(
newDomain
,
pic
)
=
(
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
)]
removeDupAtt
[
x
:
xs
]
=
[
x
:
removeDupAtt
(
filter
(
diff
x
)
xs
)]
where
where
diff
(
PenSize
_)
(
PenSize
_)
=
False
diff
(
PenSize
_)
(
PenSize
_)
=
False
...
@@ -300,12 +300,26 @@ where
...
@@ -300,12 +300,26 @@ where
|
y
<
min_y
||
y
-
lineHeight
>
max_y
|
y
<
min_y
||
y
-
lineHeight
>
max_y
=
(
y
+
lineHeight
,
p
)
=
(
y
+
lineHeight
,
p
)
=
(
y
+
lineHeight
,
drawAt
{
x
=
0
,
y
=
y
}
line
p
)
=
(
y
+
lineHeight
,
drawAt
{
x
=
0
,
y
=
y
}
line
p
)
#
pict
=
strictSeq
[
drawsel
sel
\\
sel
<-
selection
]
pict
#
pict
=
hilite_selections
selection
pict
=
pict
=
pict
where
where
x1
=
newFrame
.
corner1
.
x
x1
=
newFrame
.
corner1
.
x
x2
=
newFrame
.
corner2
.
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
}}
//--
//--
...
@@ -336,11 +350,11 @@ keyboard efun (SpecialKey key (KeyDown repeat) {shiftDown,controlDown}) ((lbStat
...
@@ -336,11 +350,11 @@ keyboard efun (SpecialKey key (KeyDown repeat) {shiftDown,controlDown}) ((lbStat
// if shift - extend selection one up
// if shift - extend selection one up
// if control ...
// if control ...
// if control-shift ...
// if control-shift ...
#
newSelection
=
if
hasSelection
(
max
1
(
lastSelection
-
1
)
)
1
#
newSelection
=
if
hasSelection
[
max
1
(
lastSelection
-
1
)
]
[
1
]
#
lbState
=
{
lbState
&
selection
=
[
newSelection
]
}
#
lbState
=
{
lbState
&
selection
=
newSelection
}
#
(
newLook
,
lbState
)
#
(
newLook
,
lbState
)
=
customlook
lbState
=
customlook
lbState
#
ps
=
scrolltoselection
True
newSelection
ps
#
ps
=
scroll
_
to
_
selection
newSelection
lineHeight
customId
ps
#
ps
=
appPIO
(
setControlLooks
[(
customId
,
True
,(
True
,
newLook
))])
ps
#
ps
=
appPIO
(
setControlLooks
[(
customId
,
True
,(
True
,
newLook
))])
ps
=
((
lbState
,
ls
),
ps
)
=
((
lbState
,
ls
),
ps
)
|
key
==
downKey
|
key
==
downKey
...
@@ -348,11 +362,11 @@ keyboard efun (SpecialKey key (KeyDown repeat) {shiftDown,controlDown}) ((lbStat
...
@@ -348,11 +362,11 @@ keyboard efun (SpecialKey key (KeyDown repeat) {shiftDown,controlDown}) ((lbStat
// if shift - extend selection one up
// if shift - extend selection one up
// if control ...
// if control ...
// if control-shift ...
// if control-shift ...
#
newSelection
=
if
hasSelection
(
min
nrItems
(
lastSelection
+
1
))
nrItems
#
newSelection
=
[
if
hasSelection
(
min
nrItems
(
lastSelection
+
1
))
nrItems
]
#
lbState
=
{
lbState
&
selection
=
[
newSelection
]
}
#
lbState
=
{
lbState
&
selection
=
newSelection
}
#
(
newLook
,
lbState
)
#
(
newLook
,
lbState
)
=
customlook
lbState
=
customlook
lbState
#
ps
=
scrolltoselection
True
newSelection
ps
#
ps
=
scroll
_
to
_
selection
newSelection
lineHeight
customId
ps
#
ps
=
appPIO
(
setControlLooks
[(
customId
,
True
,(
True
,
newLook
))])
ps
#
ps
=
appPIO
(
setControlLooks
[(
customId
,
True
,(
True
,
newLook
))])
ps
=
((
lbState
,
ls
),
ps
)
=
((
lbState
,
ls
),
ps
)
|
key
==
beginKey
|
key
==
beginKey
...
@@ -360,11 +374,11 @@ keyboard efun (SpecialKey key (KeyDown repeat) {shiftDown,controlDown}) ((lbStat
...
@@ -360,11 +374,11 @@ keyboard efun (SpecialKey key (KeyDown repeat) {shiftDown,controlDown}) ((lbStat
// if shift - extend selection one up
// if shift - extend selection one up
// if control ...
// if control ...
// if control-shift ...
// if control-shift ...
#
newSelection
=
1
#
newSelection
=
[
1
]
#
lbState
=
{
lbState
&
selection
=
[
newSelection
]
}
#
lbState
=
{
lbState
&
selection
=
newSelection
}
#
(
newLook
,
lbState
)
#
(
newLook
,
lbState
)
=
customlook
lbState
=
customlook
lbState
#
ps
=
scrolltoselection
True
newSelection
ps
#
ps
=
scroll
_
to
_
selection
newSelection
lineHeight
customId
ps
#
ps
=
appPIO
(
setControlLooks
[(
customId
,
True
,(
True
,
newLook
))])
ps
#
ps
=
appPIO
(
setControlLooks
[(
customId
,
True
,(
True
,
newLook
))])
ps
=
((
lbState
,
ls
),
ps
)
=
((
lbState
,
ls
),
ps
)
|
key
==
endKey
|
key
==
endKey
...
@@ -372,11 +386,11 @@ keyboard efun (SpecialKey key (KeyDown repeat) {shiftDown,controlDown}) ((lbStat
...
@@ -372,11 +386,11 @@ keyboard efun (SpecialKey key (KeyDown repeat) {shiftDown,controlDown}) ((lbStat
// if shift - extend selection one up
// if shift - extend selection one up
// if control ...
// if control ...
// if control-shift ...
// if control-shift ...
#
newSelection
=
nrItems
#
newSelection
=
[
nrItems
]
#
lbState
=
{
lbState
&
selection
=
[
newSelection
]
}
#
lbState
=
{
lbState
&
selection
=
newSelection
}
#
(
newLook
,
lbState
)
#
(
newLook
,
lbState
)
=
customlook
lbState
=
customlook
lbState
#
ps
=
scrolltoselection
True
newSelection
ps
#
ps
=
scroll
_
to
_
selection
newSelection
lineHeight
customId
ps
#
ps
=
appPIO
(
setControlLooks
[(
customId
,
True
,(
True
,
newLook
))])
ps
#
ps
=
appPIO
(
setControlLooks
[(
customId
,
True
,(
True
,
newLook
))])
ps
=
((
lbState
,
ls
),
ps
)
=
((
lbState
,
ls
),
ps
)
#
(
wstate
,
ps
)
=
accPIO
(
getParentWindow
customId
)
ps
#
(
wstate
,
ps
)
=
accPIO
(
getParentWindow
customId
)
ps
...
@@ -398,14 +412,14 @@ keyboard efun (SpecialKey key (KeyDown repeat) {shiftDown,controlDown}) ((lbStat
...
@@ -398,14 +412,14 @@ keyboard efun (SpecialKey key (KeyDown repeat) {shiftDown,controlDown}) ((lbStat
#
top
=
(
lastSelection
-2
)
*
lineHeight
#
top
=
(
lastSelection
-2
)
*
lineHeight
#
newSelection
=
if
hasSelection
#
newSelection
=
if
hasSelection
(
if
(
top
<=
frame
.
corner1
.
y
)
//topLine
(
if
(
top
<=
frame
.
corner1
.
y
)
//topLine
(
max
1
(
lastSelection
-
linesOnPage
)
)
[
max
1
(
lastSelection
-
linesOnPage
)
]
(
2
+
(
frame
.
corner1
.
y
/
lineHeight
)
)
//topOfPage
[
2
+
(
frame
.
corner1
.
y
/
lineHeight
)
]
//topOfPage
)
)
1
[
1
]
#
lbState
=
{
lbState
&
selection
=
[
newSelection
]
}
#
lbState
=
{
lbState
&
selection
=
newSelection
}
#
(
newLook
,
lbState
)
#
(
newLook
,
lbState
)
=
customlook
lbState
=
customlook
lbState
#
ps
=
scrolltoselection
True
newSelection
ps
#
ps
=
scroll
_
to
_
selection
newSelection
lineHeight
customId
ps
#
ps
=
appPIO
(
setControlLooks
[(
customId
,
True
,(
True
,
newLook
))])
ps
#
ps
=
appPIO
(
setControlLooks
[(
customId
,
True
,(
True
,
newLook
))])
ps
=
((
lbState
,
ls
),
ps
)
=
((
lbState
,
ls
),
ps
)
|
key
==
pgDownKey
|
key
==
pgDownKey
...
@@ -416,14 +430,14 @@ keyboard efun (SpecialKey key (KeyDown repeat) {shiftDown,controlDown}) ((lbStat
...
@@ -416,14 +430,14 @@ keyboard efun (SpecialKey key (KeyDown repeat) {shiftDown,controlDown}) ((lbStat
#
bot
=
(
inc
lastSelection
)
*
lineHeight
#
bot
=
(
inc
lastSelection
)
*
lineHeight
#
newSelection
=
if
hasSelection
#
newSelection
=
if
hasSelection
(
if
(
bot
>=
frame
.
corner2
.
y
)
//bottomLine
(
if
(
bot
>=
frame
.
corner2
.
y
)
//bottomLine
(
min
nrItems
(
lastSelection
+
linesOnPage
)
)
[
min
nrItems
(
lastSelection
+
linesOnPage
)
]
(
frame
.
corner2
.
y
/
lineHeight
)
//bottomOfPage
[
frame
.
corner2
.
y
/
lineHeight
]
//bottomOfPage
)
)
nrItems
[
nrItems
]
#
lbState
=
{
lbState
&
selection
=
[
newSelection
]
}
#
lbState
=
{
lbState
&
selection
=
newSelection
}
#
(
newLook
,
lbState
)
#
(
newLook
,
lbState
)
=
customlook
lbState
=
customlook
lbState
#
ps
=
scrolltoselection
True
newSelection
ps
#
ps
=
scroll
_
to
_
selection
newSelection
lineHeight
customId
ps
#
ps
=
appPIO
(
setControlLooks
[(
customId
,
True
,(
True
,
newLook
))])
ps
#
ps
=
appPIO
(
setControlLooks
[(
customId
,
True
,(
True
,
newLook
))])
ps
=
((
lbState
,
ls
),
ps
)
=
((
lbState
,
ls
),
ps
)
=
((
lbState
,
ls
),
ps
)
=
((
lbState
,
ls
),
ps
)
...
@@ -434,24 +448,6 @@ where
...
@@ -434,24 +448,6 @@ where
|
isEmpty
selection
=
False
|
isEmpty
selection
=
False
=
True
=
True
lastSelection
=
hd
selection
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"
keyboard
_
_
_
=
abort
"FilteredListBox: unsupported keyboard action"
// The mouse responds only to MouseDowns:
// The mouse responds only to MouseDowns:
...
@@ -478,12 +474,12 @@ where
...
@@ -478,12 +474,12 @@ where
newSelection
newSelection
|
shiftDown
|
shiftDown
|
hasSelection
|
hasSelection
=
remove
Dup
[
newIndex
:
listSelection
++
s
election
]
=
remove
Members
selection
listSelection
++
listS
election
=
[
newIndex
]
=
[
newIndex
]
|
controlDown
|
controlDown
|
isMember
newIndex
selection
|
isMember
newIndex
selection
=
removeMember
s
selection
[
newIndex
]
=
removeMember
newIndex
selection
=
[
newIndex
:
selection
]
=
selection
++[
newIndex
]
=
[
newIndex
]
=
[
newIndex
]
okSelection
=
filter
(
isBetween
1
nrItems
)
newSelection
okSelection
=
filter
(
isBetween
1
nrItems
)
newSelection
customId
=
listboxState
.
listboxId
.
fcontrolId
customId
=
listboxState
.
listboxId
.
fcontrolId
...
@@ -547,17 +543,17 @@ setFilteredListBoxPen :: !FilteredListBoxId ![PenAttribute] !(PSt .l) -> PSt .l
...
@@ -547,17 +543,17 @@ setFilteredListBoxPen :: !FilteredListBoxId ![PenAttribute] !(PSt .l) -> PSt .l
setFilteredListBoxPen
{
freceiverId
}
pen
ps
setFilteredListBoxPen
{
freceiverId
}
pen
ps
=
snd
(
syncSend2
freceiverId
(
FInSetPen
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