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
27
28
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
|
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
|
