windowdispose.icl 12.7 KB
Newer Older
Peter Achten's avatar
Peter Achten committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
implementation module windowdispose


//	Clean Object I/O library, version 1.2


import	StdBool, StdFunc, StdList, StdMisc, StdTuple
import	menuevent, osmenu, oswindow
import	commondef, iostate, receiverid, scheduler, StdPSt, windowaccess, windowclipstate
from	StdMenu				import enableMenuSystem
from	StdWindowAttribute	import isWindowDeactivate
from	windowcreate		import bufferDelayedEvents


windowdisposeFatalError :: String String -> .x
windowdisposeFatalError function error
	= FatalError function "windowdispose" error


/*	disposeWindow disposes all system resources associated with the indicated window if it exists.
	Inactive modal dialogues are not removed.
	If the window belongs to an SDI process, then only the SDI client is removed, not the SDI frame.
	It removes the indicated window from the window device administration.
	Because the window may contain controls that are 'logically' disposed, but not 'physically' 
	disposeWindow also applies the init function contained in the IOSt.
*/
27
disposeWindow :: !WID !(PSt .l) -> PSt .l
Peter Achten's avatar
Peter Achten committed
28
disposeWindow wid pState=:{io=ioState}
29
30
31
32
	# (found,wDevice,ioState)		= IOStGetDevice WindowDevice ioState
	| not found
		= {pState & io=ioState}
	# windows						= WindowSystemStateGetWindowHandles wDevice
Peter Achten's avatar
Peter Achten committed
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
	  (found,wsH,windows)			= getWindowHandlesWindow wid windows
	// The window could not be found
	| not found
		= {pState & io=IOStSetDevice (WindowSystemState windows) ioState}
	# (alreadyClosing,wsH)			= getWindowStateHandleClosing wsH
	// The window is already in the act of being closed
	| alreadyClosing
		= {pState & io=IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState}
	# (documentInterface,ioState)	= IOStGetDocumentInterface ioState
	  (wKind,wsH)					= getWindowStateHandleWindowKind wsH
	  (wids, wsH)					= getWindowStateHandleWIDS wsH
	// Of a SDI process, the SDI client should be closed, not the SDI frame (which is closed by closeProcess)
	| documentInterface==SDI && wKind==IsWindow
	//	= {pState & io=IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState}
		# windows					= incWindowBound windows
		= dispose wids wsH windows {pState & io=ioState}
	with
		incWindowBound :: !(WindowHandles .pst) -> WindowHandles .pst
		incWindowBound wHs=:{whsNrWindowBound}
			= {wHs & whsNrWindowBound=incBound whsNrWindowBound}
	# (wMode,wsH)					= getWindowStateHandleWindowMode wsH
	// Any modeless window can be disposed
	| wMode<>Modal
		= dispose wids wsH windows {pState & io=ioState}
	# (activeWIDS,windows)			= getWindowHandlesActiveWindow windows
	| isNothing activeWIDS
	// Incorrect situation: indicated dialog is modal while no active window could be found
		= windowdisposeFatalError "disposeWindow" "active window could not be found"
	# activeId						= fromJust activeWIDS
	// Do not dispose inactive modal windows
	| wids.wId<>activeId.wId
		= {pState & io=IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState}
	// Dispose only the active modal window
	| otherwise
		= dispose wids wsH windows {pState & io=ioState}
where
69
	dispose :: !WIDS !(WindowStateHandle (PSt .l)) !(WindowHandles (PSt .l)) !(PSt .l) -> PSt .l
70
71
72
73
74
75
	dispose wids=:{wId} wsH windows pState=:{io=ioState}
		# (_,_,windows)			= removeWindowHandlesWindow (toWID wId) windows	// Remove window placeholder
		# (windows,ioState)		= enableProperWindows windows ioState			// PA: before disposing last modal window, the window and menu system should be enabled
		# ioState				= IOStSetDevice (WindowSystemState windows) ioState
		# (disposeFun,ioState)	= IOStGetInitIO ioState
		# pState				= disposeFun {pState & io=ioState}
Peter Achten's avatar
Peter Achten committed
76
77
78
79
		# (osdinfo,ioState)		= IOStGetOSDInfo pState.io
		# (inputTrack,ioState)	= IOStGetInputTrack ioState
		# (tb,ioState)			= getIOToolbox ioState
		# pState				= {pState & io=ioState}
80
81
		# ((rids,ids,delayinfo,finalLS,inputTrack),(_,pState),tb)
								= disposeWindowStateHandle osdinfo inputTrack handleOSEvent (wsH,pState) tb
