implementation module processevent





import	StdArray, StdBool, StdList

from	clCrossCall_12	import CcWmDDEEXECUTE, CcWmPROCESSCLOSE, CcWmPROCESSDROPFILES, :: CrossCallInfo(..)

from	clCCall_12		import winGetCStringAndFree, :: CSTR

from	ostypes			import OSNoWindowPtr, :: OSWindowPtr

import	deviceevents, iostate

from	commondef		import fatalError

from	processstack	import topShowProcessShowState



processeventFatalError :: String String -> .x

processeventFatalError function error

	= fatalError function "processevent" error





/*	processEvent filters the scheduler events that can be handled by this process device.

	processEvent assumes that it is not applied to an empty IOSt.

*/

processEvent :: !SchedulerEvent !(PSt .l) -> (!Bool,!Maybe DeviceEvent,!SchedulerEvent,!PSt .l)



processEvent schedulerEvent=:(ScheduleOSEvent osEvent=:{ccMsg} _) pState=:{io=ioState}

	| isProcessOSEvent ccMsg

		# (processStack,ioState)		= ioStGetProcessStack ioState

		  (found,systemId)				= topShowProcessShowState processStack

		# (ioId,ioState)				= ioStGetIOId ioState

		# (osdInfo,ioState)				= ioStGetOSDInfo ioState

		# (tb,ioState)					= getIOToolbox ioState

		# (myEvent,replyToOS,deviceEvent,tb)

		  								= filterOSEvent osEvent (found && systemId==ioId) osdInfo tb

		# 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

	isProcessOSEvent :: !Int -> Bool

	isProcessOSEvent CcWmDDEEXECUTE			= True

	isProcessOSEvent CcWmPROCESSCLOSE		= True

	isProcessOSEvent CcWmPROCESSDROPFILES	= True

	isProcessOSEvent _						= False



processEvent schedulerEvent pState

	= (False,Nothing,schedulerEvent,pState)





/*	filterOSEvent filters the OSEvents that can be handled by this process device.

		The Bool argument is True iff the parent process is visible and active.

*/

filterOSEvent :: !OSEvent !Bool !OSDInfo !*OSToolbox -> (!Bool,!Maybe [Int],!Maybe DeviceEvent,!*OSToolbox)



filterOSEvent {ccMsg=CcWmDDEEXECUTE,p1=cString} isActive _ tb

	| not isActive

		= (False,Nothing,Nothing,tb)

	| otherwise

		# (fName,tb)	= winGetCStringAndFree cString tb

		= (True,Nothing,Just (ProcessRequestOpenFiles [fName]),tb)



filterOSEvent {ccMsg=CcWmPROCESSCLOSE,p1=framePtr} _ osdInfo tb

	| framePtr==getOSDInfoFramePtr osdInfo

		= (True,Nothing,Just ProcessRequestClose,tb)

	| otherwise

		= (False,Nothing,Nothing,tb)



filterOSEvent {ccMsg=CcWmPROCESSDROPFILES,p1=framePtr,p2=cString} _ osdInfo tb

	| framePtr<>getOSDInfoFramePtr osdInfo

		= (False,Nothing,Nothing,tb)

	| otherwise

		# (allNames,tb)	= winGetCStringAndFree cString tb

		  allNames		= if (allNames.[size allNames-1]=='\n') allNames (allNames+++"\n")

		= (True,Nothing,Just (ProcessRequestOpenFiles (filter ((<>) "") (getFileNames 0 0 (size allNames) allNames []))),tb)

where

//	getFileNames assumes that the file names are separated by a single '\n' and the string ends with a '\n'.

	getFileNames :: !Int !Int !Int !String [String] -> [String]

	getFileNames low up nrChars allNames fNames

		| up>=nrChars			= fNames

		| allNames.[up]=='\n'	= getFileNames (up+1) (up+1) nrChars allNames [allNames%(low,up-1):fNames]

		| otherwise				= getFileNames low (up+1) nrChars allNames fNames



filterOSEvent _ _ _ _

	= processeventFatalError "filterOSEvent" "unmatched OSEvent"





getOSDInfoFramePtr :: !OSDInfo -> OSWindowPtr

getOSDInfoFramePtr osdInfo

	= case (getOSDInfoOSInfo osdInfo) of

		Just info -> info.osFrame

		_         -> OSNoWindowPtr

