processevent.icl 3.7 KB
Newer Older
Peter Achten's avatar
Peter Achten committed
1
2
3
4
5
6
7
8
9
10
11
12
13
implementation module processevent


//	Clean Object I/O library, version 1.2

/*	processevent defines the DeviceEventFunction for the process device.
	This function is placed in a separate module because it is platform dependent.
*/


import	StdArray, StdBool, StdList
from	clCrossCall_12	import CcWmDDEEXECUTE, CcWmPROCESSCLOSE, CcWmPROCESSDROPFILES
from	clCCall_12		import WinGetCStringAndFree, CSTR
14
from	ostypes			import OSNoWindowPtr, OSWindowPtr
Peter Achten's avatar
Peter Achten committed
15
16
17
18
19
20
21
22
23
24
25
26
27
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.
*/
28
processEvent :: !SchedulerEvent !(PSt .l) -> (!Bool,!Maybe DeviceEvent,!SchedulerEvent,!PSt .l)
Peter Achten's avatar
Peter Achten committed
29
30
31
32
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
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

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
94
95
96
97
getOSDInfoFramePtr osdInfo
	= case (getOSDInfoOSInfo osdInfo) of
		Just info -> info.osFrame
		_         -> OSNoWindowPtr