Peter Achten's avatar
Peter Achten committed
82
83
		# ioState				= setIOToolbox tb pState.io
		# ioState				= IOStSetInputTrack inputTrack ioState
84
		# ioState				= unbindRIds rids ioState						// When timers are part of windows, also unbind timers
Peter Achten's avatar
Peter Achten committed
85
86
87
		# (idtable,ioState)		= IOStGetIdTable ioState
		  (_,idtable)			= removeIdsFromIdTable (rids++ids) idtable
		# ioState				= IOStSetIdTable idtable ioState
88
		# ioState				= addFinalLS finalLS ioState
Peter Achten's avatar
Peter Achten committed
89
90
91
		# ioState				= bufferDelayedEvents delayinfo ioState
		= {pState & io=ioState}
	
92
	handleOSEvent :: !OSEvent !(PSt .l) -> (![Int],!PSt .l)
Peter Achten's avatar
Peter Achten committed
93
94
	handleOSEvent osEvent pState = accContext (handleContextOSEvent osEvent) pState
	
95
	enableProperWindows :: !(WindowHandles (PSt .l)) !(IOSt .l) -> (!WindowHandles (PSt .l),!IOSt .l)
Peter Achten's avatar
Peter Achten committed
96
97
98
99
	enableProperWindows windows ioState
		# (modalWIDS,windows)	= getWindowHandlesActiveModalDialog windows
		| isJust modalWIDS		= (windows,ioState)
		| otherwise				= (windows,IOStSetIOIsModal Nothing ioState)
100
101
102
103
104
105
106
107
108
109
	
	addFinalLS :: ![FinalModalLS] !(IOSt .l) -> IOSt .l
	addFinalLS finalLS ioState
		# (found,wDevice,ioState)	= IOStGetDevice WindowDevice ioState
		| not found
			= windowdisposeFatalError "disposeWindow" "could not restore final local window state"
		| otherwise
			# windows				= WindowSystemStateGetWindowHandles wDevice
			# windows				= {windows & whsFinalModalLS=finalLS++windows.whsFinalModalLS}
			= IOStSetDevice (WindowSystemState windows) ioState
Peter Achten's avatar
Peter Achten committed
110
111
112
113
114


/*	disposeCursorInfo disposes all system resources associated with the given CursorInfo.
	PA: not yet implemented

115
disposeCursorInfo :: !CursorInfo !(IOSt .l) -> IOSt .l
Peter Achten's avatar
Peter Achten committed
116
117
118
119
120
121
122
123
124
125
*/


/*	disposeWindowStateHandle disposes all system resources associated with the given WindowStateHandle.
	The first  return [Id] are the Ids of receivers that should become unbound.
	The second return [Id] are the Ids of the other controls.
	The [DelayActivationInfo] are the delayed (de)activate events.
	The [FinalModalLS] is the final local state if the WindowStateHandle is a modal dialog.
	When timers are part of windows, also timer ids should be returned.
*/
126
127
128
129
130
disposeWindowStateHandle :: !OSDInfo !(Maybe InputTrack) !(OSEvent -> .s -> ([Int],.s)) !*(!*WindowStateHandle .pst,.s) !*OSToolbox
			-> (!(![Id],![Id],![DelayActivationInfo],![FinalModalLS],!Maybe InputTrack),!*(!*WindowStateHandle .pst,.s),!*OSToolbox)
disposeWindowStateHandle osdinfo inputTrack handleOSEvent 
						 (wsH=:{wshIds=wids=:{wPtr,wId},wshHandle=Just wlsH=:{wlsState,wlsHandle=wH=:{whWindowInfo,whItems,whKind,whMode}}},state)
						 tb
131
	# isModalDialog				= whKind==IsDialog && whMode==Modal
132
	  (isWindowInfo,info)		= case whWindowInfo of
Peter Achten's avatar
Peter Achten committed
133
134
									WindowInfo info	-> (True, info)
									_				-> (False,windowdisposeFatalError "disposeWindowStateHandle" "info unexpectedly evaluated")
135
136
137
138
//	# (ids_dispose,tb)			= StateMap (disposeWElementHandle wPtr) wH.whItems tb
//	  (rIdss,idss,disposeFuns)	= unzip3 ids_dispose
	# (rids,ids,fs,itemHs,tb)	= disposeWElementHandles wPtr whItems tb
	# tb						= fs tb//StrictSeq disposeFuns tb
139
	# (delayinfo,state,tb)		= OSdestroyWindow osdinfo (whMode==Modal) (whKind==IsWindow) wPtr handleOSEvent state tb
