osdocumentinterface.icl 7.15 KB
Newer Older
Peter Achten's avatar
Peter Achten committed
1
2
3
4
5
6
7
implementation module osdocumentinterface


//	Clean object I/O library, version 1.2


import	StdMaybe, StdTuple
8
import	clCrossCall_12, ostoolbar, ossystem, ostypes, windowCrossCall_12
Peter Achten's avatar
Peter Achten committed
9
10
11
12
13
from	commondef	import FatalError,String
from	StdIOCommon	import DocumentInterface, MDI, SDI, NDI


::	OSDInfo
14
15
	=	OSMDInfo !OSMDInfo
	|	OSSDInfo !OSSDInfo
Peter Achten's avatar
Peter Achten committed
16
17
	|	OSNoInfo
::	OSMDInfo
18
19
	=	{	osmdOSInfo		:: !OSInfo			// The general document interface infrastructure
		,	osmdWindowMenu	:: !HMENU			// The Window menu in the MDI menu bar
Peter Achten's avatar
Peter Achten committed
20
21
		}
::	OSSDInfo
22
23
24
25
26
27
28
29
30
31
32
33
	=	{	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
Peter Achten's avatar
Peter Achten committed
34
35
36
37
38
39
40
41
		}


osdocumentinterfaceFatalError :: String String -> .x
osdocumentinterfaceFatalError function error
	= FatalError function "osdocumentinterface" error


42
43
44
45
46
47
48
49
50
51
52
53
54
55
/*	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.
*/
Peter Achten's avatar
Peter Achten committed
56
57
58
59
60
61
getOSDInfoDocumentInterface :: !OSDInfo -> DocumentInterface
getOSDInfoDocumentInterface (OSMDInfo _)	= MDI
getOSDInfoDocumentInterface (OSSDInfo _)	= SDI
getOSDInfoDocumentInterface OSNoInfo		= NDI


62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
/*	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


Peter Achten's avatar
Peter Achten committed
98
99
100
101
/*	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.
*/
102
OSopenMDI :: !Bool !Bool !*OSToolbox -> (!OSDInfo,!*OSToolbox)
Peter Achten's avatar
Peter Achten committed
103
104
105
106
107
108
109
110
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)
111
112
113
114
115
116
117
118
	# osmdinfo			= {	osmdOSInfo		= {	osFrame		= framePtr
											  ,	osToolbar	= Nothing
											  ,	osClient	= clientPtr
											  ,	osMenuBar	= menuBar
											  }
						  ,	osmdWindowMenu	= windowMenu
						  }
	= (OSMDInfo osmdinfo,tb)
Peter Achten's avatar
Peter Achten committed
119
120
121
122
123
124
where
	osCreateMDIWindowCallback :: !CrossCallInfo !*OSToolbox -> (!CrossCallInfo,!*OSToolbox)
	osCreateMDIWindowCallback {ccMsg=CcWmDEACTIVATE} tb
		= (Return0Cci,tb)
	osCreateMDIWindowCallback {ccMsg=CcWmACTIVATE} tb
		= (Return0Cci,tb)
125
126
	osCreateMDIWindowCallback {ccMsg=CcWmKILLFOCUS} tb		/* PA: added. Shouldn't ControlDeactivate be delayed? */
		= (Return0Cci,tb)
Peter Achten's avatar
Peter Achten committed
127
128
129
	osCreateMDIWindowCallback {ccMsg} tb
		= osdocumentinterfaceFatalError "osCreateMDIWindowCallback" ("received message nr:"+++toString ccMsg)

130
OSopenSDI :: !Bool !*OSToolbox -> (!OSDInfo,!*OSToolbox)
Peter Achten's avatar
Peter Achten committed
131
132
133
134
135
136
137
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)
138
139
	# ossdinfo			= {	ossdOSInfo = {osFrame=framePtr,osToolbar=Nothing,osClient=OSNoWindowPtr,osMenuBar=menuBar} }
	= (OSSDInfo ossdinfo,tb)
Peter Achten's avatar
Peter Achten committed
140
141
142
143
144
145
where
	osCreateSDIWindowCallback :: !CrossCallInfo !*OSToolbox -> (!CrossCallInfo,!*OSToolbox)
	osCreateSDIWindowCallback {ccMsg=CcWmDEACTIVATE} tb
		= (Return0Cci,tb)
	osCreateSDIWindowCallback {ccMsg=CcWmACTIVATE} tb
		= (Return0Cci,tb)
146
147
	osCreateSDIWindowCallback {ccMsg=CcWmKILLFOCUS} tb		/* PA: added. Shouldn't ControlDeactivate be delayed? */
		= (Return0Cci,tb)
Peter Achten's avatar
Peter Achten committed
148
149
150
	osCreateSDIWindowCallback {ccMsg} tb
		= osdocumentinterfaceFatalError "osCreateSDIWindowCallback" ("received message nr:"+++toString ccMsg)

151
152
153
154
155
156
157
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
Peter Achten's avatar
Peter Achten committed
158
159

osDestroyProcessWindowCallback :: String !CrossCallInfo !*OSToolbox -> (!CrossCallInfo,!*OSToolbox)
160
osDestroyProcessWindowCallback _ {ccMsg=CcWmDEACTIVATE} tb
Peter Achten's avatar
Peter Achten committed
161
	= (Return0Cci,tb)
162
osDestroyProcessWindowCallback _ {ccMsg=CcWmACTIVATE} tb
Peter Achten's avatar
Peter Achten committed
163
	= (Return0Cci,tb)
164
osDestroyProcessWindowCallback _ {ccMsg=CcWmKEYBOARD} tb
Peter Achten's avatar
Peter Achten committed
165
	= (Return0Cci,tb)
166
osDestroyProcessWindowCallback _ {ccMsg=CcWmPAINT,p1=hwnd} tb
167
	= (Return0Cci,WinFakePaint hwnd tb)
Peter Achten's avatar
Peter Achten committed
168
169
170
171
172
osDestroyProcessWindowCallback function {ccMsg} tb
	= osdocumentinterfaceFatalError function ("received message nr:"+++toString ccMsg)

//	getOSDInfoOSToolbar retrieves the OSToolbar, if any.
getOSDInfoOSToolbar :: !OSDInfo -> Maybe OSToolbar
173
174
175
getOSDInfoOSToolbar (OSMDInfo {osmdOSInfo={osToolbar}})	= osToolbar
getOSDInfoOSToolbar (OSSDInfo {ossdOSInfo={osToolbar}})	= osToolbar
getOSDInfoOSToolbar _									= Nothing