Commit 8df05b3f authored by Peter Achten's avatar Peter Achten
Browse files

(PA) Removed bugs wrt unbalanced IOStGetDevice

and IOStSetDevice.
parent 28d01b46
...@@ -73,7 +73,7 @@ where ...@@ -73,7 +73,7 @@ where
isToolbarOSEvent _ = False isToolbarOSEvent _ = False
menuEvent schedulerEvent=:(ScheduleMsgEvent msgEvent) pState=:{io=ioState} menuEvent schedulerEvent=:(ScheduleMsgEvent msgEvent) pState=:{io=ioState}
# (ioId,ioState) = IOStGetIOId ioState # (ioId,ioState) = IOStGetIOId ioState
| ioId<>recLoc.rlIOId || recLoc.rlDevice<>MenuDevice | ioId<>recLoc.rlIOId || recLoc.rlDevice<>MenuDevice
= (False,Nothing,schedulerEvent,{pState & io=ioState}) = (False,Nothing,schedulerEvent,{pState & io=ioState})
| otherwise | otherwise
......
...@@ -76,7 +76,7 @@ where ...@@ -76,7 +76,7 @@ where
isWindowOSEvent _ = False isWindowOSEvent _ = False
windowEvent schedulerEvent=:(ScheduleMsgEvent msgEvent) pState=:{io=ioState} windowEvent schedulerEvent=:(ScheduleMsgEvent msgEvent) pState=:{io=ioState}
# (ioId,ioState) = IOStGetIOId ioState # (ioId,ioState) = IOStGetIOId ioState
| ioId<>recLoc.rlIOId || recLoc.rlDevice<>WindowDevice | ioId<>recLoc.rlIOId || recLoc.rlDevice<>WindowDevice
= (False,Nothing,schedulerEvent,{pState & io=ioState}) = (False,Nothing,schedulerEvent,{pState & io=ioState})
| otherwise | otherwise
......
...@@ -475,14 +475,15 @@ getMenus ioState ...@@ -475,14 +475,15 @@ getMenus ioState
# (found,mDevice,ioState) = IOStGetDevice MenuDevice ioState # (found,mDevice,ioState) = IOStGetDevice MenuDevice ioState
| not found | not found
= ([],ioState) = ([],ioState)
# mHs = MenuSystemStateGetMenuHandles mDevice | otherwise
(idtypes,msHs) = AccessList getIdType mHs.mMenus # mHs = MenuSystemStateGetMenuHandles mDevice
# ioState = IOStSetDevice (MenuSystemState {mHs & mMenus=msHs}) ioState (idtypes,msHs) = AccessList getIdType mHs.mMenus
= (tl idtypes,ioState) # ioState = IOStSetDevice (MenuSystemState {mHs & mMenus=msHs}) ioState
= (tl idtypes,ioState)
where where
getIdType :: !(MenuStateHandle .pst) -> *((Id,MenuType),!MenuStateHandle .pst) getIdType :: !(MenuStateHandle .pst) -> *((Id,MenuType),!MenuStateHandle .pst)
getIdType msH getIdType msH
# (id,msH) = menuStateHandleGetMenuId msH # (id,msH) = menuStateHandleGetMenuId msH
= ((id,"Menu"),msH) = ((id,"Menu"),msH)
...@@ -493,18 +494,19 @@ getMenuPos id ioState ...@@ -493,18 +494,19 @@ getMenuPos id ioState
# (found,mDevice,ioState) = IOStGetDevice MenuDevice ioState # (found,mDevice,ioState) = IOStGetDevice MenuDevice ioState
| not found | not found
= (Nothing,ioState) = (Nothing,ioState)
# mHs = MenuSystemStateGetMenuHandles mDevice | otherwise
(optIndex,msHs) = getmenuindex id 0 mHs.mMenus # mHs = MenuSystemStateGetMenuHandles mDevice
# ioState = IOStSetDevice (MenuSystemState {mHs & mMenus=msHs}) ioState (optIndex,msHs) = getmenuindex id 0 mHs.mMenus
= (optIndex,ioState) # ioState = IOStSetDevice (MenuSystemState {mHs & mMenus=msHs}) ioState
= (optIndex,ioState)
where where
getmenuindex :: !Id !Int ![MenuStateHandle .pst] -> (!Maybe Int,![MenuStateHandle .pst]) getmenuindex :: !Id !Int ![MenuStateHandle .pst] -> (!Maybe Int,![MenuStateHandle .pst])
getmenuindex id index [mH:mHs] getmenuindex id index [mH:mHs]
# (menu_id,mH) = menuStateHandleGetMenuId mH # (menu_id,mH) = menuStateHandleGetMenuId mH
| id==menu_id | id==menu_id
= (Just index,[mH:mHs]) = (Just index,[mH:mHs])
| otherwise | otherwise
# (optIndex,mHs)= getmenuindex id (index+1) mHs # (optIndex,mHs) = getmenuindex id (index+1) mHs
= (optIndex, [mH:mHs]) = (optIndex, [mH:mHs])
getmenuindex _ _ _ getmenuindex _ _ _
= (Nothing,[]) = (Nothing,[])
......
...@@ -103,20 +103,21 @@ eqTimerStateHandleId id tsH=:(TimerLSHandle {tHandle={tId}}) ...@@ -103,20 +103,21 @@ eqTimerStateHandleId id tsH=:(TimerLSHandle {tHandle={tId}})
closeTimer :: !Id !(IOSt .l) -> IOSt .l closeTimer :: !Id !(IOSt .l) -> IOSt .l
closeTimer id ioState closeTimer id ioState
# (ok,tHs,ioState) = IOStGetTimerHandles ioState # (ok,tHs,ioState) = IOStGetTimerHandles ioState
| not ok | not ok
= ioState = ioState
# (pid,ioState) = IOStGetIOId ioState | otherwise
# (rt,ioState) = IOStGetReceiverTable ioState # (pid,ioState) = IOStGetIOId ioState
# (tt,ioState) = IOStGetTimerTable ioState # (rt,ioState) = IOStGetReceiverTable ioState
# (it,ioState) = IOStGetIdTable ioState # (tt,ioState) = IOStGetTimerTable ioState
(rt,tt,it,tsHs) = closetimer id pid rt tt it tHs.tTimers # (it,ioState) = IOStGetIdTable ioState
# ioState = IOStSetIdTable it ioState (rt,tt,it,tsHs) = closetimer id pid rt tt it tHs.tTimers
# ioState = IOStSetReceiverTable rt ioState # ioState = IOStSetIdTable it ioState
# ioState = IOStSetTimerTable tt ioState # ioState = IOStSetReceiverTable rt ioState
tHs = {tHs & tTimers=tsHs} # ioState = IOStSetTimerTable tt ioState
# ioState = IOStSetDevice (TimerSystemState tHs) ioState tHs = {tHs & tTimers=tsHs}
= ioState # ioState = IOStSetDevice (TimerSystemState tHs) ioState
= ioState
where where
closetimer :: !Id !SystemId !*ReceiverTable !*TimerTable !*IdTable ![TimerStateHandle .pst] closetimer :: !Id !SystemId !*ReceiverTable !*TimerTable !*IdTable ![TimerStateHandle .pst]
-> (!*ReceiverTable,!*TimerTable,!*IdTable,![TimerStateHandle .pst]) -> (!*ReceiverTable,!*TimerTable,!*IdTable,![TimerStateHandle .pst])
...@@ -144,18 +145,19 @@ where ...@@ -144,18 +145,19 @@ where
getTimers :: !(IOSt .l) -> (![(Id,TimerType)],!IOSt .l) getTimers :: !(IOSt .l) -> (![(Id,TimerType)],!IOSt .l)
getTimers ioState getTimers ioState
# (ok,tHs,ioState) = IOStGetTimerHandles ioState # (ok,tHs,ioState) = IOStGetTimerHandles ioState
| not ok | not ok
= ([],ioState) = ([],ioState)
# (idtypes,timers) = getidtypes tHs.tTimers | otherwise
tHs = {tHs & tTimers=timers} # (idtypes,timers) = getidtypes tHs.tTimers
# ioState = IOStSetDevice (TimerSystemState tHs) ioState tHs = {tHs & tTimers=timers}
= (idtypes,ioState) # ioState = IOStSetDevice (TimerSystemState tHs) ioState
= (idtypes,ioState)
where where
getidtypes :: ![TimerStateHandle .pst] -> (![(Id,TimerType)],![TimerStateHandle .pst]) getidtypes :: ![TimerStateHandle .pst] -> (![(Id,TimerType)],![TimerStateHandle .pst])
getidtypes [TimerLSHandle tlsH=:{tHandle=tH}:tsHs] getidtypes [TimerLSHandle tlsH=:{tHandle=tH}:tsHs]
# (idtype, tH) = getidtype tH # (idtype, tH) = getidtype tH
(idtypes,tsHs)= getidtypes tsHs (idtypes,tsHs) = getidtypes tsHs
= ([idtype:idtypes],[TimerLSHandle {tlsH & tHandle=tH}:tsHs]) = ([idtype:idtypes],[TimerLSHandle {tlsH & tHandle=tH}:tsHs])
where where
getidtype :: !(TimerHandle .ls .pst) -> ((Id,TimerType),!TimerHandle .ls .pst) getidtype :: !(TimerHandle .ls .pst) -> ((Id,TimerType),!TimerHandle .ls .pst)
......
...@@ -1576,12 +1576,12 @@ getWindowCancel id ioState ...@@ -1576,12 +1576,12 @@ getWindowCancel id ioState
# (found,wDevice,ioState) = IOStGetDevice WindowDevice ioState # (found,wDevice,ioState) = IOStGetDevice WindowDevice ioState
| not found | not found
= (Nothing,ioState) = (Nothing,ioState)
# windows = WindowSystemStateGetWindowHandles wDevice # windows = WindowSystemStateGetWindowHandles wDevice
(found,wsH,windows) = getWindowHandlesWindow (toWID id) windows (found,wsH,windows) = getWindowHandlesWindow (toWID id) windows
| not found | not found
= (Nothing,IOStSetDevice (WindowSystemState windows) ioState) = (Nothing,IOStSetDevice (WindowSystemState windows) ioState)
| otherwise | otherwise
# (cancelId,wsH) = getWindowStateHandleCancelId wsH # (cancelId,wsH) = getWindowStateHandleCancelId wsH
= (cancelId,IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState) = (cancelId,IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState)
getWindowCursor :: !Id !(IOSt .l) -> (!Maybe CursorShape,!IOSt .l) getWindowCursor :: !Id !(IOSt .l) -> (!Maybe CursorShape,!IOSt .l)
......
...@@ -467,8 +467,8 @@ where ...@@ -467,8 +467,8 @@ where
| otherwise | otherwise
#! dfuncs = removedevicefunctions device dfuncs #! dfuncs = removedevicefunctions device dfuncs
= [dfunc:dfuncs] = [dfunc:dfuncs]
removedevicefunctions _ empty removedevicefunctions _ _
= empty = []
// Access to the DeviceSystemStates: // Access to the DeviceSystemStates:
...@@ -477,7 +477,7 @@ IOStLastInteraction ioState ...@@ -477,7 +477,7 @@ IOStLastInteraction ioState
# (processes,ioState) = IOStGetCProcesses ioState # (processes,ioState) = IOStGetCProcesses ioState
(empty,processes) = notodoRR processes (empty,processes) = notodoRR processes
# ioState = IOStSetCProcesses processes ioState # ioState = IOStSetCProcesses processes ioState
= (not empty,ioState) = (empty,ioState)
IOStHasDevice :: !Device !(IOSt .l) -> (!Bool,!IOSt .l) IOStHasDevice :: !Device !(IOSt .l) -> (!Bool,!IOSt .l)
IOStHasDevice d ioState=:{iounique=iounique=:{iodevices=ds}} IOStHasDevice d ioState=:{iounique=iounique=:{iodevices=ds}}
...@@ -518,7 +518,7 @@ where ...@@ -518,7 +518,7 @@ where
IOStRemoveDevice :: !Device !(IOSt .l) -> IOSt .l IOStRemoveDevice :: !Device !(IOSt .l) -> IOSt .l
IOStRemoveDevice d ioState=:{iounique=iounique=:{iodevices=ds}} IOStRemoveDevice d ioState=:{iounique=iounique=:{iodevices=ds}}
# ds = devicesRemoveDevice d ds # ds = devicesRemoveDevice d ds
= {ioState & iounique={iounique & iodevices=ds}} = {ioState & iounique={iounique & iodevices=ds}}
where where
devicesRemoveDevice :: !Device !*[DeviceSystemState .pst] -> *[DeviceSystemState .pst] devicesRemoveDevice :: !Device !*[DeviceSystemState .pst] -> *[DeviceSystemState .pst]
......
...@@ -84,7 +84,7 @@ menuClose pState=:{io=ioState} ...@@ -84,7 +84,7 @@ menuClose pState=:{io=ioState}
(_,(rt,it)) = StateMap (disposeIds ioid) mHs (rt,it) (_,(rt,it)) = StateMap (disposeIds ioid) mHs (rt,it)
# ioState = IOStSetIdTable it ioState # ioState = IOStSetIdTable it ioState
# ioState = IOStSetReceiverTable rt ioState # ioState = IOStSetReceiverTable rt ioState
# ioState = IOStRemoveDevice MenuDevice ioState # ioState = IOStRemoveDevice MenuDevice ioState // PA: This is actually redundant, since IOStGetDevice already removed it
# ioState = IOStRemoveDeviceFunctions MenuDevice ioState # ioState = IOStRemoveDeviceFunctions MenuDevice ioState
= {pState & io=ioState} = {pState & io=ioState}
where where
......
...@@ -7,7 +7,7 @@ implementation module receiverdevice ...@@ -7,7 +7,7 @@ implementation module receiverdevice
import StdBool, StdFunc, StdList, StdMisc, StdTuple import StdBool, StdFunc, StdList, StdMisc, StdTuple
import StdReceiver import StdReceiver
import devicefunctions, iostate, receiveraccess, receiverevent, receiverid import devicefunctions, iostate, receiveraccess, receiverevent, receiverid
from commondef import FatalError, URemove, UCond from commondef import FatalError, URemove, UCond, StrictSeq, StrictSeqList, AccessList
from StdPSt import appPIO, accPIO from StdPSt import appPIO, accPIO
...@@ -45,16 +45,17 @@ receiverClose pState=:{io=ioState} ...@@ -45,16 +45,17 @@ receiverClose pState=:{io=ioState}
# (found,rDevice,ioState) = IOStGetDevice ReceiverDevice ioState # (found,rDevice,ioState) = IOStGetDevice ReceiverDevice ioState
| not found | not found
= {pState & io=ioState} = {pState & io=ioState}
# rHs = (ReceiverSystemStateGetReceiverHandles rDevice).rReceivers | otherwise
rIds = map (\{rHandle={rId}}->rId) rHs # rHs = (ReceiverSystemStateGetReceiverHandles rDevice).rReceivers
# (idtable,ioState) = IOStGetIdTable ioState rIds = map (\{rHandle={rId}}->rId) rHs
# ioState = IOStSetIdTable (snd (removeIdsFromIdTable rIds idtable)) ioState # (idtable,ioState) = IOStGetIdTable ioState
# ioState = unbindRIds rIds ioState # ioState = IOStSetIdTable (snd (removeIdsFromIdTable rIds idtable)) ioState
# ioState = IOStRemoveDevice ReceiverDevice ioState # ioState = unbindRIds rIds ioState
# ioState = IOStRemoveDeviceFunctions ReceiverDevice ioState # ioState = IOStRemoveDevice ReceiverDevice ioState // PA: this is redundant, because IOStGetDevice already removed it
= {pState & io=ioState} # ioState = IOStRemoveDeviceFunctions ReceiverDevice ioState
= {pState & io=ioState}
// MW11.. // MW11..
where where
callReceiverCloseFunctions :: !(IOSt .l) -> (IOSt .l) callReceiverCloseFunctions :: !(IOSt .l) -> (IOSt .l)
callReceiverCloseFunctions ioState callReceiverCloseFunctions ioState
# (found,rDevice,ioState) = IOStGetDevice ReceiverDevice ioState # (found,rDevice,ioState) = IOStGetDevice ReceiverDevice ioState
...@@ -62,12 +63,21 @@ receiverClose pState=:{io=ioState} ...@@ -62,12 +63,21 @@ receiverClose pState=:{io=ioState}
= ioState = ioState
| otherwise | otherwise
# rHs = (ReceiverSystemStateGetReceiverHandles rDevice).rReceivers # rHs = (ReceiverSystemStateGetReceiverHandles rDevice).rReceivers
= seq (map callCloseFunc rHs) ioState # (funcs,rHs) = AccessList getCloseFunc rHs
where # ioState = IOStSetDevice (ReceiverSystemState {rReceivers=rHs}) ioState
// PA = seq (map callCloseFunc rHs) ioState
= StrictSeq funcs ioState
where
callCloseFunc {rHandle={rInetInfo=Nothing, rConnected}} ioState callCloseFunc {rHandle={rInetInfo=Nothing, rConnected}} ioState
= seq (map closeReceiver rConnected) ioState = seq (map closeReceiver rConnected) ioState
callCloseFunc {rHandle={rInetInfo=Just (_,_,_,closeFun), rConnected}} ioState callCloseFunc {rHandle={rInetInfo=Just (_,_,_,closeFun), rConnected}} ioState
= appIOToolbox closeFun (seq (map closeReceiver rConnected) ioState) = appIOToolbox closeFun (seq (map closeReceiver rConnected) ioState)
getCloseFunc :: !(ReceiverStateHandle (PSt .l)) -> (!IdFun (IOSt .l),!ReceiverStateHandle (PSt .l))
getCloseFunc rsH=:{rHandle={rInetInfo=Nothing, rConnected}}
= (StrictSeq (map closeReceiver rConnected),rsH)
getCloseFunc rsH=:{rHandle={rInetInfo=Just (_,_,_,closeFun),rConnected}}
= (appIOToolbox closeFun o StrictSeq (map closeReceiver rConnected),rsH)
// .. MW11 // .. MW11
/* The receiver handles three cases of message events (for the time being timers are not included in receivers): /* The receiver handles three cases of message events (for the time being timers are not included in receivers):
...@@ -112,6 +122,7 @@ where ...@@ -112,6 +122,7 @@ where
= [rsH:rsHs] = [rsH:rsHs]
qMessage _ _ [] qMessage _ _ []
= [] = []
receiverIO deviceEvent=:(ReceiverEvent (ASyncMessage event)) rsHs pState receiverIO deviceEvent=:(ReceiverEvent (ASyncMessage event)) rsHs pState
= (deviceEvent,letOneReceiverDoIO rl rsHs pState) = (deviceEvent,letOneReceiverDoIO rl rsHs pState)
where where
...@@ -133,6 +144,7 @@ where ...@@ -133,6 +144,7 @@ where
= ({rState=ls,rHandle={rH & rASMQ=tailQ}},pState) = ({rState=ls,rHandle={rH & rASMQ=tailQ}},pState)
letReceiverDoIO _ _ letReceiverDoIO _ _
= receiverdeviceFatalError "letReceiverDoIO" "message queue of target receiver is empty" = receiverdeviceFatalError "letReceiverDoIO" "message queue of target receiver is empty"
receiverIO (ReceiverEvent (SyncMessage event)) rsHs pState receiverIO (ReceiverEvent (SyncMessage event)) rsHs pState
# (lastProcess,pState) = accPIO IOStLastInteraction pState # (lastProcess,pState) = accPIO IOStLastInteraction pState
# (event,pState) = receiverSyncIO lastProcess event rsHs pState # (event,pState) = receiverSyncIO lastProcess event rsHs pState
......
...@@ -49,7 +49,7 @@ timerClose pState=:{io=ioState} ...@@ -49,7 +49,7 @@ timerClose pState=:{io=ioState}
# ioState = IOStSetReceiverTable rt ioState # ioState = IOStSetReceiverTable rt ioState
# ioState = IOStSetTimerTable tt ioState # ioState = IOStSetTimerTable tt ioState
# ioState = IOStSetIdTable idtable ioState # ioState = IOStSetIdTable idtable ioState
# ioState = IOStRemoveDevice TimerDevice ioState # ioState = IOStRemoveDevice TimerDevice ioState // PA: this is redundant, because IOStGetDevice already removed it
# ioState = IOStRemoveDeviceFunctions TimerDevice ioState # ioState = IOStRemoveDeviceFunctions TimerDevice ioState
= {pState & io=ioState} = {pState & io=ioState}
where where
......
...@@ -74,8 +74,8 @@ windowClose pState=:{io=ioState} ...@@ -74,8 +74,8 @@ windowClose pState=:{io=ioState}
windows = WindowSystemStateGetWindowHandles wDevice windows = WindowSystemStateGetWindowHandles wDevice
# (inputTrack,ioState) = IOStGetInputTrack ioState # (inputTrack,ioState) = IOStGetInputTrack ioState
# (tb,ioState) = getIOToolbox ioState # (tb,ioState) = getIOToolbox ioState
# pState = {pState & io=ioState}
(wsHs,windows) = (\windows=:{whsWindows}->(whsWindows,{windows & whsWindows=[]})) windows (wsHs,windows) = (\windows=:{whsWindows}->(whsWindows,{windows & whsWindows=[]})) windows
# pState = {pState & io=IOStSetDevice (WindowSystemState windows) ioState}
# (disposeInfo,(inputTrack,pState,tb)) # (disposeInfo,(inputTrack,pState,tb))
= StateMap (disposeWindowStateHandle` osdinfo) wsHs (inputTrack,pState,tb) = StateMap (disposeWindowStateHandle` osdinfo) wsHs (inputTrack,pState,tb)
# ioState = setIOToolbox tb pState.io # ioState = setIOToolbox tb pState.io
...@@ -89,9 +89,8 @@ windowClose pState=:{io=ioState} ...@@ -89,9 +89,8 @@ windowClose pState=:{io=ioState}
# (idtable,ioState) = IOStGetIdTable ioState # (idtable,ioState) = IOStGetIdTable ioState
(_,idtable) = removeIdsFromIdTable (freeRIds++freeIds) idtable (_,idtable) = removeIdsFromIdTable (freeRIds++freeIds) idtable
# ioState = IOStSetIdTable idtable ioState # ioState = IOStSetIdTable idtable ioState
windows = (\windows=:{whsFinalModalLS=finalLS}->{windows & whsFinalModalLS=finalLS++finalLSs}) windows // # ioState = IOStRemoveDeviceFunctions WindowDevice ioState // PA: it is not clear whether this should be done
# ioState = IOStSetDevice (WindowSystemState windows) ioState # ioState = setFinalLS finalLSs ioState
// # ioState = IOStRemoveDeviceFunction WindowDevice ioState PA: it is not clear whether this should be done
# pState = {pState & io=ioState} # pState = {pState & io=ioState}
= pState = pState
where where
...@@ -103,6 +102,16 @@ where ...@@ -103,6 +102,16 @@ where
handleOSEvent :: !OSEvent !(PSt .l) -> (![Int],!PSt .l) handleOSEvent :: !OSEvent !(PSt .l) -> (![Int],!PSt .l)
handleOSEvent osEvent pState = accContext (handleContextOSEvent osEvent) pState handleOSEvent osEvent pState = accContext (handleContextOSEvent osEvent) pState
setFinalLS :: ![FinalModalLS] !(IOSt .l) -> IOSt .l
setFinalLS finalLSs ioState
# (found,wDevice,ioState) = IOStGetDevice WindowDevice ioState
| not found
= windowdeviceFatalError "WindowFunctions.dClose" "setFinalLS could not retrieve WindowSystemState from IOSt"
| otherwise
# windows = WindowSystemStateGetWindowHandles wDevice
# windows = {windows & whsFinalModalLS=windows.whsFinalModalLS++finalLSs}
= IOStSetDevice (WindowSystemState windows) ioState
/* windowIO handles the DeviceEvents that have been filtered by windowEvent. /* windowIO handles the DeviceEvents that have been filtered by windowEvent.
...@@ -206,6 +215,8 @@ where ...@@ -206,6 +215,8 @@ where
# (osDelayEvents,ioState)= accIOToolbox (StrictSeqList (lostInputEvents ++ [createOSDeactivateControlEvent wids.wPtr info.ckfItemPtr])) ioState # (osDelayEvents,ioState)= accIOToolbox (StrictSeqList (lostInputEvents ++ [createOSDeactivateControlEvent wids.wPtr info.ckfItemPtr])) ioState
# (osEvents,ioState) = IOStGetEvents ioState # (osEvents,ioState) = IOStGetEvents ioState
# ioState = IOStSetEvents (OSappendEvents osDelayEvents osEvents) ioState # ioState = IOStSetEvents (OSappendEvents osDelayEvents osEvents) ioState
# windows = setWindowHandlesWindow wsH windows
# ioState = IOStSetDevice (WindowSystemState windows) ioState
# pState = {pState & io=ioState} # pState = {pState & io=ioState}
= (deviceEvent,pState) = (deviceEvent,pState)
...@@ -299,6 +310,8 @@ where ...@@ -299,6 +310,8 @@ where
= accIOToolbox (StrictSeqList (lostInputEvents ++ [createOSDeactivateWindowEvent wids.wPtr])) ioState = accIOToolbox (StrictSeqList (lostInputEvents ++ [createOSDeactivateWindowEvent wids.wPtr])) ioState
# (osEvents,ioState)= IOStGetEvents ioState # (osEvents,ioState)= IOStGetEvents ioState
# ioState = IOStSetEvents (OSappendEvents osDelayEvents osEvents) ioState # ioState = IOStSetEvents (OSappendEvents osDelayEvents osEvents) ioState
# windows = setWindowHandlesWindow wsH windows
# ioState = IOStSetDevice (WindowSystemState windows) ioState
# pState = {pState & io=ioState} # pState = {pState & io=ioState}
= (deviceEvent,pState) = (deviceEvent,pState)
......
...@@ -67,25 +67,25 @@ disposeWindow wid pState=:{io=ioState} ...@@ -67,25 +67,25 @@ disposeWindow wid pState=:{io=ioState}
= dispose wids wsH windows {pState & io=ioState} = dispose wids wsH windows {pState & io=ioState}
where where
dispose :: !WIDS !(WindowStateHandle (PSt .l)) !(WindowHandles (PSt .l)) !(PSt .l) -> PSt .l dispose :: !WIDS !(WindowStateHandle (PSt .l)) !(WindowHandles (PSt .l)) !(PSt .l) -> PSt .l
dispose wids=:{wId} wsH windows pState dispose wids=:{wId} wsH windows pState=:{io=ioState}
# (disposeFun,pState) = accPIO IOStGetInitIO pState # (_,_,windows) = removeWindowHandlesWindow (toWID wId) windows // Remove window placeholder
# pState = disposeFun pState # (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}
# (osdinfo,ioState) = IOStGetOSDInfo pState.io # (osdinfo,ioState) = IOStGetOSDInfo pState.io
# (inputTrack,ioState) = IOStGetInputTrack ioState # (inputTrack,ioState) = IOStGetInputTrack ioState
(_,_,windows) = removeWindowHandlesWindow (toWID wId) windows
# (windows,ioState) = enableProperWindows windows ioState // PA: before disposing last modal window, the window and menu system should be enabled
# (tb,ioState) = getIOToolbox ioState # (tb,ioState) = getIOToolbox ioState
# pState = {pState & io=ioState} # pState = {pState & io=ioState}
# ((rids,ids,delayinfo,finalLS,inputTrack),(_,pState),tb) # ((rids,ids,delayinfo,finalLS,inputTrack),(_,pState),tb)
= disposeWindowStateHandle osdinfo inputTrack handleOSEvent (wsH,pState) tb = disposeWindowStateHandle osdinfo inputTrack handleOSEvent (wsH,pState) tb
# ioState = setIOToolbox tb pState.io # ioState = setIOToolbox tb pState.io
# ioState = IOStSetInputTrack inputTrack ioState # ioState = IOStSetInputTrack inputTrack ioState
# ioState = unbindRIds rids ioState // When timers are part of windows, also unbind timers # ioState = unbindRIds rids ioState // When timers are part of windows, also unbind timers
# (idtable,ioState) = IOStGetIdTable ioState # (idtable,ioState) = IOStGetIdTable ioState
(_,idtable) = removeIdsFromIdTable (rids++ids) idtable (_,idtable) = removeIdsFromIdTable (rids++ids) idtable
# ioState = IOStSetIdTable idtable ioState # ioState = IOStSetIdTable idtable ioState
# windows = {windows & whsFinalModalLS=finalLS++windows.whsFinalModalLS} # ioState = addFinalLS finalLS ioState
# ioState = IOStSetDevice (WindowSystemState windows) ioState
# ioState = bufferDelayedEvents delayinfo ioState # ioState = bufferDelayedEvents delayinfo ioState
= {pState & io=ioState} = {pState & io=ioState}
...@@ -97,6 +97,16 @@ where ...@@ -97,6 +97,16 @@ where
# (modalWIDS,windows) = getWindowHandlesActiveModalDialog windows # (modalWIDS,windows) = getWindowHandlesActiveModalDialog windows
| isJust modalWIDS = (windows,ioState) | isJust modalWIDS = (windows,ioState)
| otherwise = (windows,IOStSetIOIsModal Nothing ioState) | otherwise = (windows,IOStSetIOIsModal Nothing ioState)
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
/* disposeCursorInfo disposes all system resources associated with the given CursorInfo. /* disposeCursorInfo disposes all system resources associated with the given CursorInfo.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment