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-compiler-and-rts
stdenv
Commits
328cbb14
Commit
328cbb14
authored
Nov 26, 1999
by
Peter Achten
Browse files
PA: internal structure improved to decrease size executable;
type IOStGetDevice changed.
parent
2ef2fcd8
Changes
44
Expand all
Hide whitespace changes
Inline
Side-by-side
ObjectIO/ObjectIO/OS Windows/menuevent.icl
View file @
328cbb14
...
...
@@ -16,6 +16,7 @@ import commondef, deviceevents, iostate
from
menuaccess
import
menuStateHandleGetHandle
,
menuStateHandleGetMenuId
from
processstack
import
topShowProcessShowState
from
StdProcessAttribute
import
getProcessToolbarAtt
,
isProcessToolbar
from
StdPSt
import
accPIO
menueventFatalError
::
String
String
->
.
x
...
...
@@ -25,69 +26,78 @@ menueventFatalError function error
/* menuEvent filters the scheduler events that can be handled by this menu device.
For the time being no timer menu elements are added, so these events are ignored.
menuEvent assumes that it is not applied to an empty IOSt.
menuEvent assumes that it is not applied to an empty IOSt and that its device is
present.
*/
menuEvent
::
!
SchedulerEvent
!(
PSt
.
l
.
p
)
->
(!
Bool
,!
Maybe
DeviceEvent
,!
SchedulerEvent
,!
PSt
.
l
.
p
)
menuEvent
schedulerEvent
=:(
ScheduleOSEvent
osEvent
=:{
ccMsg
}
_)
pState
=:{
io
=
ioState
}
|
isToolbarOSEvent
ccMsg
#
(
osdInfo
,
ioState
)
=
IOStGetOSDInfo
ioState
#
(
myEvent
,
replyToOS
,
deviceEvent
,
ioState
)
=
filterToolbarEvent
osdInfo
osEvent
ioState
#
pState
=
{
pState
&
io
=
ioState
}
schedulerEvent
=
if
(
isJust
replyToOS
)
(
ScheduleOSEvent
osEvent
(
fromJust
replyToOS
))
schedulerEvent
=
(
myEvent
,
deviceEvent
,
schedulerEvent
,
pState
)
|
isMenuOSEvent
ccMsg
#
(
processStack
,
ioState
)
=
IOStGetProcessStack
ioState
(
found
,
systemId
)
=
topShowProcessShowState
processStack
#
(
ioId
,
ioState
)
=
IOStGetIOId
ioState
#
(
tb
,
ioState
)
=
getIOToolbox
ioState
#
(
mDevice
,
ioState
)
=
IOStGetDevice
MenuDevice
ioState
menus
=
MenuSystemStateGetMenuHandles
mDevice
#
(
myEvent
,
replyToOS
,
deviceEvent
,
menus
,
tb
)
=
filterOSEvent
osEvent
(
found
&&
systemId
==
ioId
)
menus
tb
#
ioState
=
IOStSetDevice
(
MenuSystemState
menus
)
ioState
#
ioState
=
setIOToolbox
tb
ioState
#
pState
=
{
pState
&
io
=
ioState
}
schedulerEvent
=
if
(
isJust
replyToOS
)
(
ScheduleOSEvent
osEvent
(
fromJust
replyToOS
))
schedulerEvent
=
(
myEvent
,
deviceEvent
,
schedulerEvent
,
pState
)
|
otherwise
=
(
False
,
Nothing
,
schedulerEvent
,
pState
)
where
isMenuOSEvent
::
!
Int
->
Bool
isMenuOSEvent
CcWmCOMMAND
=
True
isMenuOSEvent
_
=
False
isToolbarOSEvent
::
!
Int
->
Bool
isToolbarOSEvent
CcWmBUTTONCLICKED
=
True
isToolbarOSEvent
CcWmGETTOOLBARTIPTEXT
=
True
isToolbarOSEvent
_
=
False
menuEvent
schedulerEvent
=:(
ScheduleMsgEvent
msgEvent
)
pState
=:{
io
=
ioState
}
#
(
ioId
,
ioState
)
=
IOStGetIOId
ioState
|
ioId
<>
recLoc
.
rlIOId
||
recLoc
.
rlDevice
<>
MenuDevice
=
(
False
,
Nothing
,
schedulerEvent
,{
pState
&
io
=
ioState
})
menuEvent
schedulerEvent
pState
#
(
hasMenuDevice
,
pState
)
=
accPIO
(
IOStHasDevice
MenuDevice
)
pState
|
not
hasMenuDevice
// This condition should never hold
=
menueventFatalError
"menuEvent"
"MenuDevice.dEvent applied while MenuDevice not present in IOSt"
|
otherwise
#
(
mDevice
,
ioState
)
=
IOStGetDevice
MenuDevice
ioState
menus
=
MenuSystemStateGetMenuHandles
mDevice
(
found
,
menus
)
=
hasMenuHandlesMenu
recLoc
.
rlParentId
menus
deviceEvent
=
if
found
(
Just
(
ReceiverEvent
msgEvent
))
Nothing
#
ioState
=
IOStSetDevice
(
MenuSystemState
menus
)
ioState
=
(
found
,
deviceEvent
,
schedulerEvent
,{
pState
&
io
=
ioState
})
=
menuEvent
schedulerEvent
pState
where
recLoc
=
getMsgEventRecLoc
msgEvent
menuEvent
::
!
SchedulerEvent
!(
PSt
.
l
.
p
)
->
(!
Bool
,!
Maybe
DeviceEvent
,!
SchedulerEvent
,!
PSt
.
l
.
p
)
menuEvent
schedulerEvent
=:(
ScheduleOSEvent
osEvent
=:{
ccMsg
}
_)
pState
=:{
io
=
ioState
}
|
isToolbarOSEvent
ccMsg
#
(
osdInfo
,
ioState
)
=
IOStGetOSDInfo
ioState
#
(
myEvent
,
replyToOS
,
deviceEvent
,
ioState
)
=
filterToolbarEvent
osdInfo
osEvent
ioState
#
pState
=
{
pState
&
io
=
ioState
}
schedulerEvent
=
if
(
isJust
replyToOS
)
(
ScheduleOSEvent
osEvent
(
fromJust
replyToOS
))
schedulerEvent
=
(
myEvent
,
deviceEvent
,
schedulerEvent
,
pState
)
|
isMenuOSEvent
ccMsg
#
(
processStack
,
ioState
)
=
IOStGetProcessStack
ioState
(
found
,
systemId
)
=
topShowProcessShowState
processStack
#
(
ioId
,
ioState
)
=
IOStGetIOId
ioState
#
(
tb
,
ioState
)
=
getIOToolbox
ioState
#
(
found
,
mDevice
,
ioState
)
=
IOStGetDevice
MenuDevice
ioState
#
menus
=
MenuSystemStateGetMenuHandles
mDevice
#
(
myEvent
,
replyToOS
,
deviceEvent
,
menus
,
tb
)
=
filterOSEvent
osEvent
(
found
&&
systemId
==
ioId
)
menus
tb
#
ioState
=
IOStSetDevice
(
MenuSystemState
menus
)
ioState
#
ioState
=
setIOToolbox
tb
ioState
#
pState
=
{
pState
&
io
=
ioState
}
schedulerEvent
=
if
(
isJust
replyToOS
)
(
ScheduleOSEvent
osEvent
(
fromJust
replyToOS
))
schedulerEvent
=
(
myEvent
,
deviceEvent
,
schedulerEvent
,
pState
)
|
otherwise
=
(
False
,
Nothing
,
schedulerEvent
,
pState
)
where
isMenuOSEvent
::
!
Int
->
Bool
isMenuOSEvent
CcWmCOMMAND
=
True
isMenuOSEvent
_
=
False
isToolbarOSEvent
::
!
Int
->
Bool
isToolbarOSEvent
CcWmBUTTONCLICKED
=
True
isToolbarOSEvent
CcWmGETTOOLBARTIPTEXT
=
True
isToolbarOSEvent
_
=
False
hasMenuHandlesMenu
::
!
Id
!(
MenuHandles
.
pst
)
->
(!
Bool
,!
MenuHandles
.
pst
)
hasMenuHandlesMenu
menuId
mHs
=:{
mMenus
}
#
(
found
,
mMenus
)=
UContains
(
eqMenuId
menuId
)
mMenus
=
(
found
,{
mHs
&
mMenus
=
mMenus
})
menuEvent
schedulerEvent
=:(
ScheduleMsgEvent
msgEvent
)
pState
=:{
io
=
ioState
}
#
(
ioId
,
ioState
)
=
IOStGetIOId
ioState
|
ioId
<>
recLoc
.
rlIOId
||
recLoc
.
rlDevice
<>
MenuDevice
=
(
False
,
Nothing
,
schedulerEvent
,{
pState
&
io
=
ioState
})
|
otherwise
#
(
found
,
mDevice
,
ioState
)
=
IOStGetDevice
MenuDevice
ioState
menus
=
MenuSystemStateGetMenuHandles
mDevice
(
found
,
menus
)
=
hasMenuHandlesMenu
recLoc
.
rlParentId
menus
deviceEvent
=
if
found
(
Just
(
ReceiverEvent
msgEvent
))
Nothing
#
ioState
=
IOStSetDevice
(
MenuSystemState
menus
)
ioState
=
(
found
,
deviceEvent
,
schedulerEvent
,{
pState
&
io
=
ioState
})
where
eqMenuId
::
!
Id
!(
MenuStateHandle
.
pst
)
->
(!
Bool
,!
MenuStateHandle
.
pst
)
eqMenuId
theId
msH
#
(
mId
,
msH
)
=
menuStateHandleGetMenuId
msH
=
(
theId
==
mId
,
msH
)
menuEvent
schedulerEvent
pState
=
(
False
,
Nothing
,
schedulerEvent
,
pState
)
recLoc
=
getMsgEventRecLoc
msgEvent
hasMenuHandlesMenu
::
!
Id
!(
MenuHandles
.
pst
)
->
(!
Bool
,!
MenuHandles
.
pst
)
hasMenuHandlesMenu
menuId
mHs
=:{
mMenus
}
#
(
found
,
mMenus
)=
UContains
(
eqMenuId
menuId
)
mMenus
=
(
found
,{
mHs
&
mMenus
=
mMenus
})
where
eqMenuId
::
!
Id
!(
MenuStateHandle
.
pst
)
->
(!
Bool
,!
MenuStateHandle
.
pst
)
eqMenuId
theId
msH
#
(
mId
,
msH
)
=
menuStateHandleGetMenuId
msH
=
(
theId
==
mId
,
msH
)
menuEvent
schedulerEvent
pState
=
(
False
,
Nothing
,
schedulerEvent
,
pState
)
/* filterToolbarEvent filters the OSEvents that can be handled by this menu device.
...
...
ObjectIO/ObjectIO/OS Windows/osdocumentinterface.dcl
View file @
328cbb14
...
...
@@ -10,39 +10,59 @@ from ostypes import HWND
from
StdIOCommon
import
DocumentInterface
,
MDI
,
SDI
,
NDI
::
OSDInfo
=
OSMDInfo
OSMDInfo
|
OSSDInfo
OSSDInfo
=
OSMDInfo
!
OSMDInfo
|
OSSDInfo
!
OSSDInfo
|
OSNoInfo
::
OSMDInfo
=
{
osmdFrame
::
!
HWND
// The frame window of the MDI frame window
,
osmdToolbar
::
!
Maybe
OSToolbar
// The toolbar of the MDI frame window (Nothing if no toolbar)
,
osmdClient
::
!
HWND
// The client window of the MDI frame window
,
osmdMenubar
::
!
HMENU
// The menu bar of the MDI frame window
,
osmdWindowMenu
::
!
HMENU
// The Window menu in the menu bar
=
{
osmdOSInfo
::
!
OSInfo
// The general document interface infrastructure
,
osmdWindowMenu
::
!
HMENU
// The Window menu in the MDI menu bar
}
::
OSSDInfo
=
{
ossdFrame
::
!
HWND
// The frame window of the SDI frame window
,
ossdToolbar
::
!
Maybe
OSToolbar
// The toolbar of the SDI frame window (Nothing if no toolbar)
,
ossdClient
::
!
HWND
// The client window of the SDI frame window
,
ossdMenubar
::
!
HMENU
// The menu bar of the SDI frame window
=
{
ossdOSInfo
::
!
OSInfo
// The general document interface infrastructure
}
::
OSInfo
=
{
osFrame
::
!
HWND
// The frame window of the (M/S)DI frame window
,
osToolbar
::
!
Maybe
OSToolbar
// The toolbar of the (M/S)DI frame window (Nothing if no toolbar)
,
osClient
::
!
HWND
// The client window of the (M/S)DI frame window
,
osMenuBar
::
!
HMENU
// The menu bar of the (M/S)DI frame window
}
::
OSMenuBar
=
{
menuBar
::
!
HMENU
,
menuWindow
::
!
HWND
,
menuClient
::
!
HWND
}
/* emptyOSDInfo creates a OSDInfo with dummy values for the argument document interface.
*/
emptyOSDInfo
::
!
DocumentInterface
->
OSDInfo
/* getOSDInfoDocumentInterface returns the DocumentInterface of the argument OSDInfo.
*/
getOSDInfoDocumentInterface
::
!
OSDInfo
->
DocumentInterface
/* getOSDInfoOSMenuBar returns the OSMenuBar info from the argument OSDInfo.
setOSDInfoOSMenuBar sets the OSMenuBar info in the OSDInfo.
*/
getOSDInfoOSMenuBar
::
!
OSDInfo
->
Maybe
OSMenuBar
setOSDInfoOSMenuBar
::
!
OSMenuBar
!
OSDInfo
->
OSDInfo
/* getOSDInfoOSInfo returns the OSInfo from the argument OSDInfo if present.
setOSDInfoOSInfo sets the OSInfo in the OSDInfo.
*/
getOSDInfoOSInfo
::
!
OSDInfo
->
Maybe
OSInfo
setOSDInfoOSInfo
::
!
OSInfo
!
OSDInfo
->
OSDInfo
/* OSopenMDI creates the infrastructure of a MDI process.
If the first Bool argument is True, then the frame window is shown, otherwise it is hidden.
The second Bool indicates whether the process accepts file open events.
OScloseMDI destroys the infrastructure of a MDI process.
OSopenSDI creates the infrastructure of a SDI process.
The Bool argument indicates whether the process accepts file open events.
OScloseSDI destroys the infrastructure
of a SDI process
.
OSclose
O
SDI
nfo
destroys the infrastructure.
*/
OSopenMDI
::
!
Bool
!
Bool
!*
OSToolbox
->
(!
OSMDInfo
,!*
OSToolbox
)
OScloseMDI
::
!
OSMDInfo
!*
OSToolbox
->
*
OSToolbox
OSopenSDI
::
!
Bool
!*
OSToolbox
->
(!
OSSDInfo
,!*
OSToolbox
)
OScloseSDI
::
!
OSSDInfo
!*
OSToolbox
->
*
OSToolbox
OSopenMDI
::
!
Bool
!
Bool
!*
OSToolbox
->
(!
OSDInfo
,!*
OSToolbox
)
OSopenSDI
::
!
Bool
!*
OSToolbox
->
(!
OSDInfo
,!*
OSToolbox
)
OScloseOSDInfo
::
!
OSDInfo
!*
OSToolbox
->
*
OSToolbox
// getOSDInfoOSToolbar retrieves the OSToolbar, if any.
/* getOSDInfoOSToolbar retrieves the OSToolbar, if any.
*/
getOSDInfoOSToolbar
::
!
OSDInfo
->
Maybe
OSToolbar
ObjectIO/ObjectIO/OS Windows/osdocumentinterface.icl
View file @
328cbb14
...
...
@@ -11,21 +11,26 @@ from StdIOCommon import DocumentInterface, MDI, SDI, NDI
::
OSDInfo
=
OSMDInfo
OSMDInfo
|
OSSDInfo
OSSDInfo
=
OSMDInfo
!
OSMDInfo
|
OSSDInfo
!
OSSDInfo
|
OSNoInfo
::
OSMDInfo
=
{
osmdFrame
::
!
HWND
// The frame window of the MDI frame window
,
osmdToolbar
::
!
Maybe
OSToolbar
// The toolbar of the MDI frame window (Nothing if no toolbar)
,
osmdClient
::
!
HWND
// The client window of the MDI frame window
,
osmdMenubar
::
!
HMENU
// The menu bar of the MDI frame window
,
osmdWindowMenu
::
!
HMENU
// The Window menu in the menu bar
=
{
osmdOSInfo
::
!
OSInfo
// The general document interface infrastructure
,
osmdWindowMenu
::
!
HMENU
// The Window menu in the MDI menu bar
}
::
OSSDInfo
=
{
ossdFrame
::
!
HWND
// The frame window of the SDI frame window
,
ossdToolbar
::
!
Maybe
OSToolbar
// The toolbar of the SDI frame window (Nothing if no toolbar)
,
ossdClient
::
!
HWND
// The client window of the SDI frame window
,
ossdMenubar
::
!
HMENU
// The menu bar of the SDI frame window
=
{
ossdOSInfo
::
!
OSInfo
// The general document interface infrastructure
}
::
OSInfo
=
{
osFrame
::
!
HWND
// The frame window of the (M/S)DI frame window
,
osToolbar
::
!
Maybe
OSToolbar
// The toolbar of the (M/S)DI frame window (Nothing if no toolbar)
,
osClient
::
!
HWND
// The client window of the (M/S)DI frame window
,
osMenuBar
::
!
HMENU
// The menu bar of the (M/S)DI frame window
}
::
OSMenuBar
=
{
menuBar
::
!
HMENU
,
menuWindow
::
!
HWND
,
menuClient
::
!
HWND
}
...
...
@@ -34,17 +39,67 @@ osdocumentinterfaceFatalError function error
=
FatalError
function
"osdocumentinterface"
error
/* emptyOSDInfo creates a OSDInfo with dummy values for the argument document interface.
*/
emptyOSDInfo
::
!
DocumentInterface
->
OSDInfo
emptyOSDInfo
di
=
case
di
of
MDI
->
OSMDInfo
{
osmdOSInfo
=
emptyOSInfo
,
osmdWindowMenu
=(
-1
)}
SDI
->
OSSDInfo
{
ossdOSInfo
=
emptyOSInfo
}
NDI
->
OSNoInfo
where
emptyOSInfo
=
{
osFrame
=(
-1
),
osToolbar
=
Nothing
,
osClient
=(
-1
),
osMenuBar
=(
-1
)}
/* getOSDInfoDocumentInterface returns the DocumentInterface of the argument OSDInfo.
*/
getOSDInfoDocumentInterface
::
!
OSDInfo
->
DocumentInterface
getOSDInfoDocumentInterface
(
OSMDInfo
_)
=
MDI
getOSDInfoDocumentInterface
(
OSSDInfo
_)
=
SDI
getOSDInfoDocumentInterface
OSNoInfo
=
NDI
/* getOSDInfoOSMenuBar returns the OSMenuBar info from the argument OSDInfo.
setOSDInfoOSMenuBar sets the OSMenuBar info in the OSDInfo.
*/
getOSDInfoOSMenuBar
::
!
OSDInfo
->
Maybe
OSMenuBar
getOSDInfoOSMenuBar
osdInfo
=
case
osdInfo
of
OSMDInfo
{
osmdOSInfo
}
->
get
osmdOSInfo
OSSDInfo
{
ossdOSInfo
}
->
get
ossdOSInfo
osnoinfo
->
Nothing
where
get
{
osFrame
,
osClient
,
osMenuBar
}
=
Just
{
menuBar
=
osMenuBar
,
menuWindow
=
osFrame
,
menuClient
=
osClient
}
setOSDInfoOSMenuBar
::
!
OSMenuBar
!
OSDInfo
->
OSDInfo
setOSDInfoOSMenuBar
{
menuBar
,
menuWindow
,
menuClient
}
osdInfo
=
case
osdInfo
of
OSMDInfo
mdi
=:{
osmdOSInfo
=
info
}
->
OSMDInfo
{
mdi
&
osmdOSInfo
=
set
info
}
OSSDInfo
sdi
=:{
ossdOSInfo
=
info
}
->
OSSDInfo
{
sdi
&
ossdOSInfo
=
set
info
}
osnoinfo
->
osnoinfo
where
set
info
=
{
info
&
osMenuBar
=
menuBar
,
osFrame
=
menuWindow
,
osClient
=
menuClient
}
/* getOSDInfoOSInfo returns the OSInfo from the argument OSDInfo if present.
setOSDInfoOSInfo sets the OSInfo in the OSDInfo.
*/
getOSDInfoOSInfo
::
!
OSDInfo
->
Maybe
OSInfo
getOSDInfoOSInfo
(
OSMDInfo
{
osmdOSInfo
})
=
Just
osmdOSInfo
getOSDInfoOSInfo
(
OSSDInfo
{
ossdOSInfo
})
=
Just
ossdOSInfo
getOSDInfoOSInfo
osnoinfo
=
Nothing
setOSDInfoOSInfo
::
!
OSInfo
!
OSDInfo
->
OSDInfo
setOSDInfoOSInfo
osinfo
(
OSMDInfo
osm
)
=
OSMDInfo
{
osm
&
osmdOSInfo
=
osinfo
}
setOSDInfoOSInfo
osinfo
(
OSSDInfo
oss
)
=
OSSDInfo
{
oss
&
ossdOSInfo
=
osinfo
}
setOSDInfoOSInfo
_
osnoinfo
=
osnoinfo
/* OSopenMDI creates the infrastructure of an MDI process.
If the first Bool argument is True, then the frame window is shown, otherwise it is hidden.
The second Bool indicates whether the process accepts file open events.
*/
OSopenMDI
::
!
Bool
!
Bool
!*
OSToolbox
->
(!
OS
M
DInfo
,!*
OSToolbox
)
OSopenMDI
::
!
Bool
!
Bool
!*
OSToolbox
->
(!
OSDInfo
,!*
OSToolbox
)
OSopenMDI
show
acceptFileOpen
tb
#
createCci
=
Rq2Cci
CcRqCREATEMDIFRAMEWINDOW
(
toInt
show
)
(
toInt
acceptFileOpen
)
#
(
returncci
,
tb
)
=
IssueCleanRequest2
osCreateMDIWindowCallback
createCci
tb
...
...
@@ -53,7 +108,14 @@ OSopenMDI show acceptFileOpen tb
CcRETURN4
->
(
returncci
.
p1
,
returncci
.
p2
,
returncci
.
p3
,
returncci
.
p4
)
CcWASQUIT
->
(
OSNoWindowPtr
,
OSNoWindowPtr
,
OSNoWindowPtr
,
OSNoWindowPtr
)
msg
->
osdocumentinterfaceFatalError
"OSopenMDI"
(
"CcRETURN4 expected instead of "
+++
toString
msg
)
=
({
osmdFrame
=
framePtr
,
osmdToolbar
=
Nothing
,
osmdClient
=
clientPtr
,
osmdMenubar
=
menuBar
,
osmdWindowMenu
=
windowMenu
},
tb
)
#
osmdinfo
=
{
osmdOSInfo
=
{
osFrame
=
framePtr
,
osToolbar
=
Nothing
,
osClient
=
clientPtr
,
osMenuBar
=
menuBar
}
,
osmdWindowMenu
=
windowMenu
}
=
(
OSMDInfo
osmdinfo
,
tb
)
where
osCreateMDIWindowCallback
::
!
CrossCallInfo
!*
OSToolbox
->
(!
CrossCallInfo
,!*
OSToolbox
)
osCreateMDIWindowCallback
{
ccMsg
=
CcWmDEACTIVATE
}
tb
...
...
@@ -63,11 +125,7 @@ where
osCreateMDIWindowCallback
{
ccMsg
}
tb
=
osdocumentinterfaceFatalError
"osCreateMDIWindowCallback"
(
"received message nr:"
+++
toString
ccMsg
)
OScloseMDI
::
!
OSMDInfo
!*
OSToolbox
->
*
OSToolbox
OScloseMDI
{
osmdFrame
}
tb
=
snd
(
IssueCleanRequest2
(
osDestroyProcessWindowCallback
"OScloseMDI"
)
(
Rq1Cci
CcRqDESTROYWINDOW
osmdFrame
)
tb
)
OSopenSDI
::
!
Bool
!*
OSToolbox
->
(!
OSSDInfo
,!*
OSToolbox
)
OSopenSDI
::
!
Bool
!*
OSToolbox
->
(!
OSDInfo
,!*
OSToolbox
)
OSopenSDI
acceptFileOpen
tb
#
createCci
=
Rq1Cci
CcRqCREATESDIFRAMEWINDOW
(
toInt
acceptFileOpen
)
#
(
returncci
,
tb
)
=
IssueCleanRequest2
osCreateSDIWindowCallback
createCci
tb
...
...
@@ -75,7 +133,8 @@ OSopenSDI acceptFileOpen tb
CcRETURN2
->
(
returncci
.
p1
,
returncci
.
p2
)
CcWASQUIT
->
(
OSNoWindowPtr
,
OSNoWindowPtr
)
msg
->
osdocumentinterfaceFatalError
"OSopenSDI"
(
"CcRETURN2 expected instead of "
+++
toString
msg
)
=
({
ossdFrame
=
framePtr
,
ossdToolbar
=
Nothing
,
ossdClient
=
OSNoWindowPtr
,
ossdMenubar
=
menuBar
},
tb
)
#
ossdinfo
=
{
ossdOSInfo
=
{
osFrame
=
framePtr
,
osToolbar
=
Nothing
,
osClient
=
OSNoWindowPtr
,
osMenuBar
=
menuBar
}
}
=
(
OSSDInfo
ossdinfo
,
tb
)
where
osCreateSDIWindowCallback
::
!
CrossCallInfo
!*
OSToolbox
->
(!
CrossCallInfo
,!*
OSToolbox
)
osCreateSDIWindowCallback
{
ccMsg
=
CcWmDEACTIVATE
}
tb
...
...
@@ -85,9 +144,13 @@ where
osCreateSDIWindowCallback
{
ccMsg
}
tb
=
osdocumentinterfaceFatalError
"osCreateSDIWindowCallback"
(
"received message nr:"
+++
toString
ccMsg
)
OScloseSDI
::
!
OSSDInfo
!*
OSToolbox
->
*
OSToolbox
OScloseSDI
{
ossdFrame
}
tb
=
snd
(
IssueCleanRequest2
(
osDestroyProcessWindowCallback
"OScloseSDI"
)
(
Rq1Cci
CcRqDESTROYWINDOW
ossdFrame
)
tb
)
OScloseOSDInfo
::
!
OSDInfo
!*
OSToolbox
->
*
OSToolbox
OScloseOSDInfo
(
OSMDInfo
{
osmdOSInfo
={
osFrame
}})
tb
=
snd
(
IssueCleanRequest2
(
osDestroyProcessWindowCallback
"OScloseMDI"
)
(
Rq1Cci
CcRqDESTROYWINDOW
osFrame
)
tb
)
OScloseOSDInfo
(
OSSDInfo
{
ossdOSInfo
={
osFrame
}})
tb
=
snd
(
IssueCleanRequest2
(
osDestroyProcessWindowCallback
"OScloseSDI"
)
(
Rq1Cci
CcRqDESTROYWINDOW
osFrame
)
tb
)
OScloseOSDInfo
_
tb
=
tb
osDestroyProcessWindowCallback
::
String
!
CrossCallInfo
!*
OSToolbox
->
(!
CrossCallInfo
,!*
OSToolbox
)
osDestroyProcessWindowCallback
function
{
ccMsg
=
CcWmDEACTIVATE
}
tb
...
...
@@ -101,6 +164,6 @@ osDestroyProcessWindowCallback function {ccMsg} tb
// getOSDInfoOSToolbar retrieves the OSToolbar, if any.
getOSDInfoOSToolbar
::
!
OSDInfo
->
Maybe
OSToolbar
getOSDInfoOSToolbar
(
OSMDInfo
{
osmdToolbar
}
)
=
os
md
Toolbar
getOSDInfoOSToolbar
(
OSSDInfo
{
ossdToolbar
}
)
=
os
sd
Toolbar
getOSDInfoOSToolbar
_
=
Nothing
getOSDInfoOSToolbar
(
OSMDInfo
{
osmd
OSInfo
={
os
Toolbar
}
})
=
osToolbar
getOSDInfoOSToolbar
(
OSSDInfo
{
ossd
OSInfo
={
os
Toolbar
}
})
=
osToolbar
getOSDInfoOSToolbar
_
=
Nothing
ObjectIO/ObjectIO/OS Windows/osmenu.dcl
View file @
328cbb14
...
...
@@ -4,14 +4,15 @@ definition module osmenu
// Clean Object I/O library, version 1.2
from
menuCrossCall_12
import
HMENU
,
HITEM
from
osdocumentinterface
import
OSMenuBar
from
ostoolbox
import
OSToolbox
from
ostypes
import
HWND
from
oswindow
import
OSWindowPtr
from
menuCrossCall_12
import
HMENU
,
HITEM
// Types for menus and menu elements:
::
MenuBar
/*
:: MenuBar
= NoMenuBar
| MenuBar OSMenuBar
:: OSMenuBar
...
...
@@ -19,6 +20,7 @@ from menuCrossCall_12 import HMENU, HITEM
, menuWindow :: !HWND
, menuClient :: !HWND // If MDI: client window; otherwise: OSNoWindowPtr
}
*/
::
OSMenu
:==
HMENU
::
OSMenuItem
:==
HITEM
::
OSMenuSeparator
:==
HITEM
...
...
@@ -32,9 +34,9 @@ OSNoMenuSeparator :== 0
/* Creation of a OSMenuBar:
OSMenuBarNew frameWindow clientWindow menu
creates an OSMenuBar instance that can be used to manipulate menus.
*/
PA---
OSMenuBarNew :: !HWND !HWND !HMENU -> OSMenuBar
*/
/* Enabling and disabling of menus and menu elements:
OS(Dis/En)ableMenu index menubar
...
...
ObjectIO/ObjectIO/OS Windows/osmenu.icl
View file @
328cbb14
...
...
@@ -6,11 +6,12 @@ implementation module osmenu
import
StdBool
,
StdChar
,
StdClass
,
StdInt
,
StdString
import
menuCrossCall_12
from
oswindow
import
OSWindowPtr
,
OSNoWindowPtr
from
osdocumentinterface
import
OSMenuBar
from
oswindow
import
OSWindowPtr
,
OSNoWindowPtr
// Types for menus and menu elements:
::
MenuBar
/*
:: MenuBar
= NoMenuBar
| MenuBar OSMenuBar
:: OSMenuBar
...
...
@@ -18,6 +19,7 @@ from oswindow import OSWindowPtr, OSNoWindowPtr
, menuWindow :: !HWND
, menuClient :: !HWND // If MDI: client window; otherwise: OSNoWindowPtr
}
*/
::
OSMenuHandle
:==
HMENU
::
OSMenu
:==
HMENU
::
OSMenuItem
:==
HITEM
...
...
@@ -28,10 +30,11 @@ OSNoMenu :== 0
OSNoMenuItem
:==
0
OSNoMenuSeparator
:==
0
/* PA---
OSMenuBarNew :: !HWND !HWND !HMENU -> OSMenuBar
OSMenuBarNew frameWindow clientWindow menu
= {menuBar=menu, menuWindow=frameWindow, menuClient=clientWindow}
*/
// Enabling and disabling menus and menu elements:
...
...
ObjectIO/ObjectIO/OS Windows/oswindow.dcl
View file @
328cbb14
...
...
@@ -14,7 +14,7 @@ from osrgn import OSRgnHandle
from
ostoolbox
import
OSToolbox
from
ostypes
import
Rect
,
OSWindowPtr
,
HWND
from
ospicture
import
OSPictContext
from
osdocumentinterface
import
OSDInfo
,
OSMDInfo
,
OSSDInfo
,
OSToolbar
,
OSToolbarHandle
from
osdocumentinterface
import
OSDInfo
,
OSMDInfo
,
OSSDInfo
,
OSInfo
,
OSToolbar
,
OSToolbarHandle
OSNoWindowPtr
:==
-1
...
...
ObjectIO/ObjectIO/OS Windows/oswindow.icl
View file @
328cbb14
...
...
@@ -19,17 +19,14 @@ oswindowFatalError function error
OSGetProcessWindowDimensions
::
!
OSDInfo
!*
OSToolbox
->
(!
Rect
,!*
OSToolbox
)
OSGetProcessWindowDimensions
osdinfo
tb
|
framePtr
==
OSNoWindowPtr
||
clientPtr
==
OSNoWindowPtr
#
maybeOSInfo
=
getOSDInfoOSInfo
osdinfo
|
isNothing
maybeOSInfo
=
OSscreenrect
tb
|
otherwise
#
((
x
,
y
),
tb
)
=
OSgetWindowPos
framePtr
tb
#
((
w
,
h
),
tb
)
=
OSgetWindowViewFrameSize
clientPtr
tb
#
osinfo
=
fromJust
maybeOSInfo
#
((
x
,
y
),
tb
)
=
OSgetWindowPos
osinfo
.
osFrame
tb
#
((
w
,
h
),
tb
)
=
OSgetWindowViewFrameSize
osinfo
.
osClient
tb
=
({
rleft
=
x
,
rtop
=
y
,
rright
=
x
+
w
,
rbottom
=
y
+
h
},
tb
)
where
(
framePtr
,
clientPtr
)=
case
osdinfo
of
OSMDInfo
info
->
(
info
.
osmdFrame
,
info
.
osmdClient
)
OSSDInfo
info
->
(
info
.
ossdFrame
,
info
.
ossdClient
)
OSNoInfo
->
(
OSNoWindowPtr
,
OSNoWindowPtr
)
OSNoWindowPtr
:==
-1
...
...
@@ -218,10 +215,9 @@ OScreateDialog isModal isClosable title pos size behindPtr get_focus create_cont
_
->
oswindowCreateError
1
"OScreateDialog"
=
(
reverse
delay_info
,
wPtr
,
control_info
,
tb
)
where
parentptr
=
case
osdinfo
of
OSMDInfo
info
->
info
.
osmdFrame
OSSDInfo
info
->
info
.
ossdFrame
_
->
0
parentptr
=
case
(
getOSDInfoOSInfo
osdinfo
)
of
Nothing
->
0
Just
{
osFrame
}
->
osFrame
OScreateDialogCallback
::
!(.
s
->(
OSWindowPtr
,.
s
))
!(
OSWindowPtr
->.
s
->*
OSToolbox
->(.
s
,*
OSToolbox
))
...
...
@@ -271,57 +267,54 @@ OScreateWindow wMetrics isResizable hInfo=:{cbiHasScroll=hasHScroll} vInfo=:{cbi
get_focus
create_controls
update_controls
(
OSMDInfo
mdi
)
control_info
tb
#
(
textPtr
,
tb
)
=
WinMakeCString
title
tb
styleFlags
=
WS_SYSMENU
bitor
WS_OVERLAPPED
bitor
(
if
hasHScroll
WS_HSCROLL
0
)
bitor
(
if
hasVScroll
WS_VSCROLL
0
)
bitor
(
if
isResizable
WS_THICKFRAME
0
)
// bitor WS_CLIPCHILDREN
createcci
=
Rq6Cci
CcRqCREATEMDIDOCWINDOW
textPtr
mdi
.
osmdClient
(
x
<<
16
+(
y
<<
16
)>>
16
)
w
h
styleFlags
#
(
returncci
,(
control_info
,
delay_info
),
tb
)
=
IssueCleanRequest
(
OScreateWindowCallback
isResizable
minSize
maxSize
create_controls
update_controls
)
createcci
(
control_info
,[])
tb
#
tb
=
WinReleaseCString
textPtr
tb
wPtr
=
case
returncci
.
ccMsg
of
CcRETURN1
->
returncci
.
p1
CcWASQUIT
->
OSNoWindowPtr
_
->
oswindowCreateError
1
"OScreateWindow (MDI)"
#
tb
=
setScrollRangeAndPos
hasHScroll
False
wMetrics
SB_HORZ
hInfo
.
cbiState
(
0
,
0
)
wPtr
tb
#
tb
=
setScrollRangeAndPos
hasVScroll
False
wMetrics
SB_VERT
vInfo
.
cbiState
(
0
,
0
)
wPtr
tb
=
(
reverse
delay_info
,
wPtr
,
OSNoWindowPtr
,
OSNoWindowPtr
,
OSMDInfo
mdi
,
control_info
,
tb
)
where
(
x
,
y
)
=
pos
// packed into one 32-bit integer
(
w
,
h
)
=
size
OScreateWindow
wMetrics
isResizable
hInfo
=:{
cbiHasScroll
=
hasHScroll
}
vInfo
=:{
cbiHasScroll
=
hasVScroll
}
minSize
maxSize
isClosable
title
pos
size
get_focus
create_controls
update_controls
(
OSSDInfo
sdi
)
control_info
tb
#
styleFlags
=
(
if
hasHScroll
WS_HSCROLL
0
)
bitor
(
if
hasVScroll
WS_VSCROLL
0
)
createcci
=
Rq6Cci
CcRqCREATESDIDOCWINDOW
0
sdi
.
ossdFrame
(
x
<<
16
+(
y
<<
16
)>>
16
)
w
h
styleFlags
#
(
returncci
,(
control_info
,
delay_info
),
tb
)
=
IssueCleanRequest
(
OScreateWindowCallback
isResizable
minSize
maxSize
create_controls
update_controls
)
createcci
(
control_info
,[])
tb
clientPtr
=
case
returncci
.
ccMsg
of
CcRETURN1
->
returncci
.
p1
CcWASQUIT
->
OSNoWindowPtr
_
->
oswindowCreateError
1
"OScreateWindow (SDI)"
#
tb
=
setScrollRangeAndPos
hasHScroll
False
wMetrics
SB_HORZ
hInfo
.
cbiState
(
0
,
0
)
clientPtr
tb
#
tb
=
setScrollRangeAndPos
hasVScroll
False
wMetrics
SB_VERT
vInfo
.
cbiState
(
0
,
0
)
clientPtr
tb
#
tb
=
OSsetWindowTitle
sdi
.
ossdFrame
title
tb
=
(
reverse
delay_info
,
clientPtr
,
OSNoWindowPtr
,
OSNoWindowPtr
,
OSSDInfo
{
sdi
&
ossdClient
=
clientPtr
},
control_info
,
tb
)