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
0
Merge Requests
0
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
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
//--- 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
=
filt
er
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
=
scroll
tosel
ps
#!
ps
=
scroll
_to_selection
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
...
...
@@ -275,6 +255,26 @@ where
#
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
diff
(
PenSize
_)
(
PenSize
_)
=
False
...
...
@@ -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
}}
//--
...
...
@@ -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
=
scroll
toselection
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
=
scroll
toselection
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
=
scroll
toselection
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
=
scroll
toselection
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
=
scroll
toselection
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
=
scroll
toselection
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
++
selection
]
=
remove
Members
selection
listSelection
++
listSelection
=
[
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
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a 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