3987 |xlatedKey sensor| |
3987 |xlatedKey sensor| |
3988 |
3988 |
3989 "/ |
3989 "/ |
3990 "/ ctrl-Esc gives up focus |
3990 "/ ctrl-Esc gives up focus |
3991 "/ |
3991 "/ |
3992 untranslatedKey = #'Escape' ifTrue:[ |
3992 untranslatedKey == #Escape ifTrue:[ |
3993 (ctrlDown or:[metaDown]) ifTrue:[ |
3993 (ctrlDown or:[metaDown]) ifTrue:[ |
3994 self ungrabPointer. |
3994 self ungrabPointer. |
3995 self ungrabKeyboard. |
3995 self ungrabKeyboard. |
3996 self setInputFocusTo:nil |
3996 self setInputFocusTo:nil |
3997 ] |
3997 ] |
3998 ]. |
|
3999 (self translateKey:untranslatedKey forView:aView) = #'Hardcopy' ifTrue:[ |
|
4000 [ |
|
4001 Transcript topView application |
|
4002 saveScreenImage:(Image fromView:(aView topView) inset:0 grab:true) defaultName:'hardcopy'. |
|
4003 ] forkAt:Processor userSchedulingPriority + 1. |
|
4004 ^ self. |
|
4005 ]. |
3998 ]. |
4006 |
3999 |
4007 self modifierKeyProcessing:untranslatedKey down:true. |
4000 self modifierKeyProcessing:untranslatedKey down:true. |
4008 |
4001 |
4009 aView isNil ifTrue:[ |
4002 aView isNil ifTrue:[ |
4010 "/ event arrived, after I destroyed it myself |
4003 "/ event arrived, after I destroyed it myself |
4011 ^ self |
4004 ^ self |
4012 ]. |
4005 ]. |
|
4006 |
|
4007 xlatedKey := self translateKey:untranslatedKey forView:aView. |
|
4008 xlatedKey == #Hardcopy ifTrue:[ |
|
4009 [ |
|
4010 Transcript topView application |
|
4011 saveScreenImage:(Image fromView:(aView topView) inset:0 grab:true) defaultName:'hardcopy'. |
|
4012 ] forkAt:Processor userSchedulingPriority + 1. |
|
4013 ^ self. |
|
4014 ]. |
|
4015 |
4013 (sensor := aView sensor) notNil ifTrue:[ |
4016 (sensor := aView sensor) notNil ifTrue:[ |
4014 sensor keyPress:untranslatedKey x:x y:y view:aView |
4017 sensor keyPress:untranslatedKey x:x y:y view:aView |
4015 ] ifFalse:[ |
4018 ] ifFalse:[ |
4016 aView shown ifTrue:[ "/ could be a late event arrival |
4019 aView shown ifTrue:[ "/ could be a late event arrival |
4017 " |
4020 " |
4018 if there is no sensor ... |
4021 if there is no sensor ... |
4019 " |
4022 " |
4020 xlatedKey := self translateKey:untranslatedKey forView:aView. |
4023 xlatedKey notNil ifTrue:[ |
4021 xlatedKey notNil ifTrue:[ |
4024 aView |
4022 aView |
4025 dispatchEvent:#keyPress:x:y: |
4023 dispatchEvent:#keyPress:x:y: |
4026 arguments:(Array with:xlatedKey with:x with:y) |
4024 arguments:(Array with:xlatedKey with:x with:y) |
|
4025 |
4027 |
4026 "/ WindowEvent |
4028 "/ WindowEvent |
4027 "/ sendEvent:#keyPress:x:y: |
4029 "/ sendEvent:#keyPress:x:y: |
4028 "/ arguments:(Array with:xlatedKey with:x with:y) |
4030 "/ arguments:(Array with:xlatedKey with:x with:y) |
4029 "/ view:aView |
4031 "/ view:aView |
4030 ] |
4032 ] |
4031 ] |
4033 ] |
4032 ] |
4034 ] |
4033 |
4035 |
4034 "Modified: / 20.5.1998 / 22:52:36 / cg" |
4036 "Modified: / 20.5.1998 / 22:52:36 / cg" |
4035 ! |
4037 ! |
4036 |
4038 |
4037 keyRelease:untranslatedKey x:x y:y view:aView |
4039 keyRelease:untranslatedKey x:x y:y view:aView |
4038 "forward a key-release event for some view" |
4040 "forward a key-release event for some view" |
4039 |
4041 |
4040 |xlatedKey sensor| |
4042 |xlatedKey sensor| |
4041 |
4043 |
4042 (self translateKey:untranslatedKey forView:aView) = #'Hardcopy' ifTrue:[^ self]. |
|
4043 |
|
4044 self modifierKeyProcessing:untranslatedKey down:false. |
4044 self modifierKeyProcessing:untranslatedKey down:false. |
4045 |
4045 |
4046 aView isNil ifTrue:[ |
4046 aView isNil ifTrue:[ |
4047 "/ event arrived, after I destroyed it myself |
4047 "/ event arrived, after I destroyed it myself |
4048 ^ self |
4048 ^ self |
4049 ]. |
4049 ]. |
|
4050 |
|
4051 xlatedKey := self translateKey:untranslatedKey forView:aView. |
|
4052 xlatedKey == #Hardcopy ifTrue:[^ self]. |
|
4053 |
4050 (sensor := aView sensor) notNil ifTrue:[ |
4054 (sensor := aView sensor) notNil ifTrue:[ |
4051 sensor keyRelease:untranslatedKey x:x y:y view:aView |
4055 sensor keyRelease:untranslatedKey x:x y:y view:aView |
4052 ] ifFalse:[ |
4056 ] ifFalse:[ |
4053 aView shown ifTrue:[ "/ could be a late event arrival |
4057 aView shown ifTrue:[ "/ could be a late event arrival |
4054 " |
4058 " |
4055 if there is no sensor ... |
4059 if there is no sensor ... |
4056 " |
4060 " |
4057 xlatedKey := self translateKey:untranslatedKey forView:aView. |
4061 xlatedKey notNil ifTrue:[ |
4058 xlatedKey notNil ifTrue:[ |
4062 aView |
4059 aView |
4063 dispatchEvent:#keyRelease:x:y: |
4060 dispatchEvent:#keyRelease:x:y: |
4064 arguments:(Array with:xlatedKey with:x with:y) |
4061 arguments:(Array with:xlatedKey with:x with:y) |
|
4062 |
4065 |
4063 "/ WindowEvent |
4066 "/ WindowEvent |
4064 "/ sendEvent:#keyRelease:x:y: |
4067 "/ sendEvent:#keyRelease:x:y: |
4065 "/ arguments:(Array with:xlatedKey with:x with:y) |
4068 "/ arguments:(Array with:xlatedKey with:x with:y) |
4066 "/ view:aView |
4069 "/ view:aView |
4067 ] |
4070 ] |
4068 ] |
4071 ] |
4069 ] |
4072 ] |
4070 |
4073 |
4071 "Modified: / 20.5.1998 / 22:52:52 / cg" |
4074 "Modified: / 20.5.1998 / 22:52:52 / cg" |
4072 ! |
4075 ! |
4073 |
4076 |
4257 We only do this for displays other that the default Display." |
4260 We only do this for displays other that the default Display." |
4258 |
4261 |
4259 dispatching ifFalse:[^ self]. |
4262 dispatching ifFalse:[^ self]. |
4260 |
4263 |
4261 self == Display ifTrue:[ |
4264 self == Display ifTrue:[ |
4262 ExitOnLastClose == true ifFalse:[^ self]. |
4265 ExitOnLastClose == true ifFalse:[^ self]. |
4263 ]. |
4266 ]. |
4264 exitOnLastClose == true ifFalse:[^ self]. |
4267 exitOnLastClose == true ifFalse:[^ self]. |
4265 |
4268 |
4266 knownViews notNil ifTrue:[ |
4269 knownViews notNil ifTrue:[ |
4267 (knownViews findFirst:[:slot | |
4270 (knownViews findFirst:[:slot | |
4268 slot notNil |
4271 slot notNil |
4269 and:[slot ~~ 0 "/ if there is no non-popup |
4272 and:[slot ~~ 0 "/ if there is no non-popup |
4270 and:[slot isRootView not "/ non-dialog ... |
4273 and:[slot isRootView not "/ non-dialog ... |
4271 and:[slot isTopView "/ stop dispatching. |
4274 and:[slot isTopView "/ stop dispatching. |
4272 and:[slot isPopUpView not |
4275 and:[slot isPopUpView not |
4273 and:[slot isModal not |
4276 and:[slot isModal not |
4274 "and:[slot realized]"]]]]]]) == 0 ifTrue:[ |
4277 "and:[slot realized]"]]]]]]) == 0 ifTrue:[ |
4275 "/ my last view was closed |
4278 "/ my last view was closed |
4276 dispatching := false. |
4279 dispatching := false. |
4277 'DeviceWorkstation [info]: finished dispatch (last view closed)' infoPrintCR. |
4280 'DeviceWorkstation [info]: finished dispatch (last view closed)' infoPrintCR. |
4278 LastActiveScreen == self ifTrue:[ |
4281 LastActiveScreen == self ifTrue:[ |
4279 LastActiveScreen := nil. |
4282 LastActiveScreen := nil. |
4280 LastActiveProcess := nil. |
4283 LastActiveProcess := nil. |
4281 ]. |
4284 ]. |
4282 eventSema signal. "/ get dispatchLoop out of its wait... |
4285 eventSema signal. "/ get dispatchLoop out of its wait... |
4283 ] |
4286 ] |
4284 ]. |
4287 ]. |
4285 |
4288 |
4286 "Modified: 19.9.1995 / 11:31:54 / claus" |
4289 "Modified: 19.9.1995 / 11:31:54 / claus" |
4287 "Modified: 18.3.1997 / 10:42:11 / cg" |
4290 "Modified: 18.3.1997 / 10:42:11 / cg" |
4288 ! |
4291 ! |
4289 |
4292 |
4290 cleanupAfterDispatch |
4293 cleanupAfterDispatch |
4291 eventSema notNil ifTrue:[ |
4294 eventSema notNil ifTrue:[ |
4292 Processor disableSemaphore:eventSema. |
4295 Processor disableSemaphore:eventSema. |
4293 eventSema := nil. |
4296 eventSema := nil. |
4294 ]. |
4297 ]. |
4295 dispatchProcess := nil. |
4298 dispatchProcess := nil. |
4296 ! |
4299 ! |
4297 |
4300 |
4298 dispatchEvent |
4301 dispatchEvent |
4316 |
4319 |
4317 dispatchLoop |
4320 dispatchLoop |
4318 "the actual event dispatching loop." |
4321 "the actual event dispatching loop." |
4319 |
4322 |
4320 [dispatching] whileTrue:[ |
4323 [dispatching] whileTrue:[ |
4321 AbortSignal handle:[:ex | |
4324 AbortSignal handle:[:ex | |
4322 ex return |
4325 ex return |
4323 ] do:[ |
4326 ] do:[ |
4324 self eventPending ifFalse:[ |
4327 self eventPending ifFalse:[ |
4325 Processor activeProcess setStateTo:#ioWait if:#active. |
4328 Processor activeProcess setStateTo:#ioWait if:#active. |
4326 eventSema wait. |
4329 eventSema wait. |
4327 ]. |
4330 ]. |
4328 dispatching ifTrue:[ |
4331 dispatching ifTrue:[ |
4329 self dispatchPendingEvents. |
4332 self dispatchPendingEvents. |
4330 ]. |
4333 ]. |
4331 ] |
4334 ] |
4332 ] |
4335 ] |
4333 ! |
4336 ! |
4334 |
4337 |
4335 dispatchModalWhile:aBlock |
4338 dispatchModalWhile:aBlock |
4336 "get and process next event for any view as long as the |
4339 "get and process next event for any view as long as the |
4474 |
4477 |
4475 "/ arrange for the processor to signal that semaphore when input |
4478 "/ arrange for the processor to signal that semaphore when input |
4476 "/ is available or #eventPending returns true |
4479 "/ is available or #eventPending returns true |
4477 |
4480 |
4478 fd isNil ifTrue:[ |
4481 fd isNil ifTrue:[ |
4479 "no fd -- so have to check for input also" |
4482 "no fd -- so have to check for input also" |
4480 checkBlock := [self eventPending]. |
4483 checkBlock := [self eventPending]. |
4481 ] ifFalse:[ |
4484 ] ifFalse:[ |
4482 "there is a fd, so checkblock has to check only the internal queue" |
4485 "there is a fd, so checkblock has to check only the internal queue" |
4483 checkBlock := [self eventQueued]. |
4486 checkBlock := [self eventQueued]. |
4484 ]. |
4487 ]. |
4485 |
4488 |
4486 "/ handle all incoming events from the device, sitting on a semaphore. |
4489 "/ handle all incoming events from the device, sitting on a semaphore. |
4487 "/ Tell Processor to trigger this semaphore when some event arrives |
4490 "/ Tell Processor to trigger this semaphore when some event arrives |
4488 "/ for me. Since a select alone may not be enough to know if events are pending |
4491 "/ for me. Since a select alone may not be enough to know if events are pending |
4492 |
4495 |
4493 Processor signal:eventSema onInput:fd orCheck:checkBlock. |
4496 Processor signal:eventSema onInput:fd orCheck:checkBlock. |
4494 |
4497 |
4495 |
4498 |
4496 DeviceIOErrorSignal handle:[:ex | |
4499 DeviceIOErrorSignal handle:[:ex | |
4497 "/ test for handlerBlock until the signal is changed to be classed based. |
4500 "/ test for handlerBlock until the signal is changed to be classed based. |
4498 ex signal handlerBlock notNil ifTrue:[ |
4501 ex signal handlerBlock notNil ifTrue:[ |
4499 ex defaultAction. |
4502 ex defaultAction. |
4500 ] ifFalse:[ |
4503 ] ifFalse:[ |
4501 'DeviceWorkstation [warning]: stop dispatch due to I/O error' errorPrintCR. |
4504 'DeviceWorkstation [warning]: stop dispatch due to I/O error' errorPrintCR. |
4502 self brokenConnection. |
4505 self brokenConnection. |
4503 ]. |
4506 ]. |
4504 ex return. |
4507 ex return. |
4505 ] do:[ |
4508 ] do:[ |
4506 self initializeDeviceResources. |
4509 self initializeDeviceResources. |
4507 [ |
4510 [ |
4508 self dispatchLoop |
4511 self dispatchLoop |
4509 ] ifCurtailed:[ |
4512 ] ifCurtailed:[ |
4510 self cleanupAfterDispatch. |
4513 self cleanupAfterDispatch. |
4511 self emergencyCloseConnection. |
4514 self emergencyCloseConnection. |
4512 ]. |
4515 ]. |
4513 self cleanupAfterDispatch. |
4516 self cleanupAfterDispatch. |
4514 self close. |
4517 self close. |
4515 ]. |
4518 ]. |
4516 ! |
4519 ! |
4517 |
4520 |
4518 startDispatch |
4521 startDispatch |
4519 "create & start the display event dispatch process." |
4522 "create & start the display event dispatch process." |
4525 "/ |
4528 "/ |
4526 dispatching ifTrue:[^ self]. |
4529 dispatching ifTrue:[^ self]. |
4527 dispatching := true. |
4530 dispatching := true. |
4528 |
4531 |
4529 AllScreens isNil ifTrue:[ |
4532 AllScreens isNil ifTrue:[ |
4530 AllScreens := IdentitySet new:1 |
4533 AllScreens := IdentitySet new:1 |
4531 ]. |
4534 ]. |
4532 AllScreens add:self. |
4535 AllScreens add:self. |
4533 |
4536 |
4534 p := [ self setupDispatchLoop ] newProcess. |
4537 p := [ self setupDispatchLoop ] newProcess. |
4535 |
4538 |
4536 "/ |
4539 "/ |
4537 "/ give the process a nice name (for the processMonitor) |
4540 "/ give the process a nice name (for the processMonitor) |
4538 "/ |
4541 "/ |
4539 (nm := self displayName) notNil ifTrue:[ |
4542 (nm := self displayName) notNil ifTrue:[ |
4540 nm := 'event dispatcher (' , nm , ')'. |
4543 nm := 'event dispatcher (' , nm , ')'. |
4541 ] ifFalse:[ |
4544 ] ifFalse:[ |
4542 nm := 'event dispatcher'. |
4545 nm := 'event dispatcher'. |
4543 ]. |
4546 ]. |
4544 p name:nm. |
4547 p name:nm. |
4545 p priority:(Processor userInterruptPriority). |
4548 p priority:(Processor userInterruptPriority). |
4546 p beSystemProcess. |
4549 p beSystemProcess. |
4547 dispatchProcess := p. |
4550 dispatchProcess := p. |
6868 self rememberCopyBuffer. |
6871 self rememberCopyBuffer. |
6869 self setLastCopyBuffer:nil. |
6872 self setLastCopyBuffer:nil. |
6870 self setCopyBuffer:something. |
6873 self setCopyBuffer:something. |
6871 s := something. |
6874 s := something. |
6872 s isString ifFalse:[ |
6875 s isString ifFalse:[ |
6873 s := s asStringWithCRsFrom:1 to:(s size) compressTabs:false withCR:false |
6876 s := s asStringWithCRsFrom:1 to:(s size) compressTabs:false withCR:false |
6874 ]. |
6877 ]. |
6875 |
6878 |
6876 "/ for now - should add support to pass emphasis information too |
6879 "/ for now - should add support to pass emphasis information too |
6877 s := s string. |
6880 s := s string. |
6878 |
6881 |
6879 (self setTextSelection:s owner:aView id) ifFalse:[ |
6882 (self setTextSelection:s owner:aView id) ifFalse:[ |
6880 'DeviceWorkstation [warning]: could not copy selection to clipBoard' errorPrintCR. |
6883 'DeviceWorkstation [warning]: could not copy selection to clipBoard' errorPrintCR. |
6881 ] |
6884 ] |
6882 ! ! |
6885 ! ! |
6883 |
6886 |
6884 !DeviceWorkstation methodsFor:'style defaults'! |
6887 !DeviceWorkstation methodsFor:'style defaults'! |
6885 |
6888 |