Commit 328cbb14 authored by Peter Achten's avatar Peter Achten
Browse files

PA: internal structure improved to decrease size executable;

type IOStGetDevice changed.
parent 2ef2fcd8
......@@ -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.
......
......@@ -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.
OScloseOSDInfo 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
......@@ -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 -> (!OSMDInfo,!*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}) = osmdToolbar
getOSDInfoOSToolbar (OSSDInfo {ossdToolbar}) = ossdToolbar
getOSDInfoOSToolbar _ = Nothing
getOSDInfoOSToolbar (OSMDInfo {osmdOSInfo={osToolbar}}) = osToolbar
getOSDInfoOSToolbar (OSSDInfo {ossdOSInfo={osToolbar}}) = osToolbar
getOSDInfoOSToolbar _ = Nothing
......@@ -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
......
......@@ -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:
......
......@@ -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
......
......@@ -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