From 7553b7f9d4dddc2235c137d41de8ce22547bebe3 Mon Sep 17 00:00:00 2001 From: Camil Staps Date: Wed, 1 Jul 2015 17:36:37 +0200 Subject: Initial commit --- osdocumentinterface.icl | 191 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 191 insertions(+) create mode 100644 osdocumentinterface.icl (limited to 'osdocumentinterface.icl') diff --git a/osdocumentinterface.icl b/osdocumentinterface.icl new file mode 100644 index 0000000..e01ee6c --- /dev/null +++ b/osdocumentinterface.icl @@ -0,0 +1,191 @@ +implementation module osdocumentinterface + + +import StdMaybe, StdOverloaded, StdString, StdTuple +import clCrossCall_12, ostoolbar, ossystem, ostypes, windowCrossCall_12 +from commondef import fatalError +from StdIOCommon import :: DocumentInterface(..) +import code from "cCrossCallxDI_121.o" + + +:: OSDInfo + = OSMDInfo !OSMDInfo + | OSSDInfo !OSSDInfo + | OSNoInfo +:: OSMDInfo + = { osmdOSInfo :: !OSInfo // The general document interface infrastructure + , osmdWindowMenu :: !HMENU // The Window menu in the MDI menu bar + } +:: OSSDInfo + = { 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 + } + + +osdocumentinterfaceFatalError :: String String -> .x +osdocumentinterfaceFatalError function error + = fatalError function "osdocumentinterface" error + +osInitialiseDI :: !*OSToolbox -> *OSToolbox +osInitialiseDI _ + = code + { + .inline InstallCrossCallxDI + ccall InstallCrossCallxDI "I-I" + .end + } + +/* 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 -> (!OSDInfo,!*OSToolbox) +osOpenMDI show acceptFileOpen tb + # createCci = Rq2Cci CcRqCREATEMDIFRAMEWINDOW (toInt show) (toInt acceptFileOpen) + # (returncci,tb) = issueCleanRequest2 osCreateMDIWindowCallback createCci tb + (framePtr,clientPtr,menuBar,windowMenu) + = case returncci.ccMsg of + CcRETURN4 -> (returncci.p1,returncci.p2,returncci.p3,returncci.p4) + CcWASQUIT -> (OSNoWindowPtr,OSNoWindowPtr,OSNoWindowPtr,OSNoWindowPtr) + msg -> osdocumentinterfaceFatalError "OSopenMDI" ("CcRETURN4 expected instead of "+++toString msg) + # 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 + = (return0Cci,tb) + osCreateMDIWindowCallback {ccMsg=CcWmACTIVATE} tb + = (return0Cci,tb) + osCreateMDIWindowCallback {ccMsg=CcWmKILLFOCUS} tb /* PA: added. Shouldn't ControlDeactivate be delayed? */ + = (return0Cci,tb) + osCreateMDIWindowCallback {ccMsg} tb + = osdocumentinterfaceFatalError "osCreateMDIWindowCallback" ("received message nr:"+++toString ccMsg) + +osOpenSDI :: !Bool !*OSToolbox -> (!OSDInfo,!*OSToolbox) +osOpenSDI acceptFileOpen tb + # createCci = Rq1Cci CcRqCREATESDIFRAMEWINDOW (toInt acceptFileOpen) + # (returncci,tb) = issueCleanRequest2 osCreateSDIWindowCallback createCci tb + (framePtr,menuBar)= case returncci.ccMsg of + CcRETURN2 -> (returncci.p1,returncci.p2) + CcWASQUIT -> (OSNoWindowPtr,OSNoWindowPtr) + msg -> osdocumentinterfaceFatalError "OSopenSDI" ("CcRETURN2 expected instead of "+++toString msg) + # ossdinfo = { ossdOSInfo = {osFrame=framePtr,osToolbar=Nothing,osClient=OSNoWindowPtr,osMenuBar=menuBar} } + = (OSSDInfo ossdinfo,tb) +where + osCreateSDIWindowCallback :: !CrossCallInfo !*OSToolbox -> (!CrossCallInfo,!*OSToolbox) + osCreateSDIWindowCallback {ccMsg=CcWmDEACTIVATE} tb + = (return0Cci,tb) + osCreateSDIWindowCallback {ccMsg=CcWmACTIVATE} tb + = (return0Cci,tb) + osCreateSDIWindowCallback {ccMsg=CcWmKILLFOCUS} tb /* PA: added. Shouldn't ControlDeactivate be delayed? */ + = (return0Cci,tb) + osCreateSDIWindowCallback {ccMsg} tb + = osdocumentinterfaceFatalError "osCreateSDIWindowCallback" ("received message nr:"+++toString ccMsg) + +osOpenNDI :: !*OSToolbox -> (!OSDInfo,!*OSToolbox) // PA: added. Dummy on Windows. +osOpenNDI tb + = (OSNoInfo,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 _ {ccMsg=CcWmDEACTIVATE} tb + = (return0Cci,tb) +osDestroyProcessWindowCallback _ {ccMsg=CcWmACTIVATE} tb + = (return0Cci,tb) +osDestroyProcessWindowCallback _ {ccMsg=CcWmKEYBOARD} tb + = (return0Cci,tb) +osDestroyProcessWindowCallback _ {ccMsg=CcWmPAINT,p1=hwnd} tb + = (return0Cci,winFakePaint hwnd tb) +osDestroyProcessWindowCallback function {ccMsg} tb + = osdocumentinterfaceFatalError function ("received message nr:"+++toString ccMsg) + +// getOSDInfoOSToolbar retrieves the OSToolbar, if any. +getOSDInfoOSToolbar :: !OSDInfo -> Maybe OSToolbar +getOSDInfoOSToolbar (OSMDInfo {osmdOSInfo={osToolbar}}) = osToolbar +getOSDInfoOSToolbar (OSSDInfo {ossdOSInfo={osToolbar}}) = osToolbar +getOSDInfoOSToolbar _ = Nothing + +/* osOSDInfoIsActive tests if the given OSDInfo represents the interactive process with the + active menu system. (Always True on Windows; use menu bar on Mac.) +*/ +osOSDInfoIsActive :: !OSDInfo !*OSToolbox -> (!Bool, !*OSToolbox) +osOSDInfoIsActive osdinfo tb = (True,tb) -- cgit v1.2.3