140
141
//	  rids						= flatten rIdss
	  ids						= [wId:ids]//flatten idss]
Peter Achten's avatar
Peter Achten committed
142
143
144
145
146
147
	  finalModalLS				= if isModalDialog [{fmWIDS=wids,fmLS=wlsState}] []
	  inputTrack				= case inputTrack of
	  								Just {itWindow}
	  										-> if (itWindow==wPtr) Nothing inputTrack
	  								nothing -> nothing
	  result					= (rids,ids,delayinfo,finalModalLS,inputTrack)
148
149
150
151
	  wsH						= {wsH & wshHandle=Just {wlsH & wlsState=undef,wlsHandle={wH & whItems=itemHs}}}
	| isWindowInfo				= (result,(wsH,state),disposeClipState info.windowClip tb)
	| otherwise					= (result,(wsH,state),tb)
disposeWindowStateHandle _ _ _ _ _
Peter Achten's avatar
Peter Achten committed
152
153
154
	= windowdisposeFatalError "disposeWindowStateHandle" "window expected instead of placeholder"


155
156
/*	disposeWElementHandle(s) (recursively) hides all system resources associated with the given 
	WElementHandle(s). The argument OSWindowPtr must be the parent window.
Peter Achten's avatar
Peter Achten committed
157
158
159
160
	The (IdFun *OSToolbox) function must be used to actually dispose the controls.
	It returns all freed receiver and control ids.
	When timers are part of windows, also timer ids should be returned.
*/
161
162
163
164
165
166
167
168
169
170
171
disposeWElementHandles :: !OSWindowPtr !*[WElementHandle .ls .pst] !*OSToolbox 
	 -> (![Id],![Id],!IdFun *OSToolbox,!*[WElementHandle .ls .pst],!*OSToolbox)
disposeWElementHandles wPtr [itemH:itemHs] tb
	# (rids, ids, fs, itemH, tb)	= disposeWElementHandle  wPtr itemH  tb
	# (ridss,idss,fss,itemHs,tb)	= disposeWElementHandles wPtr itemHs tb
	= (rids++ridss,ids++idss,fss o fs,[itemH:itemHs],tb)
disposeWElementHandles _ [] tb
	= ([],[],id,[],tb)

disposeWElementHandle :: !OSWindowPtr !(WElementHandle .ls .pst) !*OSToolbox
	-> (![Id],![Id],!IdFun *OSToolbox, !WElementHandle .ls .pst, !*OSToolbox)
Peter Achten's avatar
Peter Achten committed
172
disposeWElementHandle wPtr (WItemHandle itemH) tb
173
174
	# (rids,ids,f,itemH,tb)	= disposeWItemHandle wPtr itemH tb
	= (rids,ids,f,WItemHandle itemH,tb)
Peter Achten's avatar
Peter Achten committed
175
disposeWElementHandle wPtr (WListLSHandle itemHs) tb
176
177
178
179
180
181
182
183
	# (rids,ids,fs,itemHs,tb)	= disposeWElementHandles wPtr itemHs tb
	= (rids,ids,fs,WListLSHandle itemHs,tb)
disposeWElementHandle wPtr (WExtendLSHandle wExH=:{wExtendItems=itemHs}) tb
	# (rids,ids,fs,itemHs,tb)	= disposeWElementHandles wPtr itemHs tb
	= (rids,ids,fs,WExtendLSHandle {wExH & wExtendItems=itemHs},tb)
disposeWElementHandle wPtr (WChangeLSHandle wChH=:{wChangeItems=itemHs}) tb
	# (rids,ids,fs,itemHs,tb)	= disposeWElementHandles wPtr itemHs tb
	= (rids,ids,fs,WChangeLSHandle {wChH & wChangeItems=itemHs},tb)
Peter Achten's avatar
Peter Achten committed
184
185
186
187
188
189
190
191


/*	disposeWItemHandle (recursively) hides all system resources associated with the given WItemHandle. 
	The OSWindowPtr argument must identify the parent window.
	The (IdFun *OSToolbox) function must be used to actually dispose the controls.
	It returns all freed receiver ids.
	When timers are part of windows, also timer ids should be returned.
*/
192
193
disposeWItemHandle :: !OSWindowPtr !(WItemHandle .ls .pst) !*OSToolbox
  -> (![Id],![Id],!IdFun *OSToolbox,!WItemHandle .ls .pst, !*OSToolbox)
Peter Achten's avatar
Peter Achten committed
194

195
196
disposeWItemHandle wPtr itemH=:{wItemKind=IsCheckControl,wItemInfo,wItemId} tb
	# checkInfo			= getWItemCheckInfo wItemInfo
Peter Achten's avatar
Peter Achten committed
197
198
199
200
	  items				= checkInfo.checkItems
	# tb				= StateMap2 (\{checkItemPtr,checkItemPos,checkItemSize}
										->OSsetCheckControlShow wPtr checkItemPtr (PosSizeToRect checkItemPos checkItemSize) False
									) items tb
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
	= ([],maybeToList wItemId,StateMap2 (\{checkItemPtr}->OSdestroyCheckControl checkItemPtr) items,itemH,tb)

disposeWItemHandle wPtr itemH=:{wItemKind=IsCompoundControl,wItemInfo,wItems,wItemId,wItemPos,wItemSize,wItemPtr} tb
	# (rids,ids,fs,itemHs,tb)	= disposeWElementHandles wPtr wItems tb
	  f							= OSdestroyCompoundControl wItemPtr
	  ids						= maybeToList wItemId ++ ids
	  info						= getWItemCompoundInfo wItemInfo
	# tb						= OSsetCompoundShow wPtr wItemPtr (PosSizeToRect wItemPos wItemSize) False tb
	  itemH						= {itemH & wItems=itemHs}
	= (rids,ids,f o disposeClipState info.compoundLookInfo.compoundClip o fs,itemH,tb)

disposeWItemHandle wPtr itemH=:{wItemKind=IsLayoutControl,wItems,wItemId} tb
	# (rids,ids,fs,itemHs,tb)	= disposeWElementHandles wPtr wItems tb
	  ids						= maybeToList wItemId ++ ids
	  itemH						= {itemH & wItems=itemHs}
	= (rids,ids,fs,itemH,tb)

disposeWItemHandle wPtr itemH=:{wItemKind=IsOtherControl controltype,wItemId} tb
Peter Achten's avatar
Peter Achten committed
219
220
//	The control is a receiver:
	| controltype=="Receiver" || controltype=="Receiver2"
221
		= (maybeToList wItemId,[],id,itemH,tb)
222
223
/*	The control is a timer:
	| controltype=="TimerControl"
224
		= ([],getTimerLoc itemH,id,itemH,tb)
225
*/	| otherwise
Peter Achten's avatar
Peter Achten committed
226
227
		= windowdisposeFatalError "disposeWItemHandle" ("unknown control type: "+++controltype)

228
229
disposeWItemHandle wPtr itemH=:{wItemKind=IsRadioControl,wItemId,wItemInfo} tb
	# radioInfo			= getWItemRadioInfo wItemInfo
230
231
232
233
	  items				= radioInfo.radioItems
	# tb				= StateMap2 (\{radioItemPtr,radioItemPos,radioItemSize}
										->OSsetRadioControlShow wPtr radioItemPtr (PosSizeToRect radioItemPos radioItemSize) False
									) items tb
234
	= ([],maybeToList wItemId,StateMap2 (\{radioItemPtr}->OSdestroyRadioControl radioItemPtr) items,itemH,tb)
235

236
237
238
disposeWItemHandle wPtr itemH=:{wItemKind,wItemId,wItemPtr,wItemPos,wItemSize} tb
	# tb				= hide wPtr wItemPtr (PosSizeToRect wItemPos wItemSize) False tb
	= ([],maybeToList wItemId,dispose wItemPtr,itemH,tb)
Peter Achten's avatar
Peter Achten committed
239
240
241
242
243
244
245
246
247
248
249
250
251
252
where
	(hide,dispose)		= case wItemKind of
							IsPopUpControl			-> (OSsetPopUpControlShow,			OSdestroyPopUpControl)
							IsSliderControl			-> (OSsetSliderControlShow,			OSdestroySliderControl)
							IsTextControl			-> (OSsetTextControlShow,			OSdestroyTextControl)
							IsEditControl			-> (OSsetEditControlShow,			OSdestroyEditControl)
							IsButtonControl			-> (OSsetButtonControlShow,			OSdestroyButtonControl)
							IsCustomButtonControl	-> (OSsetCustomButtonControlShow,	OSdestroyCustomButtonControl)
							IsCustomControl			-> (OSsetCustomControlShow,			OSdestroyCustomControl)
							_						-> windowdisposeFatalError "disposeWItemHandle" ("unmatched ControlKind: "+++toString wItemKind)

maybeToList :: !(Maybe .x) -> [.x]
maybeToList (Just x)	= [x]
maybeToList _			= []