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
079ce4c4
Commit
079ce4c4
authored
Dec 11, 2001
by
Diederik van Arkel
Browse files
no message
parent
0427b8b5
Changes
36
Hide whitespace changes
Inline
Side-by-side
BatchBuild.prj
View file @
079ce4c4
...
...
@@ -39,12 +39,13 @@ Global
Paths
Path: {Project}
Path: {Project}\BatchBuild
Path: {Application}\Directory
Path: {Application}\ArgEnvWindows
Path: {Project}\Pm
Path: {Project}\Util
Path: {Project}\Win
Path: {Project}\Interfaces\LinkerInterface
Path: {Project}\Win\PatchConsoleEvents
Path: {Project}\Win\ArgEnvWindows
Path: {Project}\Win\Directory
Precompile:
Postlink:
MainModule
...
...
BatchBuild/IdeState.dcl
View file @
079ce4c4
...
...
@@ -3,12 +3,12 @@ definition module IdeState
import
StdPSt
,
StdId
,
StdPictureDef
import
StdPathname
import
UtilStrictLists
from
PmAbcMagic
import
ABCCache
from
PmProject
import
Project
from
PmAbcMagic
import
::
ABCCache
from
PmProject
import
::
Project
import
PmCompilerOptions
import
typewin
import
PmEnvironment
from
PmFileInfo
import
FileInfoCache
from
PmFileInfo
import
::
FileInfoCache
::
*
General
...
...
@@ -58,6 +58,7 @@ getCurrentObjts :: !*(PSt *General) -> (!(List String),!*PSt *General)
getCurrentComp
::
!*(
PSt
*
General
)
->
(!
String
,!*
PSt
*
General
)
getCurrentCgen
::
!*(
PSt
*
General
)
->
(!
String
,!*
PSt
*
General
)
getCurrentLink
::
!*(
PSt
*
General
)
->
(!
String
,!*
PSt
*
General
)
getCurrentDynl
::
!*(
PSt
*
General
)
->
(!
String
,!*
PSt
*
General
)
getCurrentVers
::
!*(
PSt
*
General
)
->
(!
Int
,!*
PSt
*
General
)
getCurrentMeth
::
!*(
PSt
*
General
)
->
(!
CompileMethod
,!*
PSt
*
General
)
...
...
BatchBuild/IdeState.icl
View file @
079ce4c4
...
...
@@ -3,14 +3,13 @@ implementation module IdeState
import
StdPSt
,
StdId
,
StdPictureDef
,
StdMisc
,
StdList
,
StdProcess
,
StdPStClass
import
StdPathname
import
UtilStrictLists
from
PmAbcMagic
import
ABCCache
,
AC_Init
from
PmProject
import
Project
,
PR_GetTarget
from
PmAbcMagic
import
::
ABCCache
,
AC_Init
from
PmProject
import
::
Project
,
PR_GetTarget
import
PmCompilerOptions
import
typewin
import
PmEnvironment
import
logfile
import
set_return_code
//import PmDriver
import
PmFileInfo
::
*
General
=
...
...
@@ -160,6 +159,11 @@ getCurrentLink ps
#
(
ct
,
ps
)
=
accPLoc
(\
p
=:{
pm_targets
,
pm_curtarg
}->(
pm_targets
!!
pm_curtarg
,
p
))
ps
=
(
ct
.
target_link
,
ps
)
getCurrentDynl
::
!*(
PSt
*
General
)
->
(!
String
,!*
PSt
*
General
)
getCurrentDynl
ps
#
(
ct
,
ps
)
=
accPLoc
(\
p
=:{
pm_targets
,
pm_curtarg
}->(
pm_targets
!!
pm_curtarg
,
p
))
ps
=
(
ct
.
target_dynl
,
ps
)
getCurrentVers
::
!*(
PSt
*
General
)
->
(!
Int
,!*
PSt
*
General
)
getCurrentVers
ps
#
(
ct
,
ps
)
=
accPLoc
(\
p
=:{
pm_targets
,
pm_curtarg
}->(
pm_targets
!!
pm_curtarg
,
p
))
ps
...
...
BatchBuild/messwin.dcl
View file @
079ce4c4
definition
module
messwin
import
StdString
,
StdPSt
from
IdeState
import
General
from
IdeState
import
::
General
::
Info
=
Level1
String
...
...
BatchBuild/messwin.icl
View file @
079ce4c4
implementation
module
messwin
import
StdString
,
StdPSt
,
StdBool
,
StdList
,
StdFunc
from
IdeState
import
General
,
writeLog
from
IdeState
import
::
General
,
writeLog
::
Info
=
Level1
String
...
...
Editor/EdClient.dcl
View file @
079ce4c4
definition
module
EdClient
import
EdMonad
,
EdState
,
EdCommon
from
EdMessage
import
EditAction
from
EdMessage
import
::
EditAction
sendToActiveWindow
::
.(*(
EditState
,*
PSt
*
b
)
->
*(.
c
,*(
EditState
,*
PSt
*
b
)))
!*(
PSt
*
b
)
->
*(
Maybe
.
c
,*
PSt
*
b
)
|
Editor
b
...
...
Editor/EdCommon.dcl
View file @
079ce4c4
definition
module
EdCommon
from
StdPSt
import
PSt
,
IO
St
from
EdState
import
Editor
,
EditorState
from
EdMonad
import
EditMonad
,
StateM
,
EditState
from
EdSelection
import
Selection
,
Position
,
ColumnNr
,
LineNr
from
StdPSt
import
::
P
St
from
EdState
import
class
Editor
,
::
EditorState
from
EdMonad
import
::
EditMonad
,
::
StateM
,
::
EditState
from
EdSelection
import
::
Selection
,
::
Position
::
*
PLocState
:==
MyEditorState
::
MyEditorState
=
MES
EditorState
...
...
Editor/EdCommon.icl
View file @
079ce4c4
implementation
module
EdCommon
from
EdState
import
Editor
,
EditorState
from
EdState
import
class
Editor
,
::
EditorState
import
EdMonad
::
*
PLocState
:==
MyEditorState
...
...
Editor/EdEditMenu.dcl
View file @
079ce4c4
...
...
@@ -4,9 +4,8 @@
definition
module
EdEditMenu
from
StdMenu
import
Menu
,
Title
,
MenuAttribute
from
StdPSt
import
PSt
,
IOSt
from
EdCommon
import
MyEditorState
from
StdPSt
import
::
PSt
from
EdCommon
import
::
MyEditorState
openEditMenu
::
(
PSt
*
MyEditorState
)
->
PSt
*
MyEditorState
Editor/EdFileMenu.dcl
View file @
079ce4c4
...
...
@@ -4,11 +4,9 @@
definition
module
EdFileMenu
from
StdMenu
import
Menu
,
Title
,
MenuAttribute
from
StdId
import
Id
from
StdPSt
import
PSt
,
IOSt
from
EdState
import
EditorState
from
EdCommon
import
MyEditorState
from
StdId
import
::
Id
from
StdPSt
import
::
PSt
from
EdCommon
import
::
MyEditorState
openFileMenu
::
Id
(
PSt
*
MyEditorState
)
->
PSt
*
MyEditorState
Editor/EdOptionsMenu.dcl
View file @
079ce4c4
...
...
@@ -4,9 +4,8 @@
definition
module
EdOptionsMenu
from
StdMenu
import
Menu
,
Title
,
MenuAttribute
from
StdPSt
import
PSt
,
IOSt
from
EdCommon
import
MyEditorState
from
StdPSt
import
::
PSt
from
EdCommon
import
::
MyEditorState
openOptionsMenu
::
!(
PSt
*
MyEditorState
)
->
PSt
*
MyEditorState
HeapProfile/ExtNotice.dcl
deleted
100644 → 0
View file @
0427b8b5
definition
module
ExtNotice
/*
0.0 [P88] The original notice class from the Object IO tutorial
1.0 [DvA] Modified for use with the new Clean IDE
2.0 [DvA] Added TimedNotice class
P88 = Peter Achten (peter88@cs.kun.nl)
DvA = Diederik van Arkel (diederik@cs.kun.nl)
*/
import
StdWindow
,
StdTimerDef
::
Notice
ls
ps
=
Notice
[
String
]
(
NoticeButton
*(
ls
,
ps
))
[
NoticeButton
*(
ls
,
ps
)]
::
NoticeButton
ps
=
NoticeButton
String
(
IdFun
ps
)
instance
Dialogs
Notice
openNotice
::
!(
Notice
.
ls
*(
PSt
.
l
))
!*(
PSt
.
l
)
->
*
PSt
.
l
okNotice
text
ps
:==
openNotice
(
Notice
text
(
NoticeButton
"OK"
(\
x
->
x
))
[])
ps
::
TimedNotice
ls
ps
=
TimedNotice
[
String
]
TimerInterval
(
NoticeButton
*(
ls
,
ps
))
[
NoticeButton
*(
ls
,
ps
)]
instance
Dialogs
TimedNotice
openTimedNotice
::
!(
TimedNotice
.
ls
*(
PSt
.
l
))
!*(
PSt
.
l
)
->
*
PSt
.
l
okTimedNotice
text
time
ps
:==
openTimedNotice
(
TimedNotice
text
time
(
NoticeButton
"OK"
(\
x
->
x
))
[])
ps
HeapProfile/ExtNotice.icl
deleted
100644 → 0
View file @
0427b8b5
implementation
module
ExtNotice
import
StdTuple
,
StdMisc
,
StdFunc
import
StdId
,
StdPSt
,
StdWindow
,
StdTimer
::
Notice
ls
ps
=
Notice
[
String
]
(
NoticeButton
*(
ls
,
ps
))
[
NoticeButton
*(
ls
,
ps
)]
::
NoticeButton
ps
=
NoticeButton
String
(
IdFun
ps
)
instance
Dialogs
Notice
where
// openDialog :: .ls (Notice .ls (PSt .l)) (PSt .l) -> (!ErrorReport, !PSt .l)
openDialog
ls
notice
ps
#
(
wId
,
ps
)
=
accPIO
openId
ps
(
okId
,
ps
)
=
accPIO
openId
ps
=
openDialog
ls
(
noticeToDialog
wId
okId
notice
)
ps
// openModalDialog :: .ls (Notice .ls (PSt .l)) (PSt .l) -> (!(!ErrorReport,!Maybe .ls),!PSt .l)
openModalDialog
ls
notice
ps
#
(
wId
,
ps
)
=
accPIO
openId
ps
(
okId
,
ps
)
=
accPIO
openId
ps
=
openModalDialog
ls
(
noticeToDialog
wId
okId
notice
)
ps
// getDialogType :: (Notice .ls .ps) -> WindowType
getDialogType
_
=
"Notice"
openNotice
::
!(
Notice
.
ls
*(
PSt
.
l
))
!*(
PSt
.
l
)
->
*
PSt
.
l
openNotice
notice
ps
=
snd
(
openModalDialog
undef
notice
ps
)
//noticeToDialog :: Id Id !(Notice .ls (PSt .l)) -> Dialog
noticeToDialog
wid
okid
(
Notice
texts
ok
buttons
)
=
Dialog
""
(
texts`
:+:
ok`
:+:
buttons`
)
[
WindowId
wid
,
WindowOk
okid
]
where
texts`
=
LayoutControl
(
ListLS
[
TextControl
text
[
ControlPos
(
Left
,
zero
)]
\\
text
<-
texts
]
)
[
ControlHMargin
0
0
,
ControlVMargin
0
0
,
ControlItemSpace
3
3
]
ok`
=
noticebutton
ok
[
ControlPos
(
Right
,
zero
),
ControlId
okid
]
buttons`
=
ListLS
[
noticebutton
button
[
ControlPos
(
LeftOfPrev
,
zero
)]
\\
button
<-
buttons
]
noticebutton
(
NoticeButton
text
f
)
atts
=
ButtonControl
text
[
ControlFunction
f`
:
atts
]
where
f`
(
ls
,
ps
)
=
f
(
ls
,
closeWindow
wid
ps
)
okNotice
text
ps
:==
openNotice
(
Notice
text
(
NoticeButton
"OK"
(\
x
->
x
))
[])
ps
::
TimedNotice
ls
ps
=
TimedNotice
[
String
]
TimerInterval
(
NoticeButton
*(
ls
,
ps
))
[
NoticeButton
*(
ls
,
ps
)]
instance
Dialogs
TimedNotice
where
// openDialog :: .ls (TimedNotice .ls (PSt .l)) (PSt .l) -> (!ErrorReport, !PSt .l)
openDialog
ls
notice
ps
#
(
wId
,
ps
)
=
accPIO
openId
ps
(
okId
,
ps
)
=
accPIO
openId
ps
=
openDialog
ls
(
timednoticeToDialog
wId
okId
notice
)
ps
// openModalDialog :: .ls (TimedNotice .ls (PSt .l)) (PSt .l) -> (!(!ErrorReport,!Maybe .ls),!PSt .l)
openModalDialog
ls
notice
ps
#
(
wId
,
ps
)
=
accPIO
openId
ps
(
okId
,
ps
)
=
accPIO
openId
ps
=
openModalDialog
ls
(
timednoticeToDialog
wId
okId
notice
)
ps
// getDialogType :: (TimedNotice .ls .ps) -> WindowType
getDialogType
_
=
"TimerNotice"
openTimedNotice
::
!(
TimedNotice
.
ls
*(
PSt
.
l
))
!*(
PSt
.
l
)
->
*
PSt
.
l
openTimedNotice
notice
ps
=
snd
(
openModalDialog
undef
notice
ps
)
//timednoticeToDialog :: Id Id !(TimedNotice .ls (PSt .l)) -> Dialog
timednoticeToDialog
wid
okid
(
TimedNotice
texts
time
ok
buttons
)
=
Dialog
""
(
texts`
:+:
ok`
:+:
buttons`
)
[
WindowId
wid
,
WindowOk
okid
,
WindowInit
(
noLS
timestuff
)
]
where
timestuff
ps
#
(
err
,
ps
)
=
openTimer
undef
timer`
ps
|
err
<>
NoError
#
ps
=
okNotice
[
"Timer Creation Failed"
]
ps
#
ps
=
closeWindow
wid
ps
=
ps
=
ps
texts`
=
LayoutControl
(
ListLS
[
TextControl
text
[
ControlPos
(
Left
,
zero
)]
\\
text
<-
texts
]
)
[
ControlHMargin
0
0
,
ControlVMargin
0
0
,
ControlItemSpace
3
3
]
ok`
=
noticebutton
ok
[
ControlPos
(
Right
,
zero
),
ControlId
okid
]
buttons`
=
ListLS
[
noticebutton
button
[
ControlPos
(
LeftOfPrev
,
zero
)]
\\
button
<-
buttons
]
timer`
=
Timer
time
NilLS
[
TimerFunction
(\_
(
ls
,
ps
)->(
ls
,
closeWindow
wid
ps
))]
noticebutton
(
NoticeButton
text
f
)
atts
=
ButtonControl
text
[
ControlFunction
f`
:
atts
]
where
f`
(
ls
,
ps
)
=
f
(
ls
,
closeWindow
wid
ps
)
okTimedNotice
text
time
ps
:==
openTimedNotice
(
TimedNotice
text
time
(
NoticeButton
"OK"
(\
x
->
x
))
[])
ps
HeapProfile/expand_8_3_names_in_path.dcl
deleted
100644 → 0
View file @
0427b8b5
definition
module
expand_8_3_names_in_path
;
expand_8_3_names_in_path
::
!{#
Char
}
->
{#
Char
};
HeapProfile/expand_8_3_names_in_path.icl
deleted
100644 → 0
View file @
0427b8b5
implementation
module
expand_8_3_names_in_path
;
import
StdEnv
;
FindFirstFile
::
!
String
->
(!
Int
,!
String
);
FindFirstFile
file_name
#
find_data
=
createArray
318
'\0'
;
#
handle
=
FindFirstFile_
file_name
find_data
;
=
(
handle
,
find_data
);
FindFirstFile_
::
!
String
!
String
->
Int
;
FindFirstFile_
file_name
find_data
=
code {
ccall
FindFirstFileA@8
"Pss:I"
}
FindClose
::
!
Int
->
Int
;
FindClose
handle
=
code {
ccall
FindClose@4
"PI:I"
}
find_null_char_in_string
::
!
Int
!
String
->
Int
;
find_null_char_in_string
i
s
|
i
<
size
s
&&
s
.[
i
]<>
'\0'
=
find_null_char_in_string
(
i
+1
)
s
;
=
i
;
find_data_file_name
find_data
#
i
=
find_null_char_in_string
44
find_data
;
=
find_data
%
(
44
,
i
-1
);
find_first_file_and_close
::
!
String
->
(!
Bool
,!
String
);
find_first_file_and_close
file_name
#
(
handle
,
find_data
)
=
FindFirstFile
file_name
;
|
handle
<>
(
-1
)
#
r
=
FindClose
handle
;
|
r
==
r
=
(
True
,
find_data
);
=
(
False
,
find_data
);
=
(
False
,
""
);
find_last_backslash_in_string
i
s
|
i
<
0
=
(
False
,
-1
);
|
s
.[
i
]==
'\\'
=
(
True
,
i
);
=
find_last_backslash_in_string
(
i
-1
)
s
;
expand_8_3_names_in_path
::
!{#
Char
}
->
{#
Char
};
expand_8_3_names_in_path
path_and_file_name
#
(
found_backslash
,
back_slash_index
)
=
find_last_backslash_in_string
(
size
path_and_file_name
-1
)
path_and_file_name
;
|
not
found_backslash
=
path_and_file_name
;
#
path
=
expand_8_3_names_in_path
(
path_and_file_name
%
(
0
,
back_slash_index
-1
));
#
file_name
=
path_and_file_name
%
(
back_slash_index
+1
,
size
path_and_file_name
-1
);
#
path_and_file_name
=
path
+++
"
\\
"
+++
file_name
;
#
(
ok
,
find_data
)
=
find_first_file_and_close
(
path_and_file_name
+++
"
\0
"
);
|
ok
=
path
+++
"
\\
"
+++
find_data_file_name
find_data
;
=
path_and_file_name
;
HeapProfile/flexwin.dcl
deleted
100644 → 0
View file @
0427b8b5
definition
module
flexwin
import
StdEnv
,
StdIO
//import ShowProfile
//:: FlexBarWindow ls pst = FlexBarWindow Title [(String, Maybe Int)] [WindowAttribute *(ls,pst)]
//:: FlexBarWindow ls pst
// = FlexBarWindow Title [(String, Maybe Int)] .[FormattedProfile] (R2Id (MessageIn ls) MessageOut) [WindowAttribute *(ls,pst)]
//:: FlexBarWindow s ls pst
// = FlexBarWindow Title [(String, Maybe Int)] [s] (R2Id (MessageIn s) MessageOut) [WindowAttribute *(ls,pst)]
class
content_size
c
::
FontMetrics
c
->
Int
::
FlexBarState
s
::
FlexBarWindow
s
ls
pst
=
FlexBarWindow
Title
[(
String
,
Maybe
Int
)]
s
(!
s
.
Int
.
Int
[.
Int
]
->
(.
SelectState
.
UpdateState
->
.(*
Picture
->
*
Picture
)))
![(
FlexBarState
s
)
->
FlexBarState
s
]
(
R2Id
(
MessageIn
s
)
(
MessageOut
s
))
[
WindowAttribute
*(
ls
,
pst
)]
::
MessageIn
s
=
FW_DummyIn
|
FW_SetContent
s
//[.FormattedProfile]
|
FW_ApplyFunction
Int
|
FW_GetContent
::
MessageOut
s
=
FW_DummyOut
|
FW_ContentOut
s
instance
Windows
(
FlexBarWindow
s
)
|
content_size
s
//--
appInfo
::
(
s
->
s
)
!(
FlexBarState
s
)
->
FlexBarState
s
HeapProfile/flexwin.icl
deleted
100644 → 0
View file @
0427b8b5
implementation
module
flexwin
/* TO DO:
o Content look
o Always leave first char of header string? Use clipping?
o Polling for column widths (in order to save/restore)
o Optimize setControlLook
o Button functions + header & body look updates...
o Sensible size handling
*/
import
StdEnv
,
StdIO
import
StdDebug
import
ioutil
class
content_size
c
::
FontMetrics
c
->
Int
::
FlexBarState
s
=
{
nrOfColumns
::
!
Int
,
columnPoss
::
![
Int
]
,
columnTexts
::
![
String
]
,
height
::
!
Int
,
windowId
::
!
Id
,
headerId
::
!
Id
,
receiverId
::
!
R2Id
(
MessageIn
s
)
(
MessageOut
s
)
,
cursep
::
!
Int
// selected column seperator ~1 if none
,
curcol
::
!
Int
// selected column 0 if none negative if selected but mouse outside of button area
,
domain
::
!
ViewDomain
,
info
::
!
s
,
line_height
::
!
Int
,
metrics
::
!
FontMetrics
,
columnFuncs
::
![(
FlexBarState
s
)
->
FlexBarState
s
]
,
body_look
::
!
s
.
Int
.
Int
[.
Int
]
->
(.
SelectState
.
UpdateState
->
.(*
Picture
->
*
Picture
))
}
::
MessageIn
s
=
FW_DummyIn
|
FW_SetContent
s
|
FW_ApplyFunction
Int
|
FW_GetContent
::
MessageOut
s
=
FW_DummyOut
|
FW_ContentOut
s
mi2cw
Nothing
=
10
mi2cw
(
Just
w
)
|
w
<
5
=
5
// minimum column width, moet eigenlijk niet hier maar pas bij tekenen en afhankelijk van font
=
w
//--
::
FlexBarWindow
s
ls
pst
=
FlexBarWindow
Title
[(
String
,
Maybe
Int
)]
s
(!
s
.
Int
.
Int
[.
Int
]
->
(.
SelectState
.
UpdateState
->
.(*
Picture
->
*
Picture
)))
![(
FlexBarState
s
)
->
FlexBarState
s
]
(
R2Id
(
MessageIn
s
)
(
MessageOut
s
))
[
WindowAttribute
*(
ls
,
pst
)]
instance
Windows
(
FlexBarWindow
s
)
|
content_size
s
where
getWindowType
_
=
"FlexBarWindow"
openWindow
ls
(
FlexBarWindow
title
elts
info
look
funs
receiverId
atts
)
ps
#
(
windowId
,
ps
)
=
case
hasWindowIdAtt
of
Nothing
->
openId
ps
(
Just
wId
)
->
(
wId
,
ps
)
#
(
headerId
,
ps
)
=
openId
ps
#
((
ok
,
font
),
ps
)
=
accScreenPicture
(
openFont
{
fName
=
"Courier New"
,
fStyles
=[
BoldStyle
],
fSize
=
8
})
ps
#
(
metrics
,
ps
)
=
accScreenPicture
(
getFontMetrics
font
)
ps
#
((
size
,
line_height
),
ps
)
=
accScreenPicture
(
profileSize
info
o
(
setPenFont
font
))
ps
#
domain
=
{
zero
&
corner2
=
{
x
=
last
columnPoss
,
y
=
height
+
size
}}
=
openWindow
(
newstate
info
domain
line_height
metrics
headerId
windowId
)
(
Window
title
(
header
info
domain
line_height
metrics
font
headerId
windowId
)
(
newatts
info
domain
font
size
line_height
metrics
headerId
windowId
))
ps
where
hasWindowIdAtt
#
los
=
filter
(
isWindowId
)
atts
|
isEmpty
los
=
Nothing
=
Just
(
getWindowIdAtt
(
hd
los
))
header
info
domain
line_height
metrics
font
headerId
windowId
=
CustomControl
{
w
=
4096
,
h
=
height
}
// zinniger maximum invullen???
(
headerLook
height
columnTexts
columnPoss`
)
[
ControlId
headerId
,
ControlMouse
mouseFilter
Able
(
mouseFunction
(
newstate
info
domain
line_height
metrics
headerId
windowId
))
,
ControlPos
(
Fix
,
OffsetFun
1
(\({
corner1
={
x
}},{
y
})->{
vx
=
x
,
vy
=
y
}))
,
ControlPen
[
PenFont
font
]
]
:+:
Receiver2
receiverId
receiver
[]
newatts
info
domain
font
size
line_height
metrics
headerId
windowId
=
[
WindowPen
[
PenBack
Vellum
,
PenFont
font
]
,
WindowLook
True
(
flexLook
(
newstate
info
domain
line_height
metrics
headerId
windowId
))
,
WindowViewDomain
domain
,
WindowId
windowId
,
WindowMouse
mouseFilter
Able
(
mouseFunction
(
newstate
info
domain
line_height
metrics
headerId
windowId
))
,
WindowKeyboard
keyboardFilter
Able
(
keyboardFunction
)
,
WindowHScroll
(
myScrollFunction
Horizontal
LR_STEP
)
,
WindowVScroll
(
myScrollFunction
Vertical
line_height
)
,
WindowClose
(
noLS
closeProcess
)
:
fixwinatts
atts
]
newstate
info
domain
line_height
metrics
headerId
windowId
=
{
nrOfColumns
=
length
elts
,
columnPoss
=
columnPoss
,
columnTexts
=
columnTexts
,
height
=
height
,
metrics
=
metrics
,
line_height
=
line_height
,
windowId
=
windowId
,
headerId
=
headerId
,
receiverId
=
receiverId
,
cursep
=
~1
,
curcol
=
0
,
domain
=
domain
,
info
=
info
,
columnFuncs
=
funs
,
body_look
=
look
}
height
=
20
columnPoss
=
fiddle
0
(
map
(
mi2cw
o
snd
)
elts
)
[]
columnPoss`
=
[
0
:
columnPoss
]
columnTexts
=
map
fst
elts
appInfo
::
(
s
->
s
)
!(
FlexBarState
s
)
->
FlexBarState
s
appInfo
f
fs
=:{
info
}
=
{
fs
&
info
=
f
info
}
//--
LR_STEP
:==
12
keyboardFilter
(
SpecialKey
key
(
KeyDown
_)
_)
|
key
==
upKey
=
True
|
key
==
downKey
=
True
|
key
==
beginKey
=
True
|
key
==
endKey
=
True
|
key
==
pgUpKey
=
True
|
key
==
pgDownKey
=
True
|
key
==
leftKey
=
True
|
key
==
rightKey
=
True
=
False
keyboardFilter
_
=
False
keyboardFunction
(
SpecialKey
key
_
mods
)
(
fs
=:{
windowId
,
height
,
line_height
,
domain
,
columnPoss
},
ps
)
#
(
delta
,
ps
)
=
calcDelta
ps
|
delta
==
zero
=
(
fs
,
ps
)
#
ps
=
appPIO
(
moveWindowViewFrame
windowId
delta
)
ps
=
(
fs
,
ps
)
where
calcDelta
ps
|
key
==
upKey
#
(
vf
,
ps
)
=
accPIO
(
getWindowViewFrame
windowId
)
ps
#
delta
=
min
(
vf
.
corner1
.
y
-
domain
.
corner1
.
y
)
line_height
=
({
zero
&
vy
=
~
delta
},
ps
)