--- a/KeybdFwd.st Thu Nov 23 03:29:10 1995 +0100
+++ b/KeybdFwd.st Thu Nov 23 11:38:43 1995 +0100
@@ -11,8 +11,6 @@
"
-'From Smalltalk/X, Version:2.10.5 on 30-mar-1995 at 5:32:55 am'!
-
Object subclass:#KeyboardForwarder
instanceVariableNames:'sourceView destinationView destination condition'
classVariableNames:''
@@ -22,8 +20,19 @@
!KeyboardForwarder class methodsFor:'documentation'!
-version
- ^ '$Header: /cvs/stx/stx/libview/Attic/KeybdFwd.st,v 1.7 1995-11-11 15:51:36 cg Exp $'
+copyright
+"
+ COPYRIGHT (c) 1995 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+
!
documentation
@@ -148,33 +157,12 @@
"
!
-copyright
-"
- COPYRIGHT (c) 1995 by Claus Gittinger
- All Rights Reserved
-
- This software is furnished under a license and may be used
- only in accordance with the terms of that license and with the
- inclusion of the above copyright notice. This software may not
- be provided or otherwise made available to, or used by, any
- other person. No title to or ownership of the software is
- hereby transferred.
-"
-
+version
+ ^ '$Header: /cvs/stx/stx/libview/Attic/KeybdFwd.st,v 1.8 1995-11-23 10:37:44 cg Exp $'
! !
!KeyboardForwarder class methodsFor:'instance creation'!
-from:sourceView toView:destinationView
- "create and return a new KeyboardForwarder to redirect key events
- for sourceView to destinationView. Events from other than the sourceView
- will not be forwarded. The forwarded event will be reported excluding
- the original view as argument (i.e. as #keyPress:x:y:).
- Use this, if the destination is a view."
-
- ^ self new sourceView:sourceView; destinationView:destinationView
-!
-
from:sourceView to:destination
"create and return a new KeyboardForwarder to redirect key events
for sourceView to destination. Events from other than the sourceView
@@ -185,14 +173,14 @@
^ self new sourceView:sourceView; destination:destination
!
-toView:destinationView
- "create and return a new KeyboardForwarder to redirect any key event
- to destinationView (Independent of the view in which the event originally
- occurred). The forwarded event will be reported excluding
+from:sourceView toView:destinationView
+ "create and return a new KeyboardForwarder to redirect key events
+ for sourceView to destinationView. Events from other than the sourceView
+ will not be forwarded. The forwarded event will be reported excluding
the original view as argument (i.e. as #keyPress:x:y:).
Use this, if the destination is a view."
- ^ self new destinationView:destinationView
+ ^ self new sourceView:sourceView; destinationView:destinationView
!
to:destination
@@ -205,6 +193,27 @@
^ self new destination:destination
!
+to:destination condition:aCondition
+ "create and return a new KeyboardForwarder to redirect any key event
+ to destinationView (Independent of the view in which the event originally
+ occurred) but only, if some condition as specified by aCondition
+ is met. The forwarded event will be reported including
+ the original view as argument (i.e. as #keyPress:x:y:view:).
+ Use this, if the destination is not a view."
+
+ ^ self new destination:destination; condition:aCondition
+!
+
+toView:destinationView
+ "create and return a new KeyboardForwarder to redirect any key event
+ to destinationView (Independent of the view in which the event originally
+ occurred). The forwarded event will be reported excluding
+ the original view as argument (i.e. as #keyPress:x:y:).
+ Use this, if the destination is a view."
+
+ ^ self new destinationView:destinationView
+!
+
toView:destinationView condition:aCondition
"create and return a new KeyboardForwarder to redirect any key event
to destinationView (Independent of the view in which the event originally
@@ -214,17 +223,6 @@
Use this, if the destination is a view."
^ self new destinationView:destinationView; condition:aCondition
-!
-
-to:destination condition:aCondition
- "create and return a new KeyboardForwarder to redirect any key event
- to destinationView (Independent of the view in which the event originally
- occurred) but only, if some condition as specified by aCondition
- is met. The forwarded event will be reported including
- the original view as argument (i.e. as #keyPress:x:y:view:).
- Use this, if the destination is not a view."
-
- ^ self new destination:destination; condition:aCondition
! !
!KeyboardForwarder methodsFor:'accessing'!
@@ -235,16 +233,10 @@
condition := aCondition
!
-destinationView:aView
- "set the destination view"
+destination
+ "return the destination"
- destinationView := aView
-!
-
-destinationView
- "return the destination view"
-
- ^ destinationView
+ ^ destination
!
destination:anObject
@@ -254,61 +246,28 @@
destination := anObject
!
-destination
- "return the destination"
+destinationView
+ "return the destination view"
- ^ destination
+ ^ destinationView
!
-sourceView:aView
- "set the sourceView - if nonNil, only events from this view will be forwarded"
+destinationView:aView
+ "set the destination view"
- sourceView := aView
+ destinationView := aView
!
sourceView
"get the sourceView - if nonNil, only events from this view will be forwarded"
^ sourceView
-! !
-
-!KeyboardForwarder methodsFor:'queries'!
-
-delegatesTo:someone
- "return true, if I delegate events to someone"
-
- ^ destination == someone or:[destinationView == someone]
!
-checkCondition:type key:key view:aView
- condition notNil ifTrue:[
- condition == #noFocus ifTrue:[
- aView windowGroup focusView notNil ifTrue:[^ false]
- ].
- condition isBlock ifTrue:[
- (condition value:type value:key value:aView) ifFalse:[^ false]
- ]
- ].
- sourceView notNil ifTrue:[
- ^ aView == sourceView
- ].
- ^ true
-!
+sourceView:aView
+ "set the sourceView - if nonNil, only events from this view will be forwarded"
-handlesKeyPress:key inView:aView
- "this is the query from the sensor to ask me if I would like to
- get a keyPress event for key from aView. Return true, if I want so,
- false otherwise."
-
- ^ self checkCondition:#keyPress key:key view:aView
-!
-
-handlesKeyRelease:key inView:aView
- "this is the query from the sensor to ask me if I would like to
- get a keyRelease event for key from aView. Return true, if I want so,
- false otherwise."
-
- ^ self checkCondition:#keyRelease key:key view:aView
+ sourceView := aView
! !
!KeyboardForwarder methodsFor:'event forwarding'!
@@ -360,3 +319,43 @@
]
]
! !
+
+!KeyboardForwarder methodsFor:'queries'!
+
+checkCondition:type key:key view:aView
+ condition notNil ifTrue:[
+ condition == #noFocus ifTrue:[
+ aView windowGroup focusView notNil ifTrue:[^ false]
+ ].
+ condition isBlock ifTrue:[
+ (condition value:type value:key value:aView) ifFalse:[^ false]
+ ]
+ ].
+ sourceView notNil ifTrue:[
+ ^ aView == sourceView
+ ].
+ ^ true
+!
+
+delegatesTo:someone
+ "return true, if I delegate events to someone"
+
+ ^ destination == someone or:[destinationView == someone]
+!
+
+handlesKeyPress:key inView:aView
+ "this is the query from the sensor to ask me if I would like to
+ get a keyPress event for key from aView. Return true, if I want so,
+ false otherwise."
+
+ ^ self checkCondition:#keyPress key:key view:aView
+!
+
+handlesKeyRelease:key inView:aView
+ "this is the query from the sensor to ask me if I would like to
+ get a keyRelease event for key from aView. Return true, if I want so,
+ false otherwise."
+
+ ^ self checkCondition:#keyRelease key:key view:aView
+! !
+
--- a/KeybdMap.st Thu Nov 23 03:29:10 1995 +0100
+++ b/KeybdMap.st Thu Nov 23 11:38:43 1995 +0100
@@ -10,11 +10,11 @@
hereby transferred.
"
-IdentityDictionary subclass:#KeyboardMap
- instanceVariableNames:'current'
- classVariableNames:''
- poolDictionaries:''
- category:'Interface-Support'
+IdentityDictionary subclass:#KeyboardMap
+ instanceVariableNames:'current'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Interface-Support'
!
!KeyboardMap class methodsFor:'documentation'!
@@ -33,10 +33,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libview/Attic/KeybdMap.st,v 1.7 1995-11-11 15:51:38 cg Exp $'
-!
-
documentation
"
instances of KeyboardMap are used for mapping keystrokes AND sequences
@@ -75,6 +71,10 @@
m := Display keyboardMap.
m bindValue:#Cmdd to:#Cmdd.
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/Attic/KeybdMap.st,v 1.8 1995-11-23 10:37:52 cg Exp $'
! !
!KeyboardMap methodsFor:'accessing'!
@@ -111,3 +111,4 @@
current := nil.
^ value
! !
+
--- a/KeyboardForwarder.st Thu Nov 23 03:29:10 1995 +0100
+++ b/KeyboardForwarder.st Thu Nov 23 11:38:43 1995 +0100
@@ -11,8 +11,6 @@
"
-'From Smalltalk/X, Version:2.10.5 on 30-mar-1995 at 5:32:55 am'!
-
Object subclass:#KeyboardForwarder
instanceVariableNames:'sourceView destinationView destination condition'
classVariableNames:''
@@ -22,8 +20,19 @@
!KeyboardForwarder class methodsFor:'documentation'!
-version
- ^ '$Header: /cvs/stx/stx/libview/KeyboardForwarder.st,v 1.7 1995-11-11 15:51:36 cg Exp $'
+copyright
+"
+ COPYRIGHT (c) 1995 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+
!
documentation
@@ -148,33 +157,12 @@
"
!
-copyright
-"
- COPYRIGHT (c) 1995 by Claus Gittinger
- All Rights Reserved
-
- This software is furnished under a license and may be used
- only in accordance with the terms of that license and with the
- inclusion of the above copyright notice. This software may not
- be provided or otherwise made available to, or used by, any
- other person. No title to or ownership of the software is
- hereby transferred.
-"
-
+version
+ ^ '$Header: /cvs/stx/stx/libview/KeyboardForwarder.st,v 1.8 1995-11-23 10:37:44 cg Exp $'
! !
!KeyboardForwarder class methodsFor:'instance creation'!
-from:sourceView toView:destinationView
- "create and return a new KeyboardForwarder to redirect key events
- for sourceView to destinationView. Events from other than the sourceView
- will not be forwarded. The forwarded event will be reported excluding
- the original view as argument (i.e. as #keyPress:x:y:).
- Use this, if the destination is a view."
-
- ^ self new sourceView:sourceView; destinationView:destinationView
-!
-
from:sourceView to:destination
"create and return a new KeyboardForwarder to redirect key events
for sourceView to destination. Events from other than the sourceView
@@ -185,14 +173,14 @@
^ self new sourceView:sourceView; destination:destination
!
-toView:destinationView
- "create and return a new KeyboardForwarder to redirect any key event
- to destinationView (Independent of the view in which the event originally
- occurred). The forwarded event will be reported excluding
+from:sourceView toView:destinationView
+ "create and return a new KeyboardForwarder to redirect key events
+ for sourceView to destinationView. Events from other than the sourceView
+ will not be forwarded. The forwarded event will be reported excluding
the original view as argument (i.e. as #keyPress:x:y:).
Use this, if the destination is a view."
- ^ self new destinationView:destinationView
+ ^ self new sourceView:sourceView; destinationView:destinationView
!
to:destination
@@ -205,6 +193,27 @@
^ self new destination:destination
!
+to:destination condition:aCondition
+ "create and return a new KeyboardForwarder to redirect any key event
+ to destinationView (Independent of the view in which the event originally
+ occurred) but only, if some condition as specified by aCondition
+ is met. The forwarded event will be reported including
+ the original view as argument (i.e. as #keyPress:x:y:view:).
+ Use this, if the destination is not a view."
+
+ ^ self new destination:destination; condition:aCondition
+!
+
+toView:destinationView
+ "create and return a new KeyboardForwarder to redirect any key event
+ to destinationView (Independent of the view in which the event originally
+ occurred). The forwarded event will be reported excluding
+ the original view as argument (i.e. as #keyPress:x:y:).
+ Use this, if the destination is a view."
+
+ ^ self new destinationView:destinationView
+!
+
toView:destinationView condition:aCondition
"create and return a new KeyboardForwarder to redirect any key event
to destinationView (Independent of the view in which the event originally
@@ -214,17 +223,6 @@
Use this, if the destination is a view."
^ self new destinationView:destinationView; condition:aCondition
-!
-
-to:destination condition:aCondition
- "create and return a new KeyboardForwarder to redirect any key event
- to destinationView (Independent of the view in which the event originally
- occurred) but only, if some condition as specified by aCondition
- is met. The forwarded event will be reported including
- the original view as argument (i.e. as #keyPress:x:y:view:).
- Use this, if the destination is not a view."
-
- ^ self new destination:destination; condition:aCondition
! !
!KeyboardForwarder methodsFor:'accessing'!
@@ -235,16 +233,10 @@
condition := aCondition
!
-destinationView:aView
- "set the destination view"
+destination
+ "return the destination"
- destinationView := aView
-!
-
-destinationView
- "return the destination view"
-
- ^ destinationView
+ ^ destination
!
destination:anObject
@@ -254,61 +246,28 @@
destination := anObject
!
-destination
- "return the destination"
+destinationView
+ "return the destination view"
- ^ destination
+ ^ destinationView
!
-sourceView:aView
- "set the sourceView - if nonNil, only events from this view will be forwarded"
+destinationView:aView
+ "set the destination view"
- sourceView := aView
+ destinationView := aView
!
sourceView
"get the sourceView - if nonNil, only events from this view will be forwarded"
^ sourceView
-! !
-
-!KeyboardForwarder methodsFor:'queries'!
-
-delegatesTo:someone
- "return true, if I delegate events to someone"
-
- ^ destination == someone or:[destinationView == someone]
!
-checkCondition:type key:key view:aView
- condition notNil ifTrue:[
- condition == #noFocus ifTrue:[
- aView windowGroup focusView notNil ifTrue:[^ false]
- ].
- condition isBlock ifTrue:[
- (condition value:type value:key value:aView) ifFalse:[^ false]
- ]
- ].
- sourceView notNil ifTrue:[
- ^ aView == sourceView
- ].
- ^ true
-!
+sourceView:aView
+ "set the sourceView - if nonNil, only events from this view will be forwarded"
-handlesKeyPress:key inView:aView
- "this is the query from the sensor to ask me if I would like to
- get a keyPress event for key from aView. Return true, if I want so,
- false otherwise."
-
- ^ self checkCondition:#keyPress key:key view:aView
-!
-
-handlesKeyRelease:key inView:aView
- "this is the query from the sensor to ask me if I would like to
- get a keyRelease event for key from aView. Return true, if I want so,
- false otherwise."
-
- ^ self checkCondition:#keyRelease key:key view:aView
+ sourceView := aView
! !
!KeyboardForwarder methodsFor:'event forwarding'!
@@ -360,3 +319,43 @@
]
]
! !
+
+!KeyboardForwarder methodsFor:'queries'!
+
+checkCondition:type key:key view:aView
+ condition notNil ifTrue:[
+ condition == #noFocus ifTrue:[
+ aView windowGroup focusView notNil ifTrue:[^ false]
+ ].
+ condition isBlock ifTrue:[
+ (condition value:type value:key value:aView) ifFalse:[^ false]
+ ]
+ ].
+ sourceView notNil ifTrue:[
+ ^ aView == sourceView
+ ].
+ ^ true
+!
+
+delegatesTo:someone
+ "return true, if I delegate events to someone"
+
+ ^ destination == someone or:[destinationView == someone]
+!
+
+handlesKeyPress:key inView:aView
+ "this is the query from the sensor to ask me if I would like to
+ get a keyPress event for key from aView. Return true, if I want so,
+ false otherwise."
+
+ ^ self checkCondition:#keyPress key:key view:aView
+!
+
+handlesKeyRelease:key inView:aView
+ "this is the query from the sensor to ask me if I would like to
+ get a keyRelease event for key from aView. Return true, if I want so,
+ false otherwise."
+
+ ^ self checkCondition:#keyRelease key:key view:aView
+! !
+
--- a/KeyboardMap.st Thu Nov 23 03:29:10 1995 +0100
+++ b/KeyboardMap.st Thu Nov 23 11:38:43 1995 +0100
@@ -10,11 +10,11 @@
hereby transferred.
"
-IdentityDictionary subclass:#KeyboardMap
- instanceVariableNames:'current'
- classVariableNames:''
- poolDictionaries:''
- category:'Interface-Support'
+IdentityDictionary subclass:#KeyboardMap
+ instanceVariableNames:'current'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Interface-Support'
!
!KeyboardMap class methodsFor:'documentation'!
@@ -33,10 +33,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libview/KeyboardMap.st,v 1.7 1995-11-11 15:51:38 cg Exp $'
-!
-
documentation
"
instances of KeyboardMap are used for mapping keystrokes AND sequences
@@ -75,6 +71,10 @@
m := Display keyboardMap.
m bindValue:#Cmdd to:#Cmdd.
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/KeyboardMap.st,v 1.8 1995-11-23 10:37:52 cg Exp $'
! !
!KeyboardMap methodsFor:'accessing'!
@@ -111,3 +111,4 @@
current := nil.
^ value
! !
+
--- a/ResourcePack.st Thu Nov 23 03:29:10 1995 +0100
+++ b/ResourcePack.st Thu Nov 23 11:38:43 1995 +0100
@@ -33,10 +33,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libview/ResourcePack.st,v 1.20 1995-11-11 15:51:55 cg Exp $'
-!
-
documentation
"
to allow easy customization of smalltalk code (i.e. internationalization)
@@ -155,18 +151,14 @@
Language := #english
Language := #german
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/ResourcePack.st,v 1.21 1995-11-23 10:38:02 cg Exp $'
! !
!ResourcePack class methodsFor:'initialization'!
-initialize
- Packs isNil ifTrue:[
- Packs := WeakArray new:30
- ].
-
- "ResourcePack initialize"
-!
-
flushCachedResourcePacks
"forget all cached resources - needed after a style change"
@@ -174,6 +166,67 @@
self initialize
"ResourcePack flushCachedResourcePacks"
+!
+
+initialize
+ Packs isNil ifTrue:[
+ Packs := WeakArray new:30
+ ].
+
+ "ResourcePack initialize"
+! !
+
+!ResourcePack class methodsFor:'instance creation'!
+
+for:aClass
+ "get the full resource definitions for aClass (i.e. with super packs).
+ Also leave the resulting pack in the cache for faster access next time."
+
+ |nm pack superPack|
+
+ nm := aClass name.
+ pack := self searchCacheFor:nm.
+ pack notNil ifTrue:[^ pack].
+
+ pack := self fromFile:(Smalltalk fileNameForClass:nm) , '.rs'.
+ aClass == Object ifFalse:[
+ superPack := self for:(aClass superclass).
+ pack := pack merge:superPack
+ ].
+ pack packsClassName:nm.
+ self addToCache:pack.
+ ^ pack
+
+ "
+ ResourcePack for:TextView
+ ResourcePack for:CodeView
+ ResourcePack for:Workspace
+ Workspace classResources
+ "
+!
+
+fromFile:aFileName
+ "get the resource definitions from a file in the default directory.
+ Uncached low-level entry."
+
+ ^ self fromFile:aFileName directory:'resources'
+
+ "
+ ResourcePack fromFile:'SBrowser.rs'
+ ResourcePack fromFile:'FBrowser.rs'
+ ResourcePack fromFile:'Smalltalk.rs'
+ "
+!
+
+fromFile:aFileName directory:dirName
+ "get the resource definitions from a file in a directory.
+ Uncached low-level entry."
+
+ |newPack|
+
+ newPack := self new.
+ newPack readFromFile:aFileName directory:dirName.
+ ^ newPack
! !
!ResourcePack class methodsFor:'private'!
@@ -223,85 +276,12 @@
"
! !
-!ResourcePack class methodsFor:'instance creation'!
-
-fromFile:aFileName directory:dirName
- "get the resource definitions from a file in a directory.
- Uncached low-level entry."
-
- |newPack|
-
- newPack := self new.
- newPack readFromFile:aFileName directory:dirName.
- ^ newPack
-!
-
-fromFile:aFileName
- "get the resource definitions from a file in the default directory.
- Uncached low-level entry."
-
- ^ self fromFile:aFileName directory:'resources'
-
- "
- ResourcePack fromFile:'SBrowser.rs'
- ResourcePack fromFile:'FBrowser.rs'
- ResourcePack fromFile:'Smalltalk.rs'
- "
-!
-
-for:aClass
- "get the full resource definitions for aClass (i.e. with super packs).
- Also leave the resulting pack in the cache for faster access next time."
-
- |nm pack superPack|
-
- nm := aClass name.
- pack := self searchCacheFor:nm.
- pack notNil ifTrue:[^ pack].
-
- pack := self fromFile:(Smalltalk fileNameForClass:nm) , '.rs'.
- aClass == Object ifFalse:[
- superPack := self for:(aClass superclass).
- pack := pack merge:superPack
- ].
- pack packsClassName:nm.
- self addToCache:pack.
- ^ pack
-
- "
- ResourcePack for:TextView
- ResourcePack for:CodeView
- ResourcePack for:Workspace
- Workspace classResources
- "
-! !
-
-!ResourcePack methodsFor:'merging'!
-
-merge:anotherPack
- anotherPack keysAndValuesDo:[:key :value |
- (self includesKey:key) ifFalse:[
- self at:key put:value
- ]
- ]
-! !
-
!ResourcePack methodsFor:'accessing'!
-dependents:aCollection
- dependents := aCollection
-!
+array:anArray
+ "translate a collection of strings"
-dependents
- ^ dependents
-!
-
-packsClassName
- ^ packsClassName
-!
-
-packsClassName:aString
- packsClassName := aString
+ ^ anArray collect:[:r | self at:r default:r]
!
at:aKey
@@ -316,6 +296,14 @@
^ self at:aKey ifAbsent:default
!
+dependents
+ ^ dependents
+!
+
+dependents:aCollection
+ dependents := aCollection
+!
+
name:aKey
"translate a string"
@@ -328,10 +316,12 @@
^ self at:aKey ifAbsent:default
!
-array:anArray
- "translate a collection of strings"
+packsClassName
+ ^ packsClassName
+!
- ^ anArray collect:[:r | self at:r default:r]
+packsClassName:aString
+ packsClassName := aString
!
string:s
@@ -363,31 +353,6 @@
!ResourcePack methodsFor:'file reading'!
-readFromFile:fileName directory:dirName
- "read definitions from a file in a directory"
-
- |inStream ok|
-
- dirName = 'resources' ifTrue:[
- inStream := Smalltalk resourceFileStreamFor:fileName
- ] ifFalse:[
- inStream := Smalltalk systemFileStreamFor:(dirName , '/' , fileName).
- ].
- inStream isNil ifTrue:[
- "
- an empty pack
- "
- ^ nil
- ].
- ok := self readFromResourceStream:inStream in:dirName.
- inStream close.
- ok ifFalse:[
- ('RESOURCEPACK: ''' , fileName , ''' contains error(s) - data may be incomplete.') errorPrintNL.
- ].
-
- "Modified: 8.11.1995 / 15:14:04 / cg"
-!
-
processLine:aLine
"process a single valid line (i.e. #ifdef & #include has already been processed)"
@@ -443,6 +408,31 @@
]
!
+readFromFile:fileName directory:dirName
+ "read definitions from a file in a directory"
+
+ |inStream ok|
+
+ dirName = 'resources' ifTrue:[
+ inStream := Smalltalk resourceFileStreamFor:fileName
+ ] ifFalse:[
+ inStream := Smalltalk systemFileStreamFor:(dirName , '/' , fileName).
+ ].
+ inStream isNil ifTrue:[
+ "
+ an empty pack
+ "
+ ^ nil
+ ].
+ ok := self readFromResourceStream:inStream in:dirName.
+ inStream close.
+ ok ifFalse:[
+ ('RESOURCEPACK: ''' , fileName , ''' contains error(s) - data may be incomplete.') errorPrintNL.
+ ].
+
+ "Modified: 8.11.1995 / 15:14:04 / cg"
+!
+
readFromResourceStream:inStream in:dirName
"read definitions from a stream. THe dirName argument is required to
specify where #include files are searched for.
@@ -520,4 +510,14 @@
"Modified: 8.11.1995 / 15:12:21 / cg"
! !
+!ResourcePack methodsFor:'merging'!
+
+merge:anotherPack
+ anotherPack keysAndValuesDo:[:key :value |
+ (self includesKey:key) ifFalse:[
+ self at:key put:value
+ ]
+ ]
+! !
+
ResourcePack initialize!
--- a/RsrcPack.st Thu Nov 23 03:29:10 1995 +0100
+++ b/RsrcPack.st Thu Nov 23 11:38:43 1995 +0100
@@ -33,10 +33,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libview/Attic/RsrcPack.st,v 1.20 1995-11-11 15:51:55 cg Exp $'
-!
-
documentation
"
to allow easy customization of smalltalk code (i.e. internationalization)
@@ -155,18 +151,14 @@
Language := #english
Language := #german
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/Attic/RsrcPack.st,v 1.21 1995-11-23 10:38:02 cg Exp $'
! !
!ResourcePack class methodsFor:'initialization'!
-initialize
- Packs isNil ifTrue:[
- Packs := WeakArray new:30
- ].
-
- "ResourcePack initialize"
-!
-
flushCachedResourcePacks
"forget all cached resources - needed after a style change"
@@ -174,6 +166,67 @@
self initialize
"ResourcePack flushCachedResourcePacks"
+!
+
+initialize
+ Packs isNil ifTrue:[
+ Packs := WeakArray new:30
+ ].
+
+ "ResourcePack initialize"
+! !
+
+!ResourcePack class methodsFor:'instance creation'!
+
+for:aClass
+ "get the full resource definitions for aClass (i.e. with super packs).
+ Also leave the resulting pack in the cache for faster access next time."
+
+ |nm pack superPack|
+
+ nm := aClass name.
+ pack := self searchCacheFor:nm.
+ pack notNil ifTrue:[^ pack].
+
+ pack := self fromFile:(Smalltalk fileNameForClass:nm) , '.rs'.
+ aClass == Object ifFalse:[
+ superPack := self for:(aClass superclass).
+ pack := pack merge:superPack
+ ].
+ pack packsClassName:nm.
+ self addToCache:pack.
+ ^ pack
+
+ "
+ ResourcePack for:TextView
+ ResourcePack for:CodeView
+ ResourcePack for:Workspace
+ Workspace classResources
+ "
+!
+
+fromFile:aFileName
+ "get the resource definitions from a file in the default directory.
+ Uncached low-level entry."
+
+ ^ self fromFile:aFileName directory:'resources'
+
+ "
+ ResourcePack fromFile:'SBrowser.rs'
+ ResourcePack fromFile:'FBrowser.rs'
+ ResourcePack fromFile:'Smalltalk.rs'
+ "
+!
+
+fromFile:aFileName directory:dirName
+ "get the resource definitions from a file in a directory.
+ Uncached low-level entry."
+
+ |newPack|
+
+ newPack := self new.
+ newPack readFromFile:aFileName directory:dirName.
+ ^ newPack
! !
!ResourcePack class methodsFor:'private'!
@@ -223,85 +276,12 @@
"
! !
-!ResourcePack class methodsFor:'instance creation'!
-
-fromFile:aFileName directory:dirName
- "get the resource definitions from a file in a directory.
- Uncached low-level entry."
-
- |newPack|
-
- newPack := self new.
- newPack readFromFile:aFileName directory:dirName.
- ^ newPack
-!
-
-fromFile:aFileName
- "get the resource definitions from a file in the default directory.
- Uncached low-level entry."
-
- ^ self fromFile:aFileName directory:'resources'
-
- "
- ResourcePack fromFile:'SBrowser.rs'
- ResourcePack fromFile:'FBrowser.rs'
- ResourcePack fromFile:'Smalltalk.rs'
- "
-!
-
-for:aClass
- "get the full resource definitions for aClass (i.e. with super packs).
- Also leave the resulting pack in the cache for faster access next time."
-
- |nm pack superPack|
-
- nm := aClass name.
- pack := self searchCacheFor:nm.
- pack notNil ifTrue:[^ pack].
-
- pack := self fromFile:(Smalltalk fileNameForClass:nm) , '.rs'.
- aClass == Object ifFalse:[
- superPack := self for:(aClass superclass).
- pack := pack merge:superPack
- ].
- pack packsClassName:nm.
- self addToCache:pack.
- ^ pack
-
- "
- ResourcePack for:TextView
- ResourcePack for:CodeView
- ResourcePack for:Workspace
- Workspace classResources
- "
-! !
-
-!ResourcePack methodsFor:'merging'!
-
-merge:anotherPack
- anotherPack keysAndValuesDo:[:key :value |
- (self includesKey:key) ifFalse:[
- self at:key put:value
- ]
- ]
-! !
-
!ResourcePack methodsFor:'accessing'!
-dependents:aCollection
- dependents := aCollection
-!
+array:anArray
+ "translate a collection of strings"
-dependents
- ^ dependents
-!
-
-packsClassName
- ^ packsClassName
-!
-
-packsClassName:aString
- packsClassName := aString
+ ^ anArray collect:[:r | self at:r default:r]
!
at:aKey
@@ -316,6 +296,14 @@
^ self at:aKey ifAbsent:default
!
+dependents
+ ^ dependents
+!
+
+dependents:aCollection
+ dependents := aCollection
+!
+
name:aKey
"translate a string"
@@ -328,10 +316,12 @@
^ self at:aKey ifAbsent:default
!
-array:anArray
- "translate a collection of strings"
+packsClassName
+ ^ packsClassName
+!
- ^ anArray collect:[:r | self at:r default:r]
+packsClassName:aString
+ packsClassName := aString
!
string:s
@@ -363,31 +353,6 @@
!ResourcePack methodsFor:'file reading'!
-readFromFile:fileName directory:dirName
- "read definitions from a file in a directory"
-
- |inStream ok|
-
- dirName = 'resources' ifTrue:[
- inStream := Smalltalk resourceFileStreamFor:fileName
- ] ifFalse:[
- inStream := Smalltalk systemFileStreamFor:(dirName , '/' , fileName).
- ].
- inStream isNil ifTrue:[
- "
- an empty pack
- "
- ^ nil
- ].
- ok := self readFromResourceStream:inStream in:dirName.
- inStream close.
- ok ifFalse:[
- ('RESOURCEPACK: ''' , fileName , ''' contains error(s) - data may be incomplete.') errorPrintNL.
- ].
-
- "Modified: 8.11.1995 / 15:14:04 / cg"
-!
-
processLine:aLine
"process a single valid line (i.e. #ifdef & #include has already been processed)"
@@ -443,6 +408,31 @@
]
!
+readFromFile:fileName directory:dirName
+ "read definitions from a file in a directory"
+
+ |inStream ok|
+
+ dirName = 'resources' ifTrue:[
+ inStream := Smalltalk resourceFileStreamFor:fileName
+ ] ifFalse:[
+ inStream := Smalltalk systemFileStreamFor:(dirName , '/' , fileName).
+ ].
+ inStream isNil ifTrue:[
+ "
+ an empty pack
+ "
+ ^ nil
+ ].
+ ok := self readFromResourceStream:inStream in:dirName.
+ inStream close.
+ ok ifFalse:[
+ ('RESOURCEPACK: ''' , fileName , ''' contains error(s) - data may be incomplete.') errorPrintNL.
+ ].
+
+ "Modified: 8.11.1995 / 15:14:04 / cg"
+!
+
readFromResourceStream:inStream in:dirName
"read definitions from a stream. THe dirName argument is required to
specify where #include files are searched for.
@@ -520,4 +510,14 @@
"Modified: 8.11.1995 / 15:12:21 / cg"
! !
+!ResourcePack methodsFor:'merging'!
+
+merge:anotherPack
+ anotherPack keysAndValuesDo:[:key :value |
+ (self includesKey:key) ifFalse:[
+ self at:key put:value
+ ]
+ ]
+! !
+
ResourcePack initialize!
--- a/WEvent.st Thu Nov 23 03:29:10 1995 +0100
+++ b/WEvent.st Thu Nov 23 11:38:43 1995 +0100
@@ -33,10 +33,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libview/Attic/WEvent.st,v 1.20 1995-11-11 15:53:22 cg Exp $'
-!
-
documentation
"
Instances of WindowEvent are created for every event coming from
@@ -113,15 +109,20 @@
view has no transformation
----> 'view keyPress:key x:x y:y'
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/Attic/WEvent.st,v 1.21 1995-11-23 10:38:12 cg Exp $'
! !
!WindowEvent class methodsFor:'instance creation'!
-for:aView type:aSymbol arguments:argArray
- "create and return a new windowEvent for sending
- aSymbol-message with arguments to aView"
+damageFor:aView rectangle:aRectangle
+ "create and return a new damage Event for aRectangle
+ in aView"
- ^ (self new) for:aView type:aSymbol arguments:argArray
+ ^ (self new) for:aView type:#damage arguments:aRectangle
+
!
for:aView type:aSymbol
@@ -131,90 +132,11 @@
^ (self new) for:aView type:aSymbol arguments:#()
!
-damageFor:aView rectangle:aRectangle
- "create and return a new damage Event for aRectangle
- in aView"
-
- ^ (self new) for:aView type:#damage arguments:aRectangle
-
-! !
-
-!WindowEvent methodsFor:'queries'!
-
-isKeyEvent
- "return true, if this event is a keyboard event"
-
- ^ (type == #keyPress:x:y:) or:[type == #keyRelease:x:y:]
-!
-
-isKeyPressEvent
- "return true, if this event is a keyboard event"
-
- ^ (type == #keyPress:x:y:)
-!
-
-isButtonEvent
- "return true, if this event is a button event"
-
- ^ (type == #buttonPress:x:y:)
- or:[type == #buttonRelease:x:y:
- or:[type == #'buttonShiftPress:x:y:'
- or:[type == #'buttonMultiPress:x:y:'
- or:[type == #'buttonMotion:x:y:']]]]
-!
-
-isDamage
- "return true, if this is a damage event"
-
- ^ type == #damage
-! !
-
-!WindowEvent methodsFor:'accessing'!
+for:aView type:aSymbol arguments:argArray
+ "create and return a new windowEvent for sending
+ aSymbol-message with arguments to aView"
-view
- "return the view, for which the event is for"
-
- ^ view
-!
-
-view:aView
- "set the view, for which the event is for"
-
- view := aView
-!
-
-type
- "return the type of the event"
-
- ^ type
-!
-
-arguments
- "return the arguments of the event"
-
- ^ arguments
-!
-
-arguments:anArray
- "set the arguments"
-
- arguments := anArray
-!
-
-rectangle
- "return the damage rectangle"
-
- ^ arguments "consider this a kludge"
-!
-
-key
- "return the key of the key-event. For non key-events, nil is returned."
-
- ((type == #keyPress:x:y:)
- or:[type == #keyRelease:x:y:]) ifTrue:[
- ^ arguments at:1
- ].
- ^ nil
+ ^ (self new) for:aView type:aSymbol arguments:argArray
! !
!WindowEvent class methodsFor:'forwarding events'!
@@ -428,6 +350,94 @@
eventReceiver perform:selector withArguments:argArray
! !
+!WindowEvent methodsFor:'accessing'!
+
+arguments
+ "return the arguments of the event"
+
+ ^ arguments
+!
+
+arguments:anArray
+ "set the arguments"
+
+ arguments := anArray
+!
+
+key
+ "return the key of the key-event. For non key-events, nil is returned."
+
+ ((type == #keyPress:x:y:)
+ or:[type == #keyRelease:x:y:]) ifTrue:[
+ ^ arguments at:1
+ ].
+ ^ nil
+!
+
+rectangle
+ "return the damage rectangle"
+
+ ^ arguments "consider this a kludge"
+!
+
+type
+ "return the type of the event"
+
+ ^ type
+!
+
+view
+ "return the view, for which the event is for"
+
+ ^ view
+!
+
+view:aView
+ "set the view, for which the event is for"
+
+ view := aView
+! !
+
+!WindowEvent methodsFor:'private accessing'!
+
+for:aView type:aSymbol arguments:argArray
+ "set the instance variables of the event"
+
+ view := aView.
+ type := aSymbol.
+ arguments := argArray
+! !
+
+!WindowEvent methodsFor:'queries'!
+
+isButtonEvent
+ "return true, if this event is a button event"
+
+ ^ (type == #buttonPress:x:y:)
+ or:[type == #buttonRelease:x:y:
+ or:[type == #'buttonShiftPress:x:y:'
+ or:[type == #'buttonMultiPress:x:y:'
+ or:[type == #'buttonMotion:x:y:']]]]
+!
+
+isDamage
+ "return true, if this is a damage event"
+
+ ^ type == #damage
+!
+
+isKeyEvent
+ "return true, if this event is a keyboard event"
+
+ ^ (type == #keyPress:x:y:) or:[type == #keyRelease:x:y:]
+!
+
+isKeyPressEvent
+ "return true, if this event is a keyboard event"
+
+ ^ (type == #keyPress:x:y:)
+! !
+
!WindowEvent methodsFor:'sending'!
sendEvent
@@ -452,12 +462,3 @@
delegate:true
! !
-!WindowEvent methodsFor:'private accessing'!
-
-for:aView type:aSymbol arguments:argArray
- "set the instance variables of the event"
-
- view := aView.
- type := aSymbol.
- arguments := argArray
-! !
--- a/WGroup.st Thu Nov 23 03:29:10 1995 +0100
+++ b/WGroup.st Thu Nov 23 11:38:43 1995 +0100
@@ -11,8 +11,8 @@
"
Object subclass:#WindowGroup
- instanceVariableNames:'views topViews myProcess mySensor isModal previousGroup
- focusView focusSequence preEventHook postEventHook'
+ instanceVariableNames:'views topViews myProcess mySensor isModal previousGroup focusView
+ focusSequence preEventHook postEventHook'
classVariableNames:'LastActiveGroup LastActiveProcess LeaveSignal'
poolDictionaries:''
category:'Interface-Support'
@@ -34,10 +34,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libview/Attic/WGroup.st,v 1.35 1995-11-13 17:11:01 cg Exp $'
-!
-
documentation
"
In Smalltalk/X, the known (ST-80) concept of a controller has been
@@ -127,6 +123,10 @@
For more information, read 'introduction to view programming' in the
doc/online directory.
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/Attic/WGroup.st,v 1.36 1995-11-23 10:38:24 cg Exp $'
! !
!WindowGroup class methodsFor:'initialization'!
@@ -141,6 +141,14 @@
"WindowGroup initialize"
! !
+!WindowGroup class methodsFor:'instance creation'!
+
+new
+ "create and return a new WindowGroup object"
+
+ ^ self basicNew initialize
+! !
+
!WindowGroup class methodsFor:'Signal constants'!
leaveSignal
@@ -152,14 +160,6 @@
^ LeaveSignal
! !
-!WindowGroup class methodsFor:'instance creation'!
-
-new
- "create and return a new WindowGroup object"
-
- ^ self basicNew initialize
-! !
-
!WindowGroup class methodsFor:'accessing'!
activeGroup
@@ -212,14 +212,6 @@
"Modified: 3.9.1995 / 14:49:53 / claus"
!
-setActiveGroup:aGroup
- "set the currently active windowGroup.
- Temporary; do not use this interface, it will vanish."
-
- LastActiveProcess := Processor activeProcess.
- LastActiveGroup := aGroup
-!
-
scheduledWindowGroups
"return a collection of all windowGroups (possibly for different
display devices) which are scheduled (i.e. which have a process
@@ -249,14 +241,25 @@
"
"Modified: 1.9.1995 / 13:43:09 / claus"
+!
+
+setActiveGroup:aGroup
+ "set the currently active windowGroup.
+ Temporary; do not use this interface, it will vanish."
+
+ LastActiveProcess := Processor activeProcess.
+ LastActiveGroup := aGroup
! !
!WindowGroup methodsFor:'accessing'!
-sensor
- "return the windowGroups sensor"
+addTopView:aView
+ "add a topview to the group"
- ^ mySensor
+ topViews isNil ifTrue:[
+ topViews := OrderedCollection new.
+ ].
+ topViews add:aView
!
addView:aView
@@ -268,13 +271,57 @@
views add:aView
!
-addTopView:aView
- "add a topview to the group"
+isModal
+ "return true, if I am in a modal mode"
+
+ ^ isModal
+!
+
+mainGroup
+ "return the main windowgroup
+ (that is the top one, which is not modal).
+ There is one exception to this: the debugger (which is sort of modal)
+ returns itself as mainGroup (not its debuggee)."
+
+ |g prev|
+
+ g := self.
+ [g notNil and:[g isModal and:[(prev := g previousGroup) notNil]]] whileTrue:[
+ g := prev
+ ].
+ ^ g
+
+ "Modified: 3.9.1995 / 14:57:20 / claus"
+!
- topViews isNil ifTrue:[
- topViews := OrderedCollection new.
- ].
- topViews add:aView
+postEventHook:anObject
+ "set the postEventHook - this one will get all events
+ passed after being processed here (via #processEvent:)."
+
+ postEventHook := anObject
+!
+
+preEventHook:anObject
+ "set the preEventHook - this one will get all events
+ passed before being processed here (via #processEvent:).
+ If this returns true, the event is supposed to be already
+ processed and ignored here.
+ Otherwise, it is processed as usual."
+
+ preEventHook := anObject
+!
+
+previousGroup
+ "return the windowgroup that started this group.
+ (for modal groups only)"
+
+ ^ previousGroup
+!
+
+process
+ "return the windowGroups process"
+
+ ^ myProcess
!
removeView:aView
@@ -303,52 +350,10 @@
mySensor notNil ifTrue:[mySensor eventSemaphore signal]
!
-views
- "return the views accociated to this windowGroup"
-
- ^ views
-!
-
-topViews
- "return the topviews accociated to this windowGroup"
-
- ^ topViews
-!
-
-process
- "return the windowGroups process"
-
- ^ myProcess
-!
-
-isModal
- "return true, if I am in a modal mode"
+sensor
+ "return the windowGroups sensor"
- ^ isModal
-!
-
-previousGroup
- "return the windowgroup that started this group.
- (for modal groups only)"
-
- ^ previousGroup
-!
-
-mainGroup
- "return the main windowgroup
- (that is the top one, which is not modal).
- There is one exception to this: the debugger (which is sort of modal)
- returns itself as mainGroup (not its debuggee)."
-
- |g prev|
-
- g := self.
- [g notNil and:[g isModal and:[(prev := g previousGroup) notNil]]] whileTrue:[
- g := prev
- ].
- ^ g
-
- "Modified: 3.9.1995 / 14:57:20 / claus"
+ ^ mySensor
!
sensor:aSensor
@@ -357,64 +362,156 @@
mySensor := aSensor
!
-preEventHook:anObject
- "set the preEventHook - this one will get all events
- passed before being processed here (via #processEvent:).
- If this returns true, the event is supposed to be already
- processed and ignored here.
- Otherwise, it is processed as usual."
+topViews
+ "return the topviews accociated to this windowGroup"
- preEventHook := anObject
+ ^ topViews
!
-postEventHook:anObject
- "set the postEventHook - this one will get all events
- passed after being processed here (via #processEvent:)."
+views
+ "return the views accociated to this windowGroup"
- postEventHook := anObject
+ ^ views
! !
-!WindowGroup methodsFor:'special accessing'!
+!WindowGroup methodsFor:'activation / deactivation'!
+
+closeDownViews
+ "destroy all views associated to this window group"
+
+ topViews notNil ifTrue:[
+ topViews do:[:aTopView | aTopView destroy]
+ ].
+ views := nil.
+ topViews := nil.
+ mySensor := nil.
+!
+
+realizeTopViews:isRestart
+ "realize all topViews associated to this windowGroup.
+ If this is a restart, tell topViews about it."
+
+ topViews notNil ifTrue:[
+ topViews do:[:aView |
+ aView realize.
+ isRestart ifTrue:[
+ aView restarted
+ ]
+ ].
+ ].
+!
-setPreviousGroup:aGroup
- "special entry for debugger:
- set the windowgroup that started this group (for modal groups only).
- This is not a public interface."
+restart
+ "restart after a snapin."
- previousGroup := aGroup
+ topViews notNil ifTrue:[
+ "
+ need a new semaphore, since obsolete processes
+ (from our previous live) may still sit on the current semaphore
+ "
+ mySensor eventSemaphore:Semaphore new.
+ isModal ifFalse:[
+ self startup:true
+ ]
+ ]
+!
- "Modified: 3.9.1995 / 14:55:40 / claus"
+shutdown
+ "shutdow the window group; close all views and
+ terminate process"
+
+ |p|
+
+ self closeDownViews.
+ myProcess notNil ifTrue:[
+ p := myProcess.
+ myProcess := nil.
+ p terminate.
+ ]
!
-setModal:aBoolean
- "special entry for debugger: set the modal flag.
- Not for public use"
+startup:isRestart
+ "startup the window-group;
+ this creates a new window group process, which
+ does the event processing."
+
+ |top nm dev devNm|
+
+ previousGroup := nil.
+ myProcess isNil ifTrue:[
+ isModal := false.
+ myProcess := [
+ self realizeTopViews:isRestart.
+ self eventLoopWhile:[true] onLeave:[]
+ ] forkAt:Processor userSchedulingPriority.
- isModal := aBoolean
+ (topViews notNil and:[topViews isEmpty not]) ifTrue:[
+ "
+ give the handler process a user friendly name
+ "
+ top := topViews first.
+ nm := top processName.
+ (dev := top device) notNil ifTrue:[
+ devNm := dev displayName.
+ (devNm notNil and:[devNm ~= Display displayName]) ifTrue:[
+ nm := nm , ' (' , devNm , ')'
+ ]
+ ]
+ ] ifFalse:[
+ nm := 'window handler'.
+ ].
+ myProcess name:nm.
- "Modified: 3.9.1995 / 14:51:04 / claus"
+ "when the process dies, we have to close-down
+ the views as well
+ "
+ myProcess exitAction:[self closeDownViews]
+ ]
!
-setProcess:aProcess
- "special entry for debugger: set the windowGroups process.
- Not for public use."
+startupModal:checkBlock
+ "startup the window-group in a modal loop (i.e. under the
+ currently running process);
+ checkBlock is evaluated and loop is left, when false is
+ returned."
+
+ "set previousGroup to the main (non-modal) group"
- myProcess := aProcess
-
- "Modified: 3.9.1995 / 14:25:38 / claus"
+ previousGroup := WindowGroup activeGroup.
+ isModal := true.
+ self realizeTopViews:false.
+ self
+ eventLoopWhile:checkBlock
+ onLeave:[
+ "
+ cleanup, in case of a terminate
+ "
+ previousGroup := nil.
+ topViews := nil.
+ views := nil.
+ "
+ the following is rubbish;
+ the views could be reused ..
+ "
+"
+ topViews notNil ifTrue:[
+ topViews do:[:aView |
+ aView destroy
+ ].
+ topViews := nil.
+ ].
+ views notNil ifTrue:[
+ views do:[:aView |
+ aView destroy
+ ].
+ views := nil.
+ ].
+"
+ ]
! !
!WindowGroup methodsFor:'enumerating'!
-allViewsDo:aBlock
- "evaluate aBlock for all views & topviews in this group.
- This works on a copy of the view collection, to allow for
- destroy and other collection changing operations to be done."
-
- topViews notNil ifTrue:[topViews copy do:aBlock].
- views notNil ifTrue:[views copy do:aBlock]
-!
-
allTopViewsExcept:aView do:aBlock
"evaluate aBlock for all topviews except aView in this group.
This works on a copy of the view collection, to allow for
@@ -427,6 +524,29 @@
].
!
+allViewsDo:aBlock
+ "evaluate aBlock for all views & topviews in this group.
+ This works on a copy of the view collection, to allow for
+ destroy and other collection changing operations to be done."
+
+ topViews notNil ifTrue:[topViews copy do:aBlock].
+ views notNil ifTrue:[views copy do:aBlock]
+!
+
+partnersDo:aBlock
+ "evaluate aBlock for all partnerViews.
+ This works on a copy of the view collection, to allow for
+ destroy and other collection changing operations to be done."
+
+ topViews notNil ifTrue:[
+ topViews copy do:[:v |
+ v notNil ifTrue:[
+ v type == #partner ifTrue:[aBlock value:v].
+ ]
+ ]
+ ].
+!
+
slavesDo:aBlock
"evaluate aBlock for all slaveViews.
This works on a copy of the view collection, to allow for
@@ -439,75 +559,102 @@
]
]
].
-!
-
-partnersDo:aBlock
- "evaluate aBlock for all partnerViews.
- This works on a copy of the view collection, to allow for
- destroy and other collection changing operations to be done."
-
- topViews notNil ifTrue:[
- topViews copy do:[:v |
- v notNil ifTrue:[
- v type == #partner ifTrue:[aBlock value:v].
- ]
- ]
- ].
-! !
-
-!WindowGroup methodsFor:'special'!
-
-showCursor:aCursor
- "change the cursor to aCursor in all of my views."
-
- |c|
-
- c := aCursor.
- self allViewsDo:[:aView |
- c := c on:(aView device).
- aView device setCursor:c id in:aView id.
- ].
-!
-
-restoreCursors
- "restore the original cursors in all of my views"
-
- |c|
-
- self allViewsDo:[:aView |
- c := aView cursor on:(aView device).
- aView device setCursor:(c id) in:(aView id).
- ].
-!
-
-withCursor:aCursor do:aBlock
- "evaluate aBlock while showing aCursor in all
- my views (used to show wait-cursor while doing something).
- Return the result as returned by aBlock."
-
- |oldCursors|
-
- "
- get mapping of view->cursor for all of my subviews
- "
- oldCursors := IdentityDictionary new.
- self allViewsDo:[:aView |
- oldCursors at:aView put:(aView cursor).
- aView cursor:aCursor
- ].
-
- ^ aBlock valueNowOrOnUnwindDo:[
- "
- restore cursors from the mapping
- "
- oldCursors keysAndValuesDo:[:view :cursor |
- view cursor:cursor
- ]
- ]
! !
!WindowGroup methodsFor:'event handling'!
+eventLoop
+ "loop executed by windowGroup process;
+ wait-for and process events forever"
+
+ self eventLoopWhile:[true] onLeave:[]
+!
+
+eventLoopWhile:aBlock onLeave:cleanupActions
+ "wait-for and process events.
+ Stay in this loop while there are still any views to dispatch for,
+ and aBlock evaluates to true."
+
+ |thisProcess|
+
+ thisProcess := Processor activeProcess.
+
+ [
+ "/
+ "/ on leave, exit the event loop
+ "/
+ LeaveSignal handle:[:ex |
+ ex return
+ ] do:[
+ |p g mainGroup|
+
+ isModal ifTrue:[
+ mainGroup := self mainGroup.
+ ].
+
+ aBlock whileTrue:[
+ LastActiveGroup := self.
+ LastActiveProcess := thisProcess.
+
+ (views isNil and:[topViews isNil]) ifTrue:[
+ myProcess notNil ifTrue:[
+ p := myProcess.
+ myProcess := nil.
+ p terminate.
+ "not reached - there is no life after death"
+ ].
+ "
+ this is the end of a modal loop
+ (not having a private process ...)
+ "
+ ^ self
+ ].
+
+ "/
+ "/ on abort, stay in the event loop
+ "/
+ AbortSignal handle:[:ex |
+ ex return
+ ] do:[
+ "
+ if modal, break out of the wait after some time
+ to allow servicing update-events of the blocked
+ windowgroup.
+ "
+ thisProcess setStateTo:#eventWait if:#active.
+ isModal ifTrue:[
+ mySensor eventSemaphore waitWithTimeout:0.2.
+ ] ifFalse:[
+ mySensor eventSemaphore wait.
+ ].
+ LastActiveGroup := self.
+ LastActiveProcess := thisProcess.
+ self processEvents.
+ ].
+
+ "
+ if modal, also check for redraw events in my maingroup
+ (we arrive here after every event for myself or after the
+ above timeout)
+ "
+ mainGroup notNil ifTrue:[
+ mainGroup processExposeEvents.
+ ]
+ ].
+ ].
+ ] valueNowOrOnUnwindDo:[
+ cleanupActions notNil ifTrue:[cleanupActions value]
+ ]
+!
+
+leaveEventLoop
+ "immediately leave the event loop, returning way back.
+ This can be used to leave (and closedown) a modal group.
+ (for normal views, this does not make sense)"
+
+ ^ LeaveSignal raise
+!
+
processEvents
"process events from either the damage- or user input queues.
Abort is assumed to be handled elsewhere."
@@ -620,90 +767,6 @@
]
!
-eventLoop
- "loop executed by windowGroup process;
- wait-for and process events forever"
-
- self eventLoopWhile:[true] onLeave:[]
-!
-
-eventLoopWhile:aBlock onLeave:cleanupActions
- "wait-for and process events.
- Stay in this loop while there are still any views to dispatch for,
- and aBlock evaluates to true."
-
- |thisProcess|
-
- thisProcess := Processor activeProcess.
-
- [
- "/
- "/ on leave, exit the event loop
- "/
- LeaveSignal handle:[:ex |
- ex return
- ] do:[
- |p g mainGroup|
-
- isModal ifTrue:[
- mainGroup := self mainGroup.
- ].
-
- aBlock whileTrue:[
- LastActiveGroup := self.
- LastActiveProcess := thisProcess.
-
- (views isNil and:[topViews isNil]) ifTrue:[
- myProcess notNil ifTrue:[
- p := myProcess.
- myProcess := nil.
- p terminate.
- "not reached - there is no life after death"
- ].
- "
- this is the end of a modal loop
- (not having a private process ...)
- "
- ^ self
- ].
-
- "/
- "/ on abort, stay in the event loop
- "/
- AbortSignal handle:[:ex |
- ex return
- ] do:[
- "
- if modal, break out of the wait after some time
- to allow servicing update-events of the blocked
- windowgroup.
- "
- thisProcess setStateTo:#eventWait if:#active.
- isModal ifTrue:[
- mySensor eventSemaphore waitWithTimeout:0.2.
- ] ifFalse:[
- mySensor eventSemaphore wait.
- ].
- LastActiveGroup := self.
- LastActiveProcess := thisProcess.
- self processEvents.
- ].
-
- "
- if modal, also check for redraw events in my maingroup
- (we arrive here after every event for myself or after the
- above timeout)
- "
- mainGroup notNil ifTrue:[
- mainGroup processExposeEvents.
- ]
- ].
- ].
- ] valueNowOrOnUnwindDo:[
- cleanupActions notNil ifTrue:[cleanupActions value]
- ]
-!
-
waitForExposeFor:aView
"wait for a noExpose on aView, then process all exposes.
To be used after a scroll"
@@ -712,182 +775,53 @@
AbortSignal catch:[
self processExposeEvents
]
-!
-
-leaveEventLoop
- "immediately leave the event loop, returning way back.
- This can be used to leave (and closedown) a modal group.
- (for normal views, this does not make sense)"
-
- ^ LeaveSignal raise
-! !
-
-!WindowGroup methodsFor:'activation / deactivation'!
-
-realizeTopViews:isRestart
- "realize all topViews associated to this windowGroup.
- If this is a restart, tell topViews about it."
-
- topViews notNil ifTrue:[
- topViews do:[:aView |
- aView realize.
- isRestart ifTrue:[
- aView restarted
- ]
- ].
- ].
-!
-
-restart
- "restart after a snapin."
-
- topViews notNil ifTrue:[
- "
- need a new semaphore, since obsolete processes
- (from our previous live) may still sit on the current semaphore
- "
- mySensor eventSemaphore:Semaphore new.
- isModal ifFalse:[
- self startup:true
- ]
- ]
-!
-
-startup:isRestart
- "startup the window-group;
- this creates a new window group process, which
- does the event processing."
-
- |top nm dev devNm|
-
- previousGroup := nil.
- myProcess isNil ifTrue:[
- isModal := false.
- myProcess := [
- self realizeTopViews:isRestart.
- self eventLoopWhile:[true] onLeave:[]
- ] forkAt:Processor userSchedulingPriority.
-
- (topViews notNil and:[topViews isEmpty not]) ifTrue:[
- "
- give the handler process a user friendly name
- "
- top := topViews first.
- nm := top processName.
- (dev := top device) notNil ifTrue:[
- devNm := dev displayName.
- (devNm notNil and:[devNm ~= Display displayName]) ifTrue:[
- nm := nm , ' (' , devNm , ')'
- ]
- ]
- ] ifFalse:[
- nm := 'window handler'.
- ].
- myProcess name:nm.
-
- "when the process dies, we have to close-down
- the views as well
- "
- myProcess exitAction:[self closeDownViews]
- ]
-!
-
-startupModal:checkBlock
- "startup the window-group in a modal loop (i.e. under the
- currently running process);
- checkBlock is evaluated and loop is left, when false is
- returned."
-
- "set previousGroup to the main (non-modal) group"
-
- previousGroup := WindowGroup activeGroup.
- isModal := true.
- self realizeTopViews:false.
- self
- eventLoopWhile:checkBlock
- onLeave:[
- "
- cleanup, in case of a terminate
- "
- previousGroup := nil.
- topViews := nil.
- views := nil.
- "
- the following is rubbish;
- the views could be reused ..
- "
-"
- topViews notNil ifTrue:[
- topViews do:[:aView |
- aView destroy
- ].
- topViews := nil.
- ].
- views notNil ifTrue:[
- views do:[:aView |
- aView destroy
- ].
- views := nil.
- ].
-"
- ]
-!
-
-closeDownViews
- "destroy all views associated to this window group"
-
- topViews notNil ifTrue:[
- topViews do:[:aTopView | aTopView destroy]
- ].
- views := nil.
- topViews := nil.
- mySensor := nil.
-!
-
-shutdown
- "shutdow the window group; close all views and
- terminate process"
-
- |p|
-
- self closeDownViews.
- myProcess notNil ifTrue:[
- p := myProcess.
- myProcess := nil.
- p terminate.
- ]
-! !
-
-!WindowGroup methodsFor:'initialization'!
-
-reinitialize
- "reinitialize the windowgroup after an image restart"
-
- "throw away old (zombie) process"
- myProcess notNil ifTrue:[
- "careful: the old processes exitaction must be cleared
- otherwise, it might do destroy or other actions when it
- gets finalized ...
- "
- myProcess exitAction:nil.
- myProcess := nil.
- ].
-
- "throw away old events"
- mySensor reinitialize
-!
-
-initialize
- "setup the windowgroup, by creating a new sensor
- and an event semaphore"
-
- mySensor := WindowSensor new.
- mySensor eventSemaphore:Semaphore new.
- isModal := false.
! !
!WindowGroup methodsFor:'focus control'!
+focusNext
+ "give focus to next view in focusSequence"
+
+ |index|
+
+ focusSequence size == 0 ifTrue:[^ self].
+ focusView notNil ifTrue:[
+ index := (focusSequence indexOf:focusView) + 1.
+ index > focusSequence size ifTrue:[index := 1].
+ ] ifFalse:[
+ index := 1.
+ ].
+ self focusView:(focusSequence at:index)
+
+ "
+ |top v1 v2|
+
+ top := StandardSystemView new.
+ v1 := EditTextView origin:0.0@0.0 corner:1.0@0.5 in:top.
+ v2 := EditTextView origin:0.0@0.5 corner:1.0@1.0 in:top.
+ top open.
+ top windowGroup focusSequence:(Array with:v1 with:v2).
+ top windowGroup focusOn:v1.
+ (Delay forSeconds:10) wait.
+ top windowGroup focusNext.
+ "
+!
+
+focusPrevious
+ "give focus to previous view in focusSequence"
+
+ |index|
+
+ focusSequence size == 0 ifTrue:[^ self].
+ focusView notNil ifTrue:[
+ index := (focusSequence indexOf:focusView) - 1.
+ index < 1 ifTrue:[index := focusSequence size].
+ ] ifFalse:[
+ index := focusSequence size.
+ ].
+ self focusView:(focusSequence at:index)
+!
+
focusSequence
"return the focus sequence for focusNext/focusPrevious.
Focus is stepped in the order in which subviews occur in
@@ -930,49 +864,34 @@
top open.
top windowGroup focusView:v1.
"
+! !
+
+!WindowGroup methodsFor:'initialization'!
+
+initialize
+ "setup the windowgroup, by creating a new sensor
+ and an event semaphore"
+
+ mySensor := WindowSensor new.
+ mySensor eventSemaphore:Semaphore new.
+ isModal := false.
!
-focusNext
- "give focus to next view in focusSequence"
-
- |index|
-
- focusSequence size == 0 ifTrue:[^ self].
- focusView notNil ifTrue:[
- index := (focusSequence indexOf:focusView) + 1.
- index > focusSequence size ifTrue:[index := 1].
- ] ifFalse:[
- index := 1.
- ].
- self focusView:(focusSequence at:index)
-
- "
- |top v1 v2|
+reinitialize
+ "reinitialize the windowgroup after an image restart"
- top := StandardSystemView new.
- v1 := EditTextView origin:0.0@0.0 corner:1.0@0.5 in:top.
- v2 := EditTextView origin:0.0@0.5 corner:1.0@1.0 in:top.
- top open.
- top windowGroup focusSequence:(Array with:v1 with:v2).
- top windowGroup focusOn:v1.
- (Delay forSeconds:10) wait.
- top windowGroup focusNext.
- "
-!
+ "throw away old (zombie) process"
+ myProcess notNil ifTrue:[
+ "careful: the old processes exitaction must be cleared
+ otherwise, it might do destroy or other actions when it
+ gets finalized ...
+ "
+ myProcess exitAction:nil.
+ myProcess := nil.
+ ].
-focusPrevious
- "give focus to previous view in focusSequence"
-
- |index|
-
- focusSequence size == 0 ifTrue:[^ self].
- focusView notNil ifTrue:[
- index := (focusSequence indexOf:focusView) - 1.
- index < 1 ifTrue:[index := focusSequence size].
- ] ifFalse:[
- index := focusSequence size.
- ].
- self focusView:(focusSequence at:index)
+ "throw away old events"
+ mySensor reinitialize
! !
!WindowGroup methodsFor:'printing'!
@@ -990,3 +909,86 @@
].
aStream nextPutAll:('WindowGroup(' , myProcess nameOrId , ')')
! !
+
+!WindowGroup methodsFor:'special'!
+
+restoreCursors
+ "restore the original cursors in all of my views"
+
+ |c|
+
+ self allViewsDo:[:aView |
+ c := aView cursor on:(aView device).
+ aView device setCursor:(c id) in:(aView id).
+ ].
+!
+
+showCursor:aCursor
+ "change the cursor to aCursor in all of my views."
+
+ |c|
+
+ c := aCursor.
+ self allViewsDo:[:aView |
+ c := c on:(aView device).
+ aView device setCursor:c id in:aView id.
+ ].
+!
+
+withCursor:aCursor do:aBlock
+ "evaluate aBlock while showing aCursor in all
+ my views (used to show wait-cursor while doing something).
+ Return the result as returned by aBlock."
+
+ |oldCursors|
+
+ "
+ get mapping of view->cursor for all of my subviews
+ "
+ oldCursors := IdentityDictionary new.
+ self allViewsDo:[:aView |
+ oldCursors at:aView put:(aView cursor).
+ aView cursor:aCursor
+ ].
+
+ ^ aBlock valueNowOrOnUnwindDo:[
+ "
+ restore cursors from the mapping
+ "
+ oldCursors keysAndValuesDo:[:view :cursor |
+ view cursor:cursor
+ ]
+ ]
+! !
+
+!WindowGroup methodsFor:'special accessing'!
+
+setModal:aBoolean
+ "special entry for debugger: set the modal flag.
+ Not for public use"
+
+ isModal := aBoolean
+
+ "Modified: 3.9.1995 / 14:51:04 / claus"
+!
+
+setPreviousGroup:aGroup
+ "special entry for debugger:
+ set the windowgroup that started this group (for modal groups only).
+ This is not a public interface."
+
+ previousGroup := aGroup
+
+ "Modified: 3.9.1995 / 14:55:40 / claus"
+!
+
+setProcess:aProcess
+ "special entry for debugger: set the windowGroups process.
+ Not for public use."
+
+ myProcess := aProcess
+
+ "Modified: 3.9.1995 / 14:25:38 / claus"
+! !
+
+WindowGroup initialize!
--- a/WSensor.st Thu Nov 23 03:29:10 1995 +0100
+++ b/WSensor.st Thu Nov 23 11:38:43 1995 +0100
@@ -10,15 +10,12 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.5 on 7-may-1995 at 11:49:31 am'!
-
Object subclass:#WindowSensor
instanceVariableNames:'eventSemaphore damage mouseAndKeyboard compressMotionEvents
- ignoreUserInput exposeEventSemaphore catchExpose
- gotExpose gotOtherEvent translateKeyboardEvents shiftDown
- ctrlDown metaDown altDown
- leftButtonDown middleButtonDown rightButtonDown
- eventListener keyboardListener'
+ ignoreUserInput exposeEventSemaphore catchExpose gotExpose
+ gotOtherEvent translateKeyboardEvents shiftDown ctrlDown metaDown
+ altDown leftButtonDown middleButtonDown rightButtonDown
+ eventListener keyboardListener'
classVariableNames:'ControlCEnabled EventListener ComposeTable GotCompose Compose1'
poolDictionaries:''
category:'Interface-Support'
@@ -40,10 +37,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libview/Attic/WSensor.st,v 1.33 1995-11-11 15:53:35 cg Exp $'
-!
-
documentation
"
Instances of this class keep track of events and damage areas for a group of
@@ -174,6 +167,10 @@
ComposeTable <Array> compose-key translation table
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/Attic/WSensor.st,v 1.34 1995-11-23 10:38:43 cg Exp $'
! !
!WindowSensor class methodsFor:'initialization'!
@@ -301,6 +298,24 @@
!WindowSensor class methodsFor:'accessing'!
+composeTable
+ "return the compose-key table.
+ Entries consist of 3-element arrays each, where
+ the first two entries (of each entry) are the raw characters,
+ and the third is the resulting composed-key"
+
+ ^ ComposeTable
+!
+
+composeTable:aTable
+ "set the compose-key table.
+ Entries consist of 3-element arrays each, where
+ the first two entries (of each entry) are the raw characters,
+ and the third is the resulting composed-key"
+
+ ComposeTable := aTable
+!
+
controlCEnabled:aBoolean
"enable/disable Control-C processing.
If enabled, pressing CNTL-C in a view will interrupt it and bring
@@ -312,13 +327,6 @@
ControlCEnabled := aBoolean
!
-eventListener:aListener
- "set the eventListener
- - see documentation for what this can be used for"
-
- EventListener := aListener
-!
-
eventListener
"return the eventListener
- see documentation for what this can be used for"
@@ -326,22 +334,11 @@
^ EventListener
!
-composeTable:aTable
- "set the compose-key table.
- Entries consist of 3-element arrays each, where
- the first two entries (of each entry) are the raw characters,
- and the third is the resulting composed-key"
+eventListener:aListener
+ "set the eventListener
+ - see documentation for what this can be used for"
- ComposeTable := aTable
-!
-
-composeTable
- "return the compose-key table.
- Entries consist of 3-element arrays each, where
- the first two entries (of each entry) are the raw characters,
- and the third is the resulting composed-key"
-
- ^ ComposeTable
+ EventListener := aListener
! !
!WindowSensor class methodsFor:'queries'!
@@ -357,94 +354,192 @@
"
! !
-!WindowSensor methodsFor:'private'!
+!WindowSensor methodsFor:'accessing'!
+
+compressMotionEvents:aBoolean
+ "turn on/off motion event compression"
+
+ compressMotionEvents := aBoolean
+!
+
+eventListener
+ "return the eventListener
+ - see documentation for what this can be used for"
+
+ ^ eventListener
+!
+
+eventListener:aListener
+ "set the eventListener
+ - see documentation for what this can be used for"
+
+ eventListener := aListener
+
+!
-isModifierKey:key
- (key == #Shift
- or:[key == #'Shift_R'
- or:[key == #'Shift_L']]) ifTrue:[
- ^ true
- ].
- (key == #Alt
- or:[key == #'Alt_R' or:[key == #'Alt_L']]) ifTrue:[
- ^ true
- ].
- (key == #Meta
- or:[key == #'Meta_R' or:[key == #'Meta_L']]) ifTrue:[
- ^ true
- ].
- (key == #Control
- or:[key == #'Control_R' or:[key == #'Control_L']]) ifTrue:[
- ^ true
- ].
- ^ false
+eventSemaphore
+ "return the semaphore used to signal event arrival"
+
+ ^ eventSemaphore
+!
+
+eventSemaphore:aSemaphore
+ "set the semaphore used to signal event arrival"
+
+ eventSemaphore := aSemaphore
+!
+
+ignoreUserInput
+ "return true, if Ctrl-C processing is currently turned off"
+
+ ^ ignoreUserInput
+!
+
+ignoreUserInput:aBoolean
+ "turn on/off ignoring of Ctrl-C processing"
+
+ ignoreUserInput := aBoolean
!
-key:key state:onOrOff
- "update the state of the shiftDown/metaDown and ctrlDown
- flags"
+keyboardListener
+ "return the keyboardListener
+ - see documentation for what this can be used for"
+
+ ^ keyboardListener
+!
+
+keyboardListener:aListener
+ "set the keyboardListener
+ - see documentation for what this can be used for"
+
+ keyboardListener := aListener
+
+! !
+
+!WindowSensor methodsFor:'event flushing'!
- (key == #Shift
- or:[key == #'Shift_R'
- or:[key == #'Shift_L']]) ifTrue:[
- shiftDown := onOrOff.
- ^ self
+compressKeyPressEventsWithKey:aKey
+ "count and remove multiple pending keyPress events for the
+ same key, aKey. This is currently used in TextViews to compress
+ multiple cursorUp/cursorDown events and do the scroll in one
+ operation. (to avoid run-after-cursor on slow displays)"
+
+ |n ev|
+
+ n := 0.
+ ev := self pendingEvent.
+ [ev notNil and:[ev isKeyPressEvent]] whileTrue:[
+ ((ev arguments at:1) == aKey) ifTrue:[
+ n := n + 1.
+ self nextEvent.
+ ev := self pendingEvent.
+ ] ifFalse:[
+ ev := nil
+ ]
].
- (key == #Alt
- or:[key == #'Alt_R' or:[key == #'Alt_L']]) ifTrue:[
- altDown := onOrOff.
- ^ self
- ].
- (key == #Meta
- or:[key == #'Meta_R' or:[key == #'Meta_L']]) ifTrue:[
- metaDown := onOrOff.
- ^ self
- ].
- (key == #Control
- or:[key == #'Control_R' or:[key == #'Control_L']]) ifTrue:[
- ctrlDown := onOrOff.
- ^ self
+ ^ n
+!
+
+flushEventsFor:aView
+ "throw away all events for aView,
+ or any view, if the argument is nil."
+
+ self flushExposeEventsFor:aView.
+ self flushUserEventsFor:aView.
+!
+
+flushExposeEvents
+ "throw away all pending expose events; this
+ can be done after a full redraw (or in views, which are
+ doing full redraws anly)"
+
+ (damage isNil or:[damage size > 0]) ifTrue:[
+ damage := OrderedCollection new
].
!
-compose:key1 with:key2
- "compose a 2-character sequence into a composed key"
+flushExposeEventsFor:aView
+ "throw away all pending expose events for aView,
+ or any view, if the argument is nil.
+ This can be done after a full redraw
+ (or in views, which are always doing full redraws -
+ instead of drawing the clip-area only)"
+
+ |nEvent "{ Class: SmallInteger }"|
- ComposeTable do:[:entry |
- |v|
+ damage notNil ifTrue:[
+ nEvent := damage size.
+ 1 to:nEvent do:[:index |
+ |aDamage|
- ((key1 == (entry at:1)) and:[key2 == (entry at:2)]) ifTrue:[
- v := entry at:3.
- v isCharacter ifFalse:[v := Character value:v].
- ^ v
+ aDamage := damage at:index.
+ aDamage notNil ifTrue:[
+ (aView isNil or:[aDamage view == aView]) ifTrue:[
+ damage at:index put:nil
+ ]
+ ]
]
].
- "/
- "/ for illegal sequence, return 2nd key
- "/
-"/ key1 print. ' ' print. key2 printNL.
- ^ key2
+!
+
+flushKeyboard
+ "ST-80 compatibility: throw away all pending keyboard events"
+
+ self flushKeyboardFor:nil
+!
+
+flushKeyboardFor:aView
+ "throw away all pending keyboard events for aView,
+ or any view, if the argument is nil."
+
+ |nEvent "{ Class: SmallInteger }"|
+
+ mouseAndKeyboard notNil ifTrue:[
+ nEvent := mouseAndKeyboard size.
+ 1 to:nEvent do:[:i |
+ |anEvent|
+
+ anEvent := mouseAndKeyboard at:i.
+ (anEvent notNil and:[anEvent isKeyEvent]) ifTrue:[
+ (aView isNil or:[anEvent view == aView]) ifTrue:[
+ mouseAndKeyboard at:i put:nil
+ ]
+ ]
+ ]
+ ].
+!
+
+flushUserEvents
+ "throw away all pending user events"
+
+ (mouseAndKeyboard isNil or:[mouseAndKeyboard size > 0]) ifTrue:[
+ mouseAndKeyboard := OrderedCollection new
+ ].
+!
+
+flushUserEventsFor:aView
+ "throw away all pending user events for aView,
+ or any view, if the argument is nil."
+
+ |nEvent "{ Class: SmallInteger }"|
+
+ mouseAndKeyboard notNil ifTrue:[
+ nEvent := mouseAndKeyboard size.
+ 1 to:nEvent do:[:i |
+ |anEvent|
+
+ anEvent := mouseAndKeyboard at:i.
+ anEvent notNil ifTrue:[
+ (aView isNil or:[anEvent view == aView]) ifTrue:[
+ mouseAndKeyboard at:i put:nil
+ ]
+ ]
+ ]
+ ].
! !
!WindowSensor methodsFor:'event processing'!
-notifyEventArrival
- "an event arrived - if there is an eventSemaphore,
- signal it, to wake up any windowGroup process"
-
- catchExpose == true ifTrue:[
- "
- dont wake up, if we are currently waiting for an expose
- but remember arrival of something.
- "
- gotOtherEvent := true.
- ^ self
- ].
- eventSemaphore notNil ifTrue:[
- eventSemaphore signal
- ]
-!
-
button:button inView:aView state:onOrOff
"update the state of the xxxButtonDown flags"
@@ -465,23 +560,6 @@
].
!
-noExposeView:aView
- "an noexpose event arrived - this is sent from the device (Display)"
-
- gotExpose := true.
- exposeEventSemaphore notNil ifTrue:[
- exposeEventSemaphore signal
- ]
-!
-
-exposeX:left y:top width:width height:height view:aView
- "an expose event arrived - this is sent from the device (Display)"
-
- (self addDamage:(Rectangle left:left top:top width:width height:height) view:aView) ifTrue:[
- self notifyEventArrival
- ]
-!
-
buttonMotion:state x:x y:y view:aView
"mouse was moved - this is sent from the device (Display)"
@@ -522,44 +600,24 @@
self notifyEventArrival
!
-pointerLeave:state view:aView
- "mouse cursor was moved out of the view - this is sent from the device (Display)"
+buttonMultiPress:button x:x y:y view:aView
+ "mouse button was pressed - this is sent from the device (Display)"
EventListener notNil ifTrue:[
- (EventListener pointerLeave:state view:aView) ifTrue:[^ self]
+ (EventListener buttonMultiPress:button x:x y:y view:aView) ifTrue:[^ self]
].
eventListener notNil ifTrue:[
- (eventListener pointerLeave:state view:aView) ifTrue:[^ self]
- ].
-
- mouseAndKeyboard
- addLast:(WindowEvent
- for:aView
- type:#pointerLeave:
- arguments:(Array with:state)).
- self notifyEventArrival
-!
-
-buttonRelease:button x:x y:y view:aView
- "mouse button was released- this is sent from the device (Display)"
-
- self button:button inView:aView state:false.
-
- EventListener notNil ifTrue:[
- (EventListener buttonRelease:button x:x y:y view:aView) ifTrue:[^ self]
- ].
- eventListener notNil ifTrue:[
- (eventListener buttonRelease:button x:x y:y view:aView) ifTrue:[^ self]
+ (eventListener buttonMultiPress:button x:x y:y view:aView) ifTrue:[^ self]
].
ignoreUserInput == true ifTrue:[
^ self
].
mouseAndKeyboard
- addLast:(WindowEvent
- for:aView
- type:#buttonRelease:x:y:
- arguments:(Array with:button with:x with:y)).
+ addLast:(WindowEvent
+ for:aView
+ type:#buttonMultiPress:x:y:
+ arguments:(Array with:button with:x with:y)).
self notifyEventArrival
!
@@ -586,10 +644,94 @@
self notifyEventArrival
!
-graphicExposeX:left y:top width:width height:height view:aView
- "a graphic expose event arrived - this is sent from the device (Display)"
+buttonRelease:button x:x y:y view:aView
+ "mouse button was released- this is sent from the device (Display)"
+
+ self button:button inView:aView state:false.
+
+ EventListener notNil ifTrue:[
+ (EventListener buttonRelease:button x:x y:y view:aView) ifTrue:[^ self]
+ ].
+ eventListener notNil ifTrue:[
+ (eventListener buttonRelease:button x:x y:y view:aView) ifTrue:[^ self]
+ ].
+
+ ignoreUserInput == true ifTrue:[
+ ^ self
+ ].
+ mouseAndKeyboard
+ addLast:(WindowEvent
+ for:aView
+ type:#buttonRelease:x:y:
+ arguments:(Array with:button with:x with:y)).
+ self notifyEventArrival
+!
+
+buttonShiftPress:button x:x y:y view:aView
+ "mouse button was pressed - this is sent from the device (Display)"
+
+ self button:button inView:aView state:true.
+
+ EventListener notNil ifTrue:[
+ (EventListener buttonShiftPress:button x:x y:y view:aView) ifTrue:[^ self]
+ ].
+ eventListener notNil ifTrue:[
+ (eventListener buttonShiftPress:button x:x y:y view:aView) ifTrue:[^ self]
+ ].
- self addDamage:(left @ top extent:width @ height) view:aView.
+ ignoreUserInput == true ifTrue:[
+ ^ self
+ ].
+ mouseAndKeyboard
+ addLast:(WindowEvent
+ for:aView
+ type:#buttonShiftPress:x:y:
+ arguments:(Array with:button with:x with:y)).
+ self notifyEventArrival
+!
+
+configureX:x y:y width:w height:h view:aView
+ "a views size or position has changed - this is sent from the device (Display)"
+
+ damage
+ addLast:(WindowEvent
+ for:aView
+ type:#configureX:y:width:height:
+ arguments:(Array with:x with:y with:w with:h)).
+ self notifyEventArrival
+!
+
+coveredBy:sibling view:aView
+ "aView was covered by one of its siblings - this is sent from the device (Display)"
+
+ damage
+ addLast:(WindowEvent
+ for:aView
+ type:#coveredBy:
+ arguments:(Array with:sibling)).
+ self notifyEventArrival
+!
+
+destroyedView:aView
+ "view was destroyed (from window manager) - this is sent from the device (Display)"
+
+ "at this time, the view is already gone; remove
+ all pending events for this one ..."
+
+ self flushEventsFor:aView.
+ damage
+ addLast:(WindowEvent
+ for:aView
+ type:#destroyed).
+ self notifyEventArrival
+!
+
+exposeX:left y:top width:width height:height view:aView
+ "an expose event arrived - this is sent from the device (Display)"
+
+ (self addDamage:(Rectangle left:left top:top width:width height:height) view:aView) ifTrue:[
+ self notifyEventArrival
+ ]
!
focusInView:aView
@@ -602,53 +744,20 @@
self notifyEventArrival
!
-pointerEnter:state x:x y:y view:aView
- "mouse cursor was moved into the view - this is sent from the device (Display)"
-
- EventListener notNil ifTrue:[
- (EventListener pointerEnter:state x:x y:y view:aView) ifTrue:[^ self]
- ].
- eventListener notNil ifTrue:[
- (eventListener pointerEnter:state x:x y:y view:aView) ifTrue:[^ self]
- ].
+focusOutView:aView
+ "view lost input focus - this is sent from the device (Display)"
mouseAndKeyboard
- addLast:(WindowEvent
- for:aView
- type:#pointerEnter:x:y:
- arguments:(Array with:state with:x with:y)).
+ addLast:(WindowEvent
+ for:aView
+ type:#focusOut).
self notifyEventArrival
!
-buttonMultiPress:button x:x y:y view:aView
- "mouse button was pressed - this is sent from the device (Display)"
-
- EventListener notNil ifTrue:[
- (EventListener buttonMultiPress:button x:x y:y view:aView) ifTrue:[^ self]
- ].
- eventListener notNil ifTrue:[
- (eventListener buttonMultiPress:button x:x y:y view:aView) ifTrue:[^ self]
- ].
+graphicExposeX:left y:top width:width height:height view:aView
+ "a graphic expose event arrived - this is sent from the device (Display)"
- ignoreUserInput == true ifTrue:[
- ^ self
- ].
- mouseAndKeyboard
- addLast:(WindowEvent
- for:aView
- type:#buttonMultiPress:x:y:
- arguments:(Array with:button with:x with:y)).
- self notifyEventArrival
-!
-
-mappedView:aView
- "view was mapped (from window manager) - this is sent from the device (Display)"
-
- damage
- addLast:(WindowEvent
- for:aView
- type:#mapped).
- self notifyEventArrival
+ self addDamage:(left @ top extent:width @ height) view:aView.
!
keyPress:key x:x y:y view:aView
@@ -745,71 +854,6 @@
self notifyEventArrival
!
-coveredBy:sibling view:aView
- "aView was covered by one of its siblings - this is sent from the device (Display)"
-
- damage
- addLast:(WindowEvent
- for:aView
- type:#coveredBy:
- arguments:(Array with:sibling)).
- self notifyEventArrival
-!
-
-configureX:x y:y width:w height:h view:aView
- "a views size or position has changed - this is sent from the device (Display)"
-
- damage
- addLast:(WindowEvent
- for:aView
- type:#configureX:y:width:height:
- arguments:(Array with:x with:y with:w with:h)).
- self notifyEventArrival
-!
-
-unmappedView:aView
- "view was unmapped (from window manager) - this is sent from the device (Display)"
-
- damage
- addLast:(WindowEvent
- for:aView
- type:#unmapped).
- self notifyEventArrival
-!
-
-focusOutView:aView
- "view lost input focus - this is sent from the device (Display)"
-
- mouseAndKeyboard
- addLast:(WindowEvent
- for:aView
- type:#focusOut).
- self notifyEventArrival
-!
-
-buttonShiftPress:button x:x y:y view:aView
- "mouse button was pressed - this is sent from the device (Display)"
-
- self button:button inView:aView state:true.
-
- EventListener notNil ifTrue:[
- (EventListener buttonShiftPress:button x:x y:y view:aView) ifTrue:[^ self]
- ].
- eventListener notNil ifTrue:[
- (eventListener buttonShiftPress:button x:x y:y view:aView) ifTrue:[^ self]
- ].
-
- ignoreUserInput == true ifTrue:[
- ^ self
- ].
- mouseAndKeyboard
- addLast:(WindowEvent
- for:aView
- type:#buttonShiftPress:x:y:
- arguments:(Array with:button with:x with:y)).
- self notifyEventArrival
-!
-
keyRelease:key x:x y:y view:aView
"key was released - this is sent from the device (Display)."
@@ -845,14 +889,75 @@
self notifyEventArrival
!
-terminateView:aView
- "view should terminate (from window manager) - this is sent from the device (Display)"
+mappedView:aView
+ "view was mapped (from window manager) - this is sent from the device (Display)"
- self flushEventsFor:aView.
damage
addLast:(WindowEvent
for:aView
- type:#terminate).
+ type:#mapped).
+ self notifyEventArrival
+!
+
+noExposeView:aView
+ "an noexpose event arrived - this is sent from the device (Display)"
+
+ gotExpose := true.
+ exposeEventSemaphore notNil ifTrue:[
+ exposeEventSemaphore signal
+ ]
+!
+
+notifyEventArrival
+ "an event arrived - if there is an eventSemaphore,
+ signal it, to wake up any windowGroup process"
+
+ catchExpose == true ifTrue:[
+ "
+ dont wake up, if we are currently waiting for an expose
+ but remember arrival of something.
+ "
+ gotOtherEvent := true.
+ ^ self
+ ].
+ eventSemaphore notNil ifTrue:[
+ eventSemaphore signal
+ ]
+!
+
+pointerEnter:state x:x y:y view:aView
+ "mouse cursor was moved into the view - this is sent from the device (Display)"
+
+ EventListener notNil ifTrue:[
+ (EventListener pointerEnter:state x:x y:y view:aView) ifTrue:[^ self]
+ ].
+ eventListener notNil ifTrue:[
+ (eventListener pointerEnter:state x:x y:y view:aView) ifTrue:[^ self]
+ ].
+
+ mouseAndKeyboard
+ addLast:(WindowEvent
+ for:aView
+ type:#pointerEnter:x:y:
+ arguments:(Array with:state with:x with:y)).
+ self notifyEventArrival
+!
+
+pointerLeave:state view:aView
+ "mouse cursor was moved out of the view - this is sent from the device (Display)"
+
+ EventListener notNil ifTrue:[
+ (EventListener pointerLeave:state view:aView) ifTrue:[^ self]
+ ].
+ eventListener notNil ifTrue:[
+ (eventListener pointerLeave:state view:aView) ifTrue:[^ self]
+ ].
+
+ mouseAndKeyboard
+ addLast:(WindowEvent
+ for:aView
+ type:#pointerLeave:
+ arguments:(Array with:state)).
self notifyEventArrival
!
@@ -867,58 +972,29 @@
self notifyEventArrival
!
-destroyedView:aView
- "view was destroyed (from window manager) - this is sent from the device (Display)"
-
- "at this time, the view is already gone; remove
- all pending events for this one ..."
+terminateView:aView
+ "view should terminate (from window manager) - this is sent from the device (Display)"
self flushEventsFor:aView.
damage
addLast:(WindowEvent
for:aView
- type:#destroyed).
+ type:#terminate).
+ self notifyEventArrival
+!
+
+unmappedView:aView
+ "view was unmapped (from window manager) - this is sent from the device (Display)"
+
+ damage
+ addLast:(WindowEvent
+ for:aView
+ type:#unmapped).
self notifyEventArrival
! !
!WindowSensor methodsFor:'event queue'!
-nextDamage
- "retrieve the next damage rectangle or nil, if there is none.
- Remove it from the queue."
-
- |d wasBlocked|
-
- [d isNil] whileTrue:[
- damage size == 0 ifTrue:[^ nil].
- "
- be careful: events are inserted at higher prio ...
- "
- wasBlocked := OperatingSystem blockInterrupts.
- d := damage removeFirst.
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ].
- ^ d
-!
-
-nextEvent
- "retrieve the next event or nil, if there is none.
- Remove it from the queue."
-
- |e wasBlocked|
-
- [e isNil] whileTrue:[
- mouseAndKeyboard size == 0 ifTrue:[^ nil].
- "
- be careful: events are inserted at higher prio ...
- "
- wasBlocked := OperatingSystem blockInterrupts.
- e := mouseAndKeyboard removeFirst.
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ].
- ^ e
-!
-
addDamage:aRectangle view:aView
"Add aRectangle to the damage list.
Try to merge incoming rectangles with the existing damage rectangles.
@@ -1063,6 +1139,42 @@
^ true
!
+nextDamage
+ "retrieve the next damage rectangle or nil, if there is none.
+ Remove it from the queue."
+
+ |d wasBlocked|
+
+ [d isNil] whileTrue:[
+ damage size == 0 ifTrue:[^ nil].
+ "
+ be careful: events are inserted at higher prio ...
+ "
+ wasBlocked := OperatingSystem blockInterrupts.
+ d := damage removeFirst.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ].
+ ^ d
+!
+
+nextEvent
+ "retrieve the next event or nil, if there is none.
+ Remove it from the queue."
+
+ |e wasBlocked|
+
+ [e isNil] whileTrue:[
+ mouseAndKeyboard size == 0 ifTrue:[^ nil].
+ "
+ be careful: events are inserted at higher prio ...
+ "
+ wasBlocked := OperatingSystem blockInterrupts.
+ e := mouseAndKeyboard removeFirst.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ].
+ ^ e
+!
+
pendingEvent
"retrieve the next pending user (i.e. non-damage) event.
Return nil, if there is none pending.
@@ -1082,12 +1194,262 @@
^ e
! !
+!WindowSensor methodsFor:'event simulation'!
+
+forwardKeyEventsTo:aView
+ "remove all keyboard events and send them to aViews sensor instead"
+
+"/ 'fwd' printNL.
+ 1 to:mouseAndKeyboard size do:[:i |
+ |anEvent|
+
+ anEvent := mouseAndKeyboard at:i.
+ anEvent notNil ifTrue:[
+ anEvent isKeyEvent ifTrue:[
+ anEvent view:aView.
+ aView sensor pushEvent:anEvent.
+"/ anEvent type printNL.
+ mouseAndKeyboard at:i put:nil
+ ]
+ ]
+ ].
+!
+
+pushEvent:anEvent
+ "manually put an event into the queue - this allows
+ simulation of events (implementation of recorders & playback)
+ or asynchronous communication between view applications."
+
+ mouseAndKeyboard addLast:anEvent.
+ self notifyEventArrival
+
+ "Created: 18.9.1995 / 22:37:57 / claus"
+!
+
+pushUserEvent:aSelector for:aView
+ "manually put an event into the queue - this allows
+ simulation of events (implementation of recorders & playback)
+ or asynchronous communication between view applications.
+ The view will perform a method as specified by aSelector,
+ when it performs event processing; this is different than sending
+ this message directly, since the execution is done by the views process,
+ not by the current process (which is especially worthwhile, if that method
+ shows a modal box or similar)."
+
+ self pushUserEvent:aSelector for:aView withArguments:#()
+
+ "Modified: 18.9.1995 / 22:40:12 / claus"
+!
+
+pushUserEvent:aSelector for:aView withArguments:arguments
+ "manually put an event into the queue - this allows
+ simulation of events (implementation of recorders & playback)
+ or asynchronous communication between view applications.
+ The view will perform a method as specified by aSelector,
+ when it performs event processing; this is different than sending
+ this message directly, since the execution is done by the views process,
+ not by the current process (which is especially worthwhile, if that method
+ shows a modal box or similar)."
+
+ self pushEvent:(WindowEvent
+ for:aView
+ type:aSelector
+ arguments:arguments).
+
+ "
+ |b|
+ b := Button label:'test'.
+ b open.
+ (Delay forSeconds:5) wait.
+ b sensor pushEvent:#pointerEnter:x:y: for:b withArguments:#(0 1 1).
+ (Delay forSeconds:1) wait.
+ b sensor pushEvent:#buttonPress:x:y: for:b withArguments:#(1 1 1).
+ (Delay forSeconds:2) wait.
+ b sensor pushEvent:#buttonRelease:x:y: for:b withArguments:#(1 1 1).
+ (Delay forSeconds:1) wait.
+ b sensor pushEvent:#pointerLeave: for:b withArguments:#(0).
+ "
+! !
+
+!WindowSensor methodsFor:'initialization'!
+
+initialize
+ "initialize the event queues to empty"
+
+ damage := OrderedCollection new.
+ mouseAndKeyboard := OrderedCollection new.
+ gotExpose := true.
+ catchExpose := false.
+
+ compressMotionEvents := translateKeyboardEvents := true.
+ ignoreUserInput := false.
+ shiftDown := ctrlDown := altDown := metaDown := false.
+ leftButtonDown := middleButtonDown := rightButtonDown := false.
+!
+
+reinitialize
+ "called when an image is restarted;
+ reinitialize the event queues to empty; leave other setup as-is"
+
+ self flushUserEvents.
+ self flushExposeEvents.
+ gotExpose := true.
+ catchExpose := false.
+ shiftDown := ctrlDown := altDown := metaDown := false.
+ leftButtonDown := middleButtonDown := rightButtonDown := false.
+! !
+
+!WindowSensor methodsFor:'private'!
+
+compose:key1 with:key2
+ "compose a 2-character sequence into a composed key"
+
+ ComposeTable do:[:entry |
+ |v|
+
+ ((key1 == (entry at:1)) and:[key2 == (entry at:2)]) ifTrue:[
+ v := entry at:3.
+ v isCharacter ifFalse:[v := Character value:v].
+ ^ v
+ ]
+ ].
+ "/
+ "/ for illegal sequence, return 2nd key
+ "/
+"/ key1 print. ' ' print. key2 printNL.
+ ^ key2
+!
+
+isModifierKey:key
+ (key == #Shift
+ or:[key == #'Shift_R'
+ or:[key == #'Shift_L']]) ifTrue:[
+ ^ true
+ ].
+ (key == #Alt
+ or:[key == #'Alt_R' or:[key == #'Alt_L']]) ifTrue:[
+ ^ true
+ ].
+ (key == #Meta
+ or:[key == #'Meta_R' or:[key == #'Meta_L']]) ifTrue:[
+ ^ true
+ ].
+ (key == #Control
+ or:[key == #'Control_R' or:[key == #'Control_L']]) ifTrue:[
+ ^ true
+ ].
+ ^ false
+!
+
+key:key state:onOrOff
+ "update the state of the shiftDown/metaDown and ctrlDown
+ flags"
+
+ (key == #Shift
+ or:[key == #'Shift_R'
+ or:[key == #'Shift_L']]) ifTrue:[
+ shiftDown := onOrOff.
+ ^ self
+ ].
+ (key == #Alt
+ or:[key == #'Alt_R' or:[key == #'Alt_L']]) ifTrue:[
+ altDown := onOrOff.
+ ^ self
+ ].
+ (key == #Meta
+ or:[key == #'Meta_R' or:[key == #'Meta_L']]) ifTrue:[
+ metaDown := onOrOff.
+ ^ self
+ ].
+ (key == #Control
+ or:[key == #'Control_R' or:[key == #'Control_L']]) ifTrue:[
+ ctrlDown := onOrOff.
+ ^ self
+ ].
+! !
+
!WindowSensor methodsFor:'queries '!
-hasEvents
- "return true, if any mouse/keyboard events are pending"
+altDown
+ "return true, if the meta key is currently pressed.
+ Notice, that some keyboards dont have an alt key;
+ it is better to use 'sensor metaDown or:[sensor altDown]'."
+
+ ^ altDown
+!
+
+anyButtonPressed
+ "ST-80 compatibility: return true, if any mouse button is pressed.
+ You should no use it in 'normal' applications.
+ Instead, keep track of the buttons state in your views or controllers
+ button-event methods."
+
+ ^ rightButtonDown or:[middleButtonDown or:[rightButtonDown]]
+!
+
+blueButtonPressed
+ "ST-80 compatibility: return true, if the right mouse button is pressed.
+ You should no use it in 'normal' applications.
+ Instead, keep track of the buttons state in your views or controllers
+ button-event methods."
+
+ ^ rightButtonDown
+!
+
+ctrlDown
+ "return true, if any CTRL key is currently pressed."
+
+ ^ ctrlDown
+!
+
+cursorPoint
+ "ST-80 compatibility:
+ return the position of the mouse pointer on the current display
+ (in screen coordinates)"
+
+ ^ self class cursorPoint
+!
- ^ mouseAndKeyboard size ~~ 0
+eventPending
+ "return true, if either damage or events are pending"
+
+ mouseAndKeyboard size ~~ 0 ifTrue:[^ true].
+ ^ damage size ~~ 0
+!
+
+globalOrigin
+ "ST-80 compatibility:
+ dont know what we should return here ...
+ ... at least the PD program which uses it works when we return 0@0."
+
+ ^ 0@0
+!
+
+hasButtonMotionEventsFor:aView
+ "return true, if any buttonMotion events are pending.
+ If the argument, aView is nil, the information is regarding any
+ view (i.e. is there a motion event for any of my views);
+ otherwise, the information is regrding that specific view."
+
+ ^ self hasEvent:#buttonMotion:x:y: orPendingDeviceEvent:#buttonMotion for:aView
+!
+
+hasButtonPressEventFor:aView
+ "return true, if any buttonPress events are pending.
+ If the argument, aView is nil, the information is regarding any
+ view (i.e. is there a motion event for any of my views);
+ otherwise, the information is regrding that specific view."
+
+ ^ self hasEvent:#buttonPress:x:y: orPendingDeviceEvent:#buttonPress for:aView
+!
+
+hasButtonReleaseEventFor:aView
+ "return true, if any buttonRelease events are pending.
+ If the argument, aView is nil, the information is regarding any
+ view (i.e. is there a motion event for any of my views);
+ otherwise, the information is regrding that specific view."
+
+ ^ self hasEvent:#buttonRelease:x:y: orPendingDeviceEvent:#buttonRelease for:aView
!
hasDamage
@@ -1131,90 +1493,10 @@
^ false
!
-hasButtonMotionEventsFor:aView
- "return true, if any buttonMotion events are pending.
- If the argument, aView is nil, the information is regarding any
- view (i.e. is there a motion event for any of my views);
- otherwise, the information is regrding that specific view."
-
- ^ self hasEvent:#buttonMotion:x:y: orPendingDeviceEvent:#buttonMotion for:aView
-!
-
-hasButtonReleaseEventFor:aView
- "return true, if any buttonRelease events are pending.
- If the argument, aView is nil, the information is regarding any
- view (i.e. is there a motion event for any of my views);
- otherwise, the information is regrding that specific view."
-
- ^ self hasEvent:#buttonRelease:x:y: orPendingDeviceEvent:#buttonRelease for:aView
-!
-
-hasButtonPressEventFor:aView
- "return true, if any buttonPress events are pending.
- If the argument, aView is nil, the information is regarding any
- view (i.e. is there a motion event for any of my views);
- otherwise, the information is regrding that specific view."
-
- ^ self hasEvent:#buttonPress:x:y: orPendingDeviceEvent:#buttonPress for:aView
-!
-
-eventPending
- "return true, if either damage or events are pending"
-
- mouseAndKeyboard size ~~ 0 ifTrue:[^ true].
- ^ damage size ~~ 0
-!
-
-mousePoint
- "ST-80 compatibility:
- return the position of the mouse pointer on the current display
- (in screen coordinates)"
-
- ^ self cursorPoint
-!
+hasEvents
+ "return true, if any mouse/keyboard events are pending"
-cursorPoint
- "ST-80 compatibility:
- return the position of the mouse pointer on the current display
- (in screen coordinates)"
-
- ^ self class cursorPoint
-!
-
-globalOrigin
- "ST-80 compatibility:
- dont know what we should return here ...
- ... at least the PD program which uses it works when we return 0@0."
-
- ^ 0@0
-!
-
-shiftDown
- "return true, if any shift key is currently pressed."
-
- ^ shiftDown
-!
-
-ctrlDown
- "return true, if any CTRL key is currently pressed."
-
- ^ ctrlDown
-!
-
-metaDown
- "return true, if the meta key is currently pressed.
- Notice, that most keyboards dont have a meta key;
- it is better to use 'sensor metaDown or:[sensor altDown]'."
-
- ^ metaDown
-!
-
-altDown
- "return true, if the meta key is currently pressed.
- Notice, that some keyboards dont have an alt key;
- it is better to use 'sensor metaDown or:[sensor altDown]'."
-
- ^ altDown
+ ^ mouseAndKeyboard size ~~ 0
!
leftButtonPressed
@@ -1227,6 +1509,14 @@
^ leftButtonDown
!
+metaDown
+ "return true, if the meta key is currently pressed.
+ Notice, that most keyboards dont have a meta key;
+ it is better to use 'sensor metaDown or:[sensor altDown]'."
+
+ ^ metaDown
+!
+
middleButtonPressed
"return true, if the middle mouse button is pressed.
This has been added to support ST-80 style button polling;
@@ -1237,6 +1527,23 @@
^ middleButtonDown
!
+mousePoint
+ "ST-80 compatibility:
+ return the position of the mouse pointer on the current display
+ (in screen coordinates)"
+
+ ^ self cursorPoint
+!
+
+redButtonPressed
+ "ST-80 compatibility: return true, if the left mouse button is pressed.
+ You should no use it in 'normal' applications.
+ Instead, keep track of the buttons state in your views or controllers
+ button-event methods."
+
+ ^ leftButtonDown
+!
+
rightButtonPressed
"return true, if the right mouse button is pressed.
This has been added to support ST-80 style button polling;
@@ -1247,13 +1554,10 @@
^ rightButtonDown
!
-redButtonPressed
- "ST-80 compatibility: return true, if the left mouse button is pressed.
- You should no use it in 'normal' applications.
- Instead, keep track of the buttons state in your views or controllers
- button-event methods."
+shiftDown
+ "return true, if any shift key is currently pressed."
- ^ leftButtonDown
+ ^ shiftDown
!
yellowButtonPressed
@@ -1263,24 +1567,6 @@
button-event methods."
^ middleButtonDown
-!
-
-blueButtonPressed
- "ST-80 compatibility: return true, if the right mouse button is pressed.
- You should no use it in 'normal' applications.
- Instead, keep track of the buttons state in your views or controllers
- button-event methods."
-
- ^ rightButtonDown
-!
-
-anyButtonPressed
- "ST-80 compatibility: return true, if any mouse button is pressed.
- You should no use it in 'normal' applications.
- Instead, keep track of the buttons state in your views or controllers
- button-event methods."
-
- ^ rightButtonDown or:[middleButtonDown or:[rightButtonDown]]
! !
!WindowSensor methodsFor:'special'!
@@ -1296,6 +1582,24 @@
exposeEventSemaphore := Semaphore new.
!
+waitButton
+ "ST-80 compatibility: wait until any mouse button is pressed.
+ Do not use this in your applications; polling the sensor is
+ bad style."
+
+ [self anyButtonPressed] whileFalse:[
+ (Delay forSeconds:0.01) wait.
+ ].
+
+"/ (leftButtonPressed
+"/ or:[middleButtonPressed
+"/ or:[rightButtonPressed]]) ifTrue:[^ self].
+"/
+"/ [self hasButtonPressEventFor:nil] whileFalse:[
+"/ (Delay forSeconds:0.01) wait.
+"/ ]
+!
+
waitForExposeFor:aView
"wait until a graphicsExpose or a noExpose arrives (after a bitblt).
This may be too X-specific, and things may change in this area
@@ -1349,24 +1653,6 @@
catchExpose := false
!
-waitButton
- "ST-80 compatibility: wait until any mouse button is pressed.
- Do not use this in your applications; polling the sensor is
- bad style."
-
- [self anyButtonPressed] whileFalse:[
- (Delay forSeconds:0.01) wait.
- ].
-
-"/ (leftButtonPressed
-"/ or:[middleButtonPressed
-"/ or:[rightButtonPressed]]) ifTrue:[^ self].
-"/
-"/ [self hasButtonPressEventFor:nil] whileFalse:[
-"/ (Delay forSeconds:0.01) wait.
-"/ ]
-!
-
waitNoButton
"ST-80 compatibility: wait until no mouse button is pressed.
Do not use this in your applications; polling the sensor is
@@ -1384,293 +1670,4 @@
"/ ]
! !
-!WindowSensor methodsFor:'event flushing'!
-
-flushUserEvents
- "throw away all pending user events"
-
- (mouseAndKeyboard isNil or:[mouseAndKeyboard size > 0]) ifTrue:[
- mouseAndKeyboard := OrderedCollection new
- ].
-!
-
-flushExposeEventsFor:aView
- "throw away all pending expose events for aView,
- or any view, if the argument is nil.
- This can be done after a full redraw
- (or in views, which are always doing full redraws -
- instead of drawing the clip-area only)"
-
- |nEvent "{ Class: SmallInteger }"|
-
- damage notNil ifTrue:[
- nEvent := damage size.
- 1 to:nEvent do:[:index |
- |aDamage|
-
- aDamage := damage at:index.
- aDamage notNil ifTrue:[
- (aView isNil or:[aDamage view == aView]) ifTrue:[
- damage at:index put:nil
- ]
- ]
- ]
- ].
-!
-
-flushUserEventsFor:aView
- "throw away all pending user events for aView,
- or any view, if the argument is nil."
-
- |nEvent "{ Class: SmallInteger }"|
-
- mouseAndKeyboard notNil ifTrue:[
- nEvent := mouseAndKeyboard size.
- 1 to:nEvent do:[:i |
- |anEvent|
-
- anEvent := mouseAndKeyboard at:i.
- anEvent notNil ifTrue:[
- (aView isNil or:[anEvent view == aView]) ifTrue:[
- mouseAndKeyboard at:i put:nil
- ]
- ]
- ]
- ].
-!
-
-flushKeyboardFor:aView
- "throw away all pending keyboard events for aView,
- or any view, if the argument is nil."
-
- |nEvent "{ Class: SmallInteger }"|
-
- mouseAndKeyboard notNil ifTrue:[
- nEvent := mouseAndKeyboard size.
- 1 to:nEvent do:[:i |
- |anEvent|
-
- anEvent := mouseAndKeyboard at:i.
- (anEvent notNil and:[anEvent isKeyEvent]) ifTrue:[
- (aView isNil or:[anEvent view == aView]) ifTrue:[
- mouseAndKeyboard at:i put:nil
- ]
- ]
- ]
- ].
-!
-
-flushEventsFor:aView
- "throw away all events for aView,
- or any view, if the argument is nil."
-
- self flushExposeEventsFor:aView.
- self flushUserEventsFor:aView.
-!
-
-flushExposeEvents
- "throw away all pending expose events; this
- can be done after a full redraw (or in views, which are
- doing full redraws anly)"
-
- (damage isNil or:[damage size > 0]) ifTrue:[
- damage := OrderedCollection new
- ].
-!
-
-flushKeyboard
- "ST-80 compatibility: throw away all pending keyboard events"
-
- self flushKeyboardFor:nil
-!
-
-compressKeyPressEventsWithKey:aKey
- "count and remove multiple pending keyPress events for the
- same key, aKey. This is currently used in TextViews to compress
- multiple cursorUp/cursorDown events and do the scroll in one
- operation. (to avoid run-after-cursor on slow displays)"
-
- |n ev|
-
- n := 0.
- ev := self pendingEvent.
- [ev notNil and:[ev isKeyPressEvent]] whileTrue:[
- ((ev arguments at:1) == aKey) ifTrue:[
- n := n + 1.
- self nextEvent.
- ev := self pendingEvent.
- ] ifFalse:[
- ev := nil
- ]
- ].
- ^ n
-! !
-
-!WindowSensor methodsFor:'event simulation'!
-
-pushEvent:anEvent
- "manually put an event into the queue - this allows
- simulation of events (implementation of recorders & playback)
- or asynchronous communication between view applications."
-
- mouseAndKeyboard addLast:anEvent.
- self notifyEventArrival
-
- "Created: 18.9.1995 / 22:37:57 / claus"
-!
-
-pushUserEvent:aSelector for:aView
- "manually put an event into the queue - this allows
- simulation of events (implementation of recorders & playback)
- or asynchronous communication between view applications.
- The view will perform a method as specified by aSelector,
- when it performs event processing; this is different than sending
- this message directly, since the execution is done by the views process,
- not by the current process (which is especially worthwhile, if that method
- shows a modal box or similar)."
-
- self pushUserEvent:aSelector for:aView withArguments:#()
-
- "Modified: 18.9.1995 / 22:40:12 / claus"
-!
-
-pushUserEvent:aSelector for:aView withArguments:arguments
- "manually put an event into the queue - this allows
- simulation of events (implementation of recorders & playback)
- or asynchronous communication between view applications.
- The view will perform a method as specified by aSelector,
- when it performs event processing; this is different than sending
- this message directly, since the execution is done by the views process,
- not by the current process (which is especially worthwhile, if that method
- shows a modal box or similar)."
-
- self pushEvent:(WindowEvent
- for:aView
- type:aSelector
- arguments:arguments).
-
- "
- |b|
- b := Button label:'test'.
- b open.
- (Delay forSeconds:5) wait.
- b sensor pushEvent:#pointerEnter:x:y: for:b withArguments:#(0 1 1).
- (Delay forSeconds:1) wait.
- b sensor pushEvent:#buttonPress:x:y: for:b withArguments:#(1 1 1).
- (Delay forSeconds:2) wait.
- b sensor pushEvent:#buttonRelease:x:y: for:b withArguments:#(1 1 1).
- (Delay forSeconds:1) wait.
- b sensor pushEvent:#pointerLeave: for:b withArguments:#(0).
- "
-!
-
-forwardKeyEventsTo:aView
- "remove all keyboard events and send them to aViews sensor instead"
-
-"/ 'fwd' printNL.
- 1 to:mouseAndKeyboard size do:[:i |
- |anEvent|
-
- anEvent := mouseAndKeyboard at:i.
- anEvent notNil ifTrue:[
- anEvent isKeyEvent ifTrue:[
- anEvent view:aView.
- aView sensor pushEvent:anEvent.
-"/ anEvent type printNL.
- mouseAndKeyboard at:i put:nil
- ]
- ]
- ].
-! !
-
-!WindowSensor methodsFor:'accessing'!
-
-eventSemaphore
- "return the semaphore used to signal event arrival"
-
- ^ eventSemaphore
-!
-
-eventSemaphore:aSemaphore
- "set the semaphore used to signal event arrival"
-
- eventSemaphore := aSemaphore
-!
-
-ignoreUserInput:aBoolean
- "turn on/off ignoring of Ctrl-C processing"
-
- ignoreUserInput := aBoolean
-!
-
-ignoreUserInput
- "return true, if Ctrl-C processing is currently turned off"
-
- ^ ignoreUserInput
-!
-
-compressMotionEvents:aBoolean
- "turn on/off motion event compression"
-
- compressMotionEvents := aBoolean
-!
-
-eventListener:aListener
- "set the eventListener
- - see documentation for what this can be used for"
-
- eventListener := aListener
-
-!
-
-eventListener
- "return the eventListener
- - see documentation for what this can be used for"
-
- ^ eventListener
-!
-
-keyboardListener
- "return the keyboardListener
- - see documentation for what this can be used for"
-
- ^ keyboardListener
-!
-
-keyboardListener:aListener
- "set the keyboardListener
- - see documentation for what this can be used for"
-
- keyboardListener := aListener
-
-! !
-
-!WindowSensor methodsFor:'initialization'!
-
-initialize
- "initialize the event queues to empty"
-
- damage := OrderedCollection new.
- mouseAndKeyboard := OrderedCollection new.
- gotExpose := true.
- catchExpose := false.
-
- compressMotionEvents := translateKeyboardEvents := true.
- ignoreUserInput := false.
- shiftDown := ctrlDown := altDown := metaDown := false.
- leftButtonDown := middleButtonDown := rightButtonDown := false.
-!
-
-reinitialize
- "called when an image is restarted;
- reinitialize the event queues to empty; leave other setup as-is"
-
- self flushUserEvents.
- self flushExposeEvents.
- gotExpose := true.
- catchExpose := false.
- shiftDown := ctrlDown := altDown := metaDown := false.
- leftButtonDown := middleButtonDown := rightButtonDown := false.
-! !
-
WindowSensor initialize!
--- a/WindowEvent.st Thu Nov 23 03:29:10 1995 +0100
+++ b/WindowEvent.st Thu Nov 23 11:38:43 1995 +0100
@@ -33,10 +33,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libview/WindowEvent.st,v 1.20 1995-11-11 15:53:22 cg Exp $'
-!
-
documentation
"
Instances of WindowEvent are created for every event coming from
@@ -113,15 +109,20 @@
view has no transformation
----> 'view keyPress:key x:x y:y'
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/WindowEvent.st,v 1.21 1995-11-23 10:38:12 cg Exp $'
! !
!WindowEvent class methodsFor:'instance creation'!
-for:aView type:aSymbol arguments:argArray
- "create and return a new windowEvent for sending
- aSymbol-message with arguments to aView"
+damageFor:aView rectangle:aRectangle
+ "create and return a new damage Event for aRectangle
+ in aView"
- ^ (self new) for:aView type:aSymbol arguments:argArray
+ ^ (self new) for:aView type:#damage arguments:aRectangle
+
!
for:aView type:aSymbol
@@ -131,90 +132,11 @@
^ (self new) for:aView type:aSymbol arguments:#()
!
-damageFor:aView rectangle:aRectangle
- "create and return a new damage Event for aRectangle
- in aView"
-
- ^ (self new) for:aView type:#damage arguments:aRectangle
-
-! !
-
-!WindowEvent methodsFor:'queries'!
-
-isKeyEvent
- "return true, if this event is a keyboard event"
-
- ^ (type == #keyPress:x:y:) or:[type == #keyRelease:x:y:]
-!
-
-isKeyPressEvent
- "return true, if this event is a keyboard event"
-
- ^ (type == #keyPress:x:y:)
-!
-
-isButtonEvent
- "return true, if this event is a button event"
-
- ^ (type == #buttonPress:x:y:)
- or:[type == #buttonRelease:x:y:
- or:[type == #'buttonShiftPress:x:y:'
- or:[type == #'buttonMultiPress:x:y:'
- or:[type == #'buttonMotion:x:y:']]]]
-!
-
-isDamage
- "return true, if this is a damage event"
-
- ^ type == #damage
-! !
-
-!WindowEvent methodsFor:'accessing'!
+for:aView type:aSymbol arguments:argArray
+ "create and return a new windowEvent for sending
+ aSymbol-message with arguments to aView"
-view
- "return the view, for which the event is for"
-
- ^ view
-!
-
-view:aView
- "set the view, for which the event is for"
-
- view := aView
-!
-
-type
- "return the type of the event"
-
- ^ type
-!
-
-arguments
- "return the arguments of the event"
-
- ^ arguments
-!
-
-arguments:anArray
- "set the arguments"
-
- arguments := anArray
-!
-
-rectangle
- "return the damage rectangle"
-
- ^ arguments "consider this a kludge"
-!
-
-key
- "return the key of the key-event. For non key-events, nil is returned."
-
- ((type == #keyPress:x:y:)
- or:[type == #keyRelease:x:y:]) ifTrue:[
- ^ arguments at:1
- ].
- ^ nil
+ ^ (self new) for:aView type:aSymbol arguments:argArray
! !
!WindowEvent class methodsFor:'forwarding events'!
@@ -428,6 +350,94 @@
eventReceiver perform:selector withArguments:argArray
! !
+!WindowEvent methodsFor:'accessing'!
+
+arguments
+ "return the arguments of the event"
+
+ ^ arguments
+!
+
+arguments:anArray
+ "set the arguments"
+
+ arguments := anArray
+!
+
+key
+ "return the key of the key-event. For non key-events, nil is returned."
+
+ ((type == #keyPress:x:y:)
+ or:[type == #keyRelease:x:y:]) ifTrue:[
+ ^ arguments at:1
+ ].
+ ^ nil
+!
+
+rectangle
+ "return the damage rectangle"
+
+ ^ arguments "consider this a kludge"
+!
+
+type
+ "return the type of the event"
+
+ ^ type
+!
+
+view
+ "return the view, for which the event is for"
+
+ ^ view
+!
+
+view:aView
+ "set the view, for which the event is for"
+
+ view := aView
+! !
+
+!WindowEvent methodsFor:'private accessing'!
+
+for:aView type:aSymbol arguments:argArray
+ "set the instance variables of the event"
+
+ view := aView.
+ type := aSymbol.
+ arguments := argArray
+! !
+
+!WindowEvent methodsFor:'queries'!
+
+isButtonEvent
+ "return true, if this event is a button event"
+
+ ^ (type == #buttonPress:x:y:)
+ or:[type == #buttonRelease:x:y:
+ or:[type == #'buttonShiftPress:x:y:'
+ or:[type == #'buttonMultiPress:x:y:'
+ or:[type == #'buttonMotion:x:y:']]]]
+!
+
+isDamage
+ "return true, if this is a damage event"
+
+ ^ type == #damage
+!
+
+isKeyEvent
+ "return true, if this event is a keyboard event"
+
+ ^ (type == #keyPress:x:y:) or:[type == #keyRelease:x:y:]
+!
+
+isKeyPressEvent
+ "return true, if this event is a keyboard event"
+
+ ^ (type == #keyPress:x:y:)
+! !
+
!WindowEvent methodsFor:'sending'!
sendEvent
@@ -452,12 +462,3 @@
delegate:true
! !
-!WindowEvent methodsFor:'private accessing'!
-
-for:aView type:aSymbol arguments:argArray
- "set the instance variables of the event"
-
- view := aView.
- type := aSymbol.
- arguments := argArray
-! !
--- a/WindowGroup.st Thu Nov 23 03:29:10 1995 +0100
+++ b/WindowGroup.st Thu Nov 23 11:38:43 1995 +0100
@@ -11,8 +11,8 @@
"
Object subclass:#WindowGroup
- instanceVariableNames:'views topViews myProcess mySensor isModal previousGroup
- focusView focusSequence preEventHook postEventHook'
+ instanceVariableNames:'views topViews myProcess mySensor isModal previousGroup focusView
+ focusSequence preEventHook postEventHook'
classVariableNames:'LastActiveGroup LastActiveProcess LeaveSignal'
poolDictionaries:''
category:'Interface-Support'
@@ -34,10 +34,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libview/WindowGroup.st,v 1.35 1995-11-13 17:11:01 cg Exp $'
-!
-
documentation
"
In Smalltalk/X, the known (ST-80) concept of a controller has been
@@ -127,6 +123,10 @@
For more information, read 'introduction to view programming' in the
doc/online directory.
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/WindowGroup.st,v 1.36 1995-11-23 10:38:24 cg Exp $'
! !
!WindowGroup class methodsFor:'initialization'!
@@ -141,6 +141,14 @@
"WindowGroup initialize"
! !
+!WindowGroup class methodsFor:'instance creation'!
+
+new
+ "create and return a new WindowGroup object"
+
+ ^ self basicNew initialize
+! !
+
!WindowGroup class methodsFor:'Signal constants'!
leaveSignal
@@ -152,14 +160,6 @@
^ LeaveSignal
! !
-!WindowGroup class methodsFor:'instance creation'!
-
-new
- "create and return a new WindowGroup object"
-
- ^ self basicNew initialize
-! !
-
!WindowGroup class methodsFor:'accessing'!
activeGroup
@@ -212,14 +212,6 @@
"Modified: 3.9.1995 / 14:49:53 / claus"
!
-setActiveGroup:aGroup
- "set the currently active windowGroup.
- Temporary; do not use this interface, it will vanish."
-
- LastActiveProcess := Processor activeProcess.
- LastActiveGroup := aGroup
-!
-
scheduledWindowGroups
"return a collection of all windowGroups (possibly for different
display devices) which are scheduled (i.e. which have a process
@@ -249,14 +241,25 @@
"
"Modified: 1.9.1995 / 13:43:09 / claus"
+!
+
+setActiveGroup:aGroup
+ "set the currently active windowGroup.
+ Temporary; do not use this interface, it will vanish."
+
+ LastActiveProcess := Processor activeProcess.
+ LastActiveGroup := aGroup
! !
!WindowGroup methodsFor:'accessing'!
-sensor
- "return the windowGroups sensor"
+addTopView:aView
+ "add a topview to the group"
- ^ mySensor
+ topViews isNil ifTrue:[
+ topViews := OrderedCollection new.
+ ].
+ topViews add:aView
!
addView:aView
@@ -268,13 +271,57 @@
views add:aView
!
-addTopView:aView
- "add a topview to the group"
+isModal
+ "return true, if I am in a modal mode"
+
+ ^ isModal
+!
+
+mainGroup
+ "return the main windowgroup
+ (that is the top one, which is not modal).
+ There is one exception to this: the debugger (which is sort of modal)
+ returns itself as mainGroup (not its debuggee)."
+
+ |g prev|
+
+ g := self.
+ [g notNil and:[g isModal and:[(prev := g previousGroup) notNil]]] whileTrue:[
+ g := prev
+ ].
+ ^ g
+
+ "Modified: 3.9.1995 / 14:57:20 / claus"
+!
- topViews isNil ifTrue:[
- topViews := OrderedCollection new.
- ].
- topViews add:aView
+postEventHook:anObject
+ "set the postEventHook - this one will get all events
+ passed after being processed here (via #processEvent:)."
+
+ postEventHook := anObject
+!
+
+preEventHook:anObject
+ "set the preEventHook - this one will get all events
+ passed before being processed here (via #processEvent:).
+ If this returns true, the event is supposed to be already
+ processed and ignored here.
+ Otherwise, it is processed as usual."
+
+ preEventHook := anObject
+!
+
+previousGroup
+ "return the windowgroup that started this group.
+ (for modal groups only)"
+
+ ^ previousGroup
+!
+
+process
+ "return the windowGroups process"
+
+ ^ myProcess
!
removeView:aView
@@ -303,52 +350,10 @@
mySensor notNil ifTrue:[mySensor eventSemaphore signal]
!
-views
- "return the views accociated to this windowGroup"
-
- ^ views
-!
-
-topViews
- "return the topviews accociated to this windowGroup"
-
- ^ topViews
-!
-
-process
- "return the windowGroups process"
-
- ^ myProcess
-!
-
-isModal
- "return true, if I am in a modal mode"
+sensor
+ "return the windowGroups sensor"
- ^ isModal
-!
-
-previousGroup
- "return the windowgroup that started this group.
- (for modal groups only)"
-
- ^ previousGroup
-!
-
-mainGroup
- "return the main windowgroup
- (that is the top one, which is not modal).
- There is one exception to this: the debugger (which is sort of modal)
- returns itself as mainGroup (not its debuggee)."
-
- |g prev|
-
- g := self.
- [g notNil and:[g isModal and:[(prev := g previousGroup) notNil]]] whileTrue:[
- g := prev
- ].
- ^ g
-
- "Modified: 3.9.1995 / 14:57:20 / claus"
+ ^ mySensor
!
sensor:aSensor
@@ -357,64 +362,156 @@
mySensor := aSensor
!
-preEventHook:anObject
- "set the preEventHook - this one will get all events
- passed before being processed here (via #processEvent:).
- If this returns true, the event is supposed to be already
- processed and ignored here.
- Otherwise, it is processed as usual."
+topViews
+ "return the topviews accociated to this windowGroup"
- preEventHook := anObject
+ ^ topViews
!
-postEventHook:anObject
- "set the postEventHook - this one will get all events
- passed after being processed here (via #processEvent:)."
+views
+ "return the views accociated to this windowGroup"
- postEventHook := anObject
+ ^ views
! !
-!WindowGroup methodsFor:'special accessing'!
+!WindowGroup methodsFor:'activation / deactivation'!
+
+closeDownViews
+ "destroy all views associated to this window group"
+
+ topViews notNil ifTrue:[
+ topViews do:[:aTopView | aTopView destroy]
+ ].
+ views := nil.
+ topViews := nil.
+ mySensor := nil.
+!
+
+realizeTopViews:isRestart
+ "realize all topViews associated to this windowGroup.
+ If this is a restart, tell topViews about it."
+
+ topViews notNil ifTrue:[
+ topViews do:[:aView |
+ aView realize.
+ isRestart ifTrue:[
+ aView restarted
+ ]
+ ].
+ ].
+!
-setPreviousGroup:aGroup
- "special entry for debugger:
- set the windowgroup that started this group (for modal groups only).
- This is not a public interface."
+restart
+ "restart after a snapin."
- previousGroup := aGroup
+ topViews notNil ifTrue:[
+ "
+ need a new semaphore, since obsolete processes
+ (from our previous live) may still sit on the current semaphore
+ "
+ mySensor eventSemaphore:Semaphore new.
+ isModal ifFalse:[
+ self startup:true
+ ]
+ ]
+!
- "Modified: 3.9.1995 / 14:55:40 / claus"
+shutdown
+ "shutdow the window group; close all views and
+ terminate process"
+
+ |p|
+
+ self closeDownViews.
+ myProcess notNil ifTrue:[
+ p := myProcess.
+ myProcess := nil.
+ p terminate.
+ ]
!
-setModal:aBoolean
- "special entry for debugger: set the modal flag.
- Not for public use"
+startup:isRestart
+ "startup the window-group;
+ this creates a new window group process, which
+ does the event processing."
+
+ |top nm dev devNm|
+
+ previousGroup := nil.
+ myProcess isNil ifTrue:[
+ isModal := false.
+ myProcess := [
+ self realizeTopViews:isRestart.
+ self eventLoopWhile:[true] onLeave:[]
+ ] forkAt:Processor userSchedulingPriority.
- isModal := aBoolean
+ (topViews notNil and:[topViews isEmpty not]) ifTrue:[
+ "
+ give the handler process a user friendly name
+ "
+ top := topViews first.
+ nm := top processName.
+ (dev := top device) notNil ifTrue:[
+ devNm := dev displayName.
+ (devNm notNil and:[devNm ~= Display displayName]) ifTrue:[
+ nm := nm , ' (' , devNm , ')'
+ ]
+ ]
+ ] ifFalse:[
+ nm := 'window handler'.
+ ].
+ myProcess name:nm.
- "Modified: 3.9.1995 / 14:51:04 / claus"
+ "when the process dies, we have to close-down
+ the views as well
+ "
+ myProcess exitAction:[self closeDownViews]
+ ]
!
-setProcess:aProcess
- "special entry for debugger: set the windowGroups process.
- Not for public use."
+startupModal:checkBlock
+ "startup the window-group in a modal loop (i.e. under the
+ currently running process);
+ checkBlock is evaluated and loop is left, when false is
+ returned."
+
+ "set previousGroup to the main (non-modal) group"
- myProcess := aProcess
-
- "Modified: 3.9.1995 / 14:25:38 / claus"
+ previousGroup := WindowGroup activeGroup.
+ isModal := true.
+ self realizeTopViews:false.
+ self
+ eventLoopWhile:checkBlock
+ onLeave:[
+ "
+ cleanup, in case of a terminate
+ "
+ previousGroup := nil.
+ topViews := nil.
+ views := nil.
+ "
+ the following is rubbish;
+ the views could be reused ..
+ "
+"
+ topViews notNil ifTrue:[
+ topViews do:[:aView |
+ aView destroy
+ ].
+ topViews := nil.
+ ].
+ views notNil ifTrue:[
+ views do:[:aView |
+ aView destroy
+ ].
+ views := nil.
+ ].
+"
+ ]
! !
!WindowGroup methodsFor:'enumerating'!
-allViewsDo:aBlock
- "evaluate aBlock for all views & topviews in this group.
- This works on a copy of the view collection, to allow for
- destroy and other collection changing operations to be done."
-
- topViews notNil ifTrue:[topViews copy do:aBlock].
- views notNil ifTrue:[views copy do:aBlock]
-!
-
allTopViewsExcept:aView do:aBlock
"evaluate aBlock for all topviews except aView in this group.
This works on a copy of the view collection, to allow for
@@ -427,6 +524,29 @@
].
!
+allViewsDo:aBlock
+ "evaluate aBlock for all views & topviews in this group.
+ This works on a copy of the view collection, to allow for
+ destroy and other collection changing operations to be done."
+
+ topViews notNil ifTrue:[topViews copy do:aBlock].
+ views notNil ifTrue:[views copy do:aBlock]
+!
+
+partnersDo:aBlock
+ "evaluate aBlock for all partnerViews.
+ This works on a copy of the view collection, to allow for
+ destroy and other collection changing operations to be done."
+
+ topViews notNil ifTrue:[
+ topViews copy do:[:v |
+ v notNil ifTrue:[
+ v type == #partner ifTrue:[aBlock value:v].
+ ]
+ ]
+ ].
+!
+
slavesDo:aBlock
"evaluate aBlock for all slaveViews.
This works on a copy of the view collection, to allow for
@@ -439,75 +559,102 @@
]
]
].
-!
-
-partnersDo:aBlock
- "evaluate aBlock for all partnerViews.
- This works on a copy of the view collection, to allow for
- destroy and other collection changing operations to be done."
-
- topViews notNil ifTrue:[
- topViews copy do:[:v |
- v notNil ifTrue:[
- v type == #partner ifTrue:[aBlock value:v].
- ]
- ]
- ].
-! !
-
-!WindowGroup methodsFor:'special'!
-
-showCursor:aCursor
- "change the cursor to aCursor in all of my views."
-
- |c|
-
- c := aCursor.
- self allViewsDo:[:aView |
- c := c on:(aView device).
- aView device setCursor:c id in:aView id.
- ].
-!
-
-restoreCursors
- "restore the original cursors in all of my views"
-
- |c|
-
- self allViewsDo:[:aView |
- c := aView cursor on:(aView device).
- aView device setCursor:(c id) in:(aView id).
- ].
-!
-
-withCursor:aCursor do:aBlock
- "evaluate aBlock while showing aCursor in all
- my views (used to show wait-cursor while doing something).
- Return the result as returned by aBlock."
-
- |oldCursors|
-
- "
- get mapping of view->cursor for all of my subviews
- "
- oldCursors := IdentityDictionary new.
- self allViewsDo:[:aView |
- oldCursors at:aView put:(aView cursor).
- aView cursor:aCursor
- ].
-
- ^ aBlock valueNowOrOnUnwindDo:[
- "
- restore cursors from the mapping
- "
- oldCursors keysAndValuesDo:[:view :cursor |
- view cursor:cursor
- ]
- ]
! !
!WindowGroup methodsFor:'event handling'!
+eventLoop
+ "loop executed by windowGroup process;
+ wait-for and process events forever"
+
+ self eventLoopWhile:[true] onLeave:[]
+!
+
+eventLoopWhile:aBlock onLeave:cleanupActions
+ "wait-for and process events.
+ Stay in this loop while there are still any views to dispatch for,
+ and aBlock evaluates to true."
+
+ |thisProcess|
+
+ thisProcess := Processor activeProcess.
+
+ [
+ "/
+ "/ on leave, exit the event loop
+ "/
+ LeaveSignal handle:[:ex |
+ ex return
+ ] do:[
+ |p g mainGroup|
+
+ isModal ifTrue:[
+ mainGroup := self mainGroup.
+ ].
+
+ aBlock whileTrue:[
+ LastActiveGroup := self.
+ LastActiveProcess := thisProcess.
+
+ (views isNil and:[topViews isNil]) ifTrue:[
+ myProcess notNil ifTrue:[
+ p := myProcess.
+ myProcess := nil.
+ p terminate.
+ "not reached - there is no life after death"
+ ].
+ "
+ this is the end of a modal loop
+ (not having a private process ...)
+ "
+ ^ self
+ ].
+
+ "/
+ "/ on abort, stay in the event loop
+ "/
+ AbortSignal handle:[:ex |
+ ex return
+ ] do:[
+ "
+ if modal, break out of the wait after some time
+ to allow servicing update-events of the blocked
+ windowgroup.
+ "
+ thisProcess setStateTo:#eventWait if:#active.
+ isModal ifTrue:[
+ mySensor eventSemaphore waitWithTimeout:0.2.
+ ] ifFalse:[
+ mySensor eventSemaphore wait.
+ ].
+ LastActiveGroup := self.
+ LastActiveProcess := thisProcess.
+ self processEvents.
+ ].
+
+ "
+ if modal, also check for redraw events in my maingroup
+ (we arrive here after every event for myself or after the
+ above timeout)
+ "
+ mainGroup notNil ifTrue:[
+ mainGroup processExposeEvents.
+ ]
+ ].
+ ].
+ ] valueNowOrOnUnwindDo:[
+ cleanupActions notNil ifTrue:[cleanupActions value]
+ ]
+!
+
+leaveEventLoop
+ "immediately leave the event loop, returning way back.
+ This can be used to leave (and closedown) a modal group.
+ (for normal views, this does not make sense)"
+
+ ^ LeaveSignal raise
+!
+
processEvents
"process events from either the damage- or user input queues.
Abort is assumed to be handled elsewhere."
@@ -620,90 +767,6 @@
]
!
-eventLoop
- "loop executed by windowGroup process;
- wait-for and process events forever"
-
- self eventLoopWhile:[true] onLeave:[]
-!
-
-eventLoopWhile:aBlock onLeave:cleanupActions
- "wait-for and process events.
- Stay in this loop while there are still any views to dispatch for,
- and aBlock evaluates to true."
-
- |thisProcess|
-
- thisProcess := Processor activeProcess.
-
- [
- "/
- "/ on leave, exit the event loop
- "/
- LeaveSignal handle:[:ex |
- ex return
- ] do:[
- |p g mainGroup|
-
- isModal ifTrue:[
- mainGroup := self mainGroup.
- ].
-
- aBlock whileTrue:[
- LastActiveGroup := self.
- LastActiveProcess := thisProcess.
-
- (views isNil and:[topViews isNil]) ifTrue:[
- myProcess notNil ifTrue:[
- p := myProcess.
- myProcess := nil.
- p terminate.
- "not reached - there is no life after death"
- ].
- "
- this is the end of a modal loop
- (not having a private process ...)
- "
- ^ self
- ].
-
- "/
- "/ on abort, stay in the event loop
- "/
- AbortSignal handle:[:ex |
- ex return
- ] do:[
- "
- if modal, break out of the wait after some time
- to allow servicing update-events of the blocked
- windowgroup.
- "
- thisProcess setStateTo:#eventWait if:#active.
- isModal ifTrue:[
- mySensor eventSemaphore waitWithTimeout:0.2.
- ] ifFalse:[
- mySensor eventSemaphore wait.
- ].
- LastActiveGroup := self.
- LastActiveProcess := thisProcess.
- self processEvents.
- ].
-
- "
- if modal, also check for redraw events in my maingroup
- (we arrive here after every event for myself or after the
- above timeout)
- "
- mainGroup notNil ifTrue:[
- mainGroup processExposeEvents.
- ]
- ].
- ].
- ] valueNowOrOnUnwindDo:[
- cleanupActions notNil ifTrue:[cleanupActions value]
- ]
-!
-
waitForExposeFor:aView
"wait for a noExpose on aView, then process all exposes.
To be used after a scroll"
@@ -712,182 +775,53 @@
AbortSignal catch:[
self processExposeEvents
]
-!
-
-leaveEventLoop
- "immediately leave the event loop, returning way back.
- This can be used to leave (and closedown) a modal group.
- (for normal views, this does not make sense)"
-
- ^ LeaveSignal raise
-! !
-
-!WindowGroup methodsFor:'activation / deactivation'!
-
-realizeTopViews:isRestart
- "realize all topViews associated to this windowGroup.
- If this is a restart, tell topViews about it."
-
- topViews notNil ifTrue:[
- topViews do:[:aView |
- aView realize.
- isRestart ifTrue:[
- aView restarted
- ]
- ].
- ].
-!
-
-restart
- "restart after a snapin."
-
- topViews notNil ifTrue:[
- "
- need a new semaphore, since obsolete processes
- (from our previous live) may still sit on the current semaphore
- "
- mySensor eventSemaphore:Semaphore new.
- isModal ifFalse:[
- self startup:true
- ]
- ]
-!
-
-startup:isRestart
- "startup the window-group;
- this creates a new window group process, which
- does the event processing."
-
- |top nm dev devNm|
-
- previousGroup := nil.
- myProcess isNil ifTrue:[
- isModal := false.
- myProcess := [
- self realizeTopViews:isRestart.
- self eventLoopWhile:[true] onLeave:[]
- ] forkAt:Processor userSchedulingPriority.
-
- (topViews notNil and:[topViews isEmpty not]) ifTrue:[
- "
- give the handler process a user friendly name
- "
- top := topViews first.
- nm := top processName.
- (dev := top device) notNil ifTrue:[
- devNm := dev displayName.
- (devNm notNil and:[devNm ~= Display displayName]) ifTrue:[
- nm := nm , ' (' , devNm , ')'
- ]
- ]
- ] ifFalse:[
- nm := 'window handler'.
- ].
- myProcess name:nm.
-
- "when the process dies, we have to close-down
- the views as well
- "
- myProcess exitAction:[self closeDownViews]
- ]
-!
-
-startupModal:checkBlock
- "startup the window-group in a modal loop (i.e. under the
- currently running process);
- checkBlock is evaluated and loop is left, when false is
- returned."
-
- "set previousGroup to the main (non-modal) group"
-
- previousGroup := WindowGroup activeGroup.
- isModal := true.
- self realizeTopViews:false.
- self
- eventLoopWhile:checkBlock
- onLeave:[
- "
- cleanup, in case of a terminate
- "
- previousGroup := nil.
- topViews := nil.
- views := nil.
- "
- the following is rubbish;
- the views could be reused ..
- "
-"
- topViews notNil ifTrue:[
- topViews do:[:aView |
- aView destroy
- ].
- topViews := nil.
- ].
- views notNil ifTrue:[
- views do:[:aView |
- aView destroy
- ].
- views := nil.
- ].
-"
- ]
-!
-
-closeDownViews
- "destroy all views associated to this window group"
-
- topViews notNil ifTrue:[
- topViews do:[:aTopView | aTopView destroy]
- ].
- views := nil.
- topViews := nil.
- mySensor := nil.
-!
-
-shutdown
- "shutdow the window group; close all views and
- terminate process"
-
- |p|
-
- self closeDownViews.
- myProcess notNil ifTrue:[
- p := myProcess.
- myProcess := nil.
- p terminate.
- ]
-! !
-
-!WindowGroup methodsFor:'initialization'!
-
-reinitialize
- "reinitialize the windowgroup after an image restart"
-
- "throw away old (zombie) process"
- myProcess notNil ifTrue:[
- "careful: the old processes exitaction must be cleared
- otherwise, it might do destroy or other actions when it
- gets finalized ...
- "
- myProcess exitAction:nil.
- myProcess := nil.
- ].
-
- "throw away old events"
- mySensor reinitialize
-!
-
-initialize
- "setup the windowgroup, by creating a new sensor
- and an event semaphore"
-
- mySensor := WindowSensor new.
- mySensor eventSemaphore:Semaphore new.
- isModal := false.
! !
!WindowGroup methodsFor:'focus control'!
+focusNext
+ "give focus to next view in focusSequence"
+
+ |index|
+
+ focusSequence size == 0 ifTrue:[^ self].
+ focusView notNil ifTrue:[
+ index := (focusSequence indexOf:focusView) + 1.
+ index > focusSequence size ifTrue:[index := 1].
+ ] ifFalse:[
+ index := 1.
+ ].
+ self focusView:(focusSequence at:index)
+
+ "
+ |top v1 v2|
+
+ top := StandardSystemView new.
+ v1 := EditTextView origin:0.0@0.0 corner:1.0@0.5 in:top.
+ v2 := EditTextView origin:0.0@0.5 corner:1.0@1.0 in:top.
+ top open.
+ top windowGroup focusSequence:(Array with:v1 with:v2).
+ top windowGroup focusOn:v1.
+ (Delay forSeconds:10) wait.
+ top windowGroup focusNext.
+ "
+!
+
+focusPrevious
+ "give focus to previous view in focusSequence"
+
+ |index|
+
+ focusSequence size == 0 ifTrue:[^ self].
+ focusView notNil ifTrue:[
+ index := (focusSequence indexOf:focusView) - 1.
+ index < 1 ifTrue:[index := focusSequence size].
+ ] ifFalse:[
+ index := focusSequence size.
+ ].
+ self focusView:(focusSequence at:index)
+!
+
focusSequence
"return the focus sequence for focusNext/focusPrevious.
Focus is stepped in the order in which subviews occur in
@@ -930,49 +864,34 @@
top open.
top windowGroup focusView:v1.
"
+! !
+
+!WindowGroup methodsFor:'initialization'!
+
+initialize
+ "setup the windowgroup, by creating a new sensor
+ and an event semaphore"
+
+ mySensor := WindowSensor new.
+ mySensor eventSemaphore:Semaphore new.
+ isModal := false.
!
-focusNext
- "give focus to next view in focusSequence"
-
- |index|
-
- focusSequence size == 0 ifTrue:[^ self].
- focusView notNil ifTrue:[
- index := (focusSequence indexOf:focusView) + 1.
- index > focusSequence size ifTrue:[index := 1].
- ] ifFalse:[
- index := 1.
- ].
- self focusView:(focusSequence at:index)
-
- "
- |top v1 v2|
+reinitialize
+ "reinitialize the windowgroup after an image restart"
- top := StandardSystemView new.
- v1 := EditTextView origin:0.0@0.0 corner:1.0@0.5 in:top.
- v2 := EditTextView origin:0.0@0.5 corner:1.0@1.0 in:top.
- top open.
- top windowGroup focusSequence:(Array with:v1 with:v2).
- top windowGroup focusOn:v1.
- (Delay forSeconds:10) wait.
- top windowGroup focusNext.
- "
-!
+ "throw away old (zombie) process"
+ myProcess notNil ifTrue:[
+ "careful: the old processes exitaction must be cleared
+ otherwise, it might do destroy or other actions when it
+ gets finalized ...
+ "
+ myProcess exitAction:nil.
+ myProcess := nil.
+ ].
-focusPrevious
- "give focus to previous view in focusSequence"
-
- |index|
-
- focusSequence size == 0 ifTrue:[^ self].
- focusView notNil ifTrue:[
- index := (focusSequence indexOf:focusView) - 1.
- index < 1 ifTrue:[index := focusSequence size].
- ] ifFalse:[
- index := focusSequence size.
- ].
- self focusView:(focusSequence at:index)
+ "throw away old events"
+ mySensor reinitialize
! !
!WindowGroup methodsFor:'printing'!
@@ -990,3 +909,86 @@
].
aStream nextPutAll:('WindowGroup(' , myProcess nameOrId , ')')
! !
+
+!WindowGroup methodsFor:'special'!
+
+restoreCursors
+ "restore the original cursors in all of my views"
+
+ |c|
+
+ self allViewsDo:[:aView |
+ c := aView cursor on:(aView device).
+ aView device setCursor:(c id) in:(aView id).
+ ].
+!
+
+showCursor:aCursor
+ "change the cursor to aCursor in all of my views."
+
+ |c|
+
+ c := aCursor.
+ self allViewsDo:[:aView |
+ c := c on:(aView device).
+ aView device setCursor:c id in:aView id.
+ ].
+!
+
+withCursor:aCursor do:aBlock
+ "evaluate aBlock while showing aCursor in all
+ my views (used to show wait-cursor while doing something).
+ Return the result as returned by aBlock."
+
+ |oldCursors|
+
+ "
+ get mapping of view->cursor for all of my subviews
+ "
+ oldCursors := IdentityDictionary new.
+ self allViewsDo:[:aView |
+ oldCursors at:aView put:(aView cursor).
+ aView cursor:aCursor
+ ].
+
+ ^ aBlock valueNowOrOnUnwindDo:[
+ "
+ restore cursors from the mapping
+ "
+ oldCursors keysAndValuesDo:[:view :cursor |
+ view cursor:cursor
+ ]
+ ]
+! !
+
+!WindowGroup methodsFor:'special accessing'!
+
+setModal:aBoolean
+ "special entry for debugger: set the modal flag.
+ Not for public use"
+
+ isModal := aBoolean
+
+ "Modified: 3.9.1995 / 14:51:04 / claus"
+!
+
+setPreviousGroup:aGroup
+ "special entry for debugger:
+ set the windowgroup that started this group (for modal groups only).
+ This is not a public interface."
+
+ previousGroup := aGroup
+
+ "Modified: 3.9.1995 / 14:55:40 / claus"
+!
+
+setProcess:aProcess
+ "special entry for debugger: set the windowGroups process.
+ Not for public use."
+
+ myProcess := aProcess
+
+ "Modified: 3.9.1995 / 14:25:38 / claus"
+! !
+
+WindowGroup initialize!
--- a/WindowSensor.st Thu Nov 23 03:29:10 1995 +0100
+++ b/WindowSensor.st Thu Nov 23 11:38:43 1995 +0100
@@ -10,15 +10,12 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.5 on 7-may-1995 at 11:49:31 am'!
-
Object subclass:#WindowSensor
instanceVariableNames:'eventSemaphore damage mouseAndKeyboard compressMotionEvents
- ignoreUserInput exposeEventSemaphore catchExpose
- gotExpose gotOtherEvent translateKeyboardEvents shiftDown
- ctrlDown metaDown altDown
- leftButtonDown middleButtonDown rightButtonDown
- eventListener keyboardListener'
+ ignoreUserInput exposeEventSemaphore catchExpose gotExpose
+ gotOtherEvent translateKeyboardEvents shiftDown ctrlDown metaDown
+ altDown leftButtonDown middleButtonDown rightButtonDown
+ eventListener keyboardListener'
classVariableNames:'ControlCEnabled EventListener ComposeTable GotCompose Compose1'
poolDictionaries:''
category:'Interface-Support'
@@ -40,10 +37,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libview/WindowSensor.st,v 1.33 1995-11-11 15:53:35 cg Exp $'
-!
-
documentation
"
Instances of this class keep track of events and damage areas for a group of
@@ -174,6 +167,10 @@
ComposeTable <Array> compose-key translation table
"
+!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/WindowSensor.st,v 1.34 1995-11-23 10:38:43 cg Exp $'
! !
!WindowSensor class methodsFor:'initialization'!
@@ -301,6 +298,24 @@
!WindowSensor class methodsFor:'accessing'!
+composeTable
+ "return the compose-key table.
+ Entries consist of 3-element arrays each, where
+ the first two entries (of each entry) are the raw characters,
+ and the third is the resulting composed-key"
+
+ ^ ComposeTable
+!
+
+composeTable:aTable
+ "set the compose-key table.
+ Entries consist of 3-element arrays each, where
+ the first two entries (of each entry) are the raw characters,
+ and the third is the resulting composed-key"
+
+ ComposeTable := aTable
+!
+
controlCEnabled:aBoolean
"enable/disable Control-C processing.
If enabled, pressing CNTL-C in a view will interrupt it and bring
@@ -312,13 +327,6 @@
ControlCEnabled := aBoolean
!
-eventListener:aListener
- "set the eventListener
- - see documentation for what this can be used for"
-
- EventListener := aListener
-!
-
eventListener
"return the eventListener
- see documentation for what this can be used for"
@@ -326,22 +334,11 @@
^ EventListener
!
-composeTable:aTable
- "set the compose-key table.
- Entries consist of 3-element arrays each, where
- the first two entries (of each entry) are the raw characters,
- and the third is the resulting composed-key"
+eventListener:aListener
+ "set the eventListener
+ - see documentation for what this can be used for"
- ComposeTable := aTable
-!
-
-composeTable
- "return the compose-key table.
- Entries consist of 3-element arrays each, where
- the first two entries (of each entry) are the raw characters,
- and the third is the resulting composed-key"
-
- ^ ComposeTable
+ EventListener := aListener
! !
!WindowSensor class methodsFor:'queries'!
@@ -357,94 +354,192 @@
"
! !
-!WindowSensor methodsFor:'private'!
+!WindowSensor methodsFor:'accessing'!
+
+compressMotionEvents:aBoolean
+ "turn on/off motion event compression"
+
+ compressMotionEvents := aBoolean
+!
+
+eventListener
+ "return the eventListener
+ - see documentation for what this can be used for"
+
+ ^ eventListener
+!
+
+eventListener:aListener
+ "set the eventListener
+ - see documentation for what this can be used for"
+
+ eventListener := aListener
+
+!
-isModifierKey:key
- (key == #Shift
- or:[key == #'Shift_R'
- or:[key == #'Shift_L']]) ifTrue:[
- ^ true
- ].
- (key == #Alt
- or:[key == #'Alt_R' or:[key == #'Alt_L']]) ifTrue:[
- ^ true
- ].
- (key == #Meta
- or:[key == #'Meta_R' or:[key == #'Meta_L']]) ifTrue:[
- ^ true
- ].
- (key == #Control
- or:[key == #'Control_R' or:[key == #'Control_L']]) ifTrue:[
- ^ true
- ].
- ^ false
+eventSemaphore
+ "return the semaphore used to signal event arrival"
+
+ ^ eventSemaphore
+!
+
+eventSemaphore:aSemaphore
+ "set the semaphore used to signal event arrival"
+
+ eventSemaphore := aSemaphore
+!
+
+ignoreUserInput
+ "return true, if Ctrl-C processing is currently turned off"
+
+ ^ ignoreUserInput
+!
+
+ignoreUserInput:aBoolean
+ "turn on/off ignoring of Ctrl-C processing"
+
+ ignoreUserInput := aBoolean
!
-key:key state:onOrOff
- "update the state of the shiftDown/metaDown and ctrlDown
- flags"
+keyboardListener
+ "return the keyboardListener
+ - see documentation for what this can be used for"
+
+ ^ keyboardListener
+!
+
+keyboardListener:aListener
+ "set the keyboardListener
+ - see documentation for what this can be used for"
+
+ keyboardListener := aListener
+
+! !
+
+!WindowSensor methodsFor:'event flushing'!
- (key == #Shift
- or:[key == #'Shift_R'
- or:[key == #'Shift_L']]) ifTrue:[
- shiftDown := onOrOff.
- ^ self
+compressKeyPressEventsWithKey:aKey
+ "count and remove multiple pending keyPress events for the
+ same key, aKey. This is currently used in TextViews to compress
+ multiple cursorUp/cursorDown events and do the scroll in one
+ operation. (to avoid run-after-cursor on slow displays)"
+
+ |n ev|
+
+ n := 0.
+ ev := self pendingEvent.
+ [ev notNil and:[ev isKeyPressEvent]] whileTrue:[
+ ((ev arguments at:1) == aKey) ifTrue:[
+ n := n + 1.
+ self nextEvent.
+ ev := self pendingEvent.
+ ] ifFalse:[
+ ev := nil
+ ]
].
- (key == #Alt
- or:[key == #'Alt_R' or:[key == #'Alt_L']]) ifTrue:[
- altDown := onOrOff.
- ^ self
- ].
- (key == #Meta
- or:[key == #'Meta_R' or:[key == #'Meta_L']]) ifTrue:[
- metaDown := onOrOff.
- ^ self
- ].
- (key == #Control
- or:[key == #'Control_R' or:[key == #'Control_L']]) ifTrue:[
- ctrlDown := onOrOff.
- ^ self
+ ^ n
+!
+
+flushEventsFor:aView
+ "throw away all events for aView,
+ or any view, if the argument is nil."
+
+ self flushExposeEventsFor:aView.
+ self flushUserEventsFor:aView.
+!
+
+flushExposeEvents
+ "throw away all pending expose events; this
+ can be done after a full redraw (or in views, which are
+ doing full redraws anly)"
+
+ (damage isNil or:[damage size > 0]) ifTrue:[
+ damage := OrderedCollection new
].
!
-compose:key1 with:key2
- "compose a 2-character sequence into a composed key"
+flushExposeEventsFor:aView
+ "throw away all pending expose events for aView,
+ or any view, if the argument is nil.
+ This can be done after a full redraw
+ (or in views, which are always doing full redraws -
+ instead of drawing the clip-area only)"
+
+ |nEvent "{ Class: SmallInteger }"|
- ComposeTable do:[:entry |
- |v|
+ damage notNil ifTrue:[
+ nEvent := damage size.
+ 1 to:nEvent do:[:index |
+ |aDamage|
- ((key1 == (entry at:1)) and:[key2 == (entry at:2)]) ifTrue:[
- v := entry at:3.
- v isCharacter ifFalse:[v := Character value:v].
- ^ v
+ aDamage := damage at:index.
+ aDamage notNil ifTrue:[
+ (aView isNil or:[aDamage view == aView]) ifTrue:[
+ damage at:index put:nil
+ ]
+ ]
]
].
- "/
- "/ for illegal sequence, return 2nd key
- "/
-"/ key1 print. ' ' print. key2 printNL.
- ^ key2
+!
+
+flushKeyboard
+ "ST-80 compatibility: throw away all pending keyboard events"
+
+ self flushKeyboardFor:nil
+!
+
+flushKeyboardFor:aView
+ "throw away all pending keyboard events for aView,
+ or any view, if the argument is nil."
+
+ |nEvent "{ Class: SmallInteger }"|
+
+ mouseAndKeyboard notNil ifTrue:[
+ nEvent := mouseAndKeyboard size.
+ 1 to:nEvent do:[:i |
+ |anEvent|
+
+ anEvent := mouseAndKeyboard at:i.
+ (anEvent notNil and:[anEvent isKeyEvent]) ifTrue:[
+ (aView isNil or:[anEvent view == aView]) ifTrue:[
+ mouseAndKeyboard at:i put:nil
+ ]
+ ]
+ ]
+ ].
+!
+
+flushUserEvents
+ "throw away all pending user events"
+
+ (mouseAndKeyboard isNil or:[mouseAndKeyboard size > 0]) ifTrue:[
+ mouseAndKeyboard := OrderedCollection new
+ ].
+!
+
+flushUserEventsFor:aView
+ "throw away all pending user events for aView,
+ or any view, if the argument is nil."
+
+ |nEvent "{ Class: SmallInteger }"|
+
+ mouseAndKeyboard notNil ifTrue:[
+ nEvent := mouseAndKeyboard size.
+ 1 to:nEvent do:[:i |
+ |anEvent|
+
+ anEvent := mouseAndKeyboard at:i.
+ anEvent notNil ifTrue:[
+ (aView isNil or:[anEvent view == aView]) ifTrue:[
+ mouseAndKeyboard at:i put:nil
+ ]
+ ]
+ ]
+ ].
! !
!WindowSensor methodsFor:'event processing'!
-notifyEventArrival
- "an event arrived - if there is an eventSemaphore,
- signal it, to wake up any windowGroup process"
-
- catchExpose == true ifTrue:[
- "
- dont wake up, if we are currently waiting for an expose
- but remember arrival of something.
- "
- gotOtherEvent := true.
- ^ self
- ].
- eventSemaphore notNil ifTrue:[
- eventSemaphore signal
- ]
-!
-
button:button inView:aView state:onOrOff
"update the state of the xxxButtonDown flags"
@@ -465,23 +560,6 @@
].
!
-noExposeView:aView
- "an noexpose event arrived - this is sent from the device (Display)"
-
- gotExpose := true.
- exposeEventSemaphore notNil ifTrue:[
- exposeEventSemaphore signal
- ]
-!
-
-exposeX:left y:top width:width height:height view:aView
- "an expose event arrived - this is sent from the device (Display)"
-
- (self addDamage:(Rectangle left:left top:top width:width height:height) view:aView) ifTrue:[
- self notifyEventArrival
- ]
-!
-
buttonMotion:state x:x y:y view:aView
"mouse was moved - this is sent from the device (Display)"
@@ -522,44 +600,24 @@
self notifyEventArrival
!
-pointerLeave:state view:aView
- "mouse cursor was moved out of the view - this is sent from the device (Display)"
+buttonMultiPress:button x:x y:y view:aView
+ "mouse button was pressed - this is sent from the device (Display)"
EventListener notNil ifTrue:[
- (EventListener pointerLeave:state view:aView) ifTrue:[^ self]
+ (EventListener buttonMultiPress:button x:x y:y view:aView) ifTrue:[^ self]
].
eventListener notNil ifTrue:[
- (eventListener pointerLeave:state view:aView) ifTrue:[^ self]
- ].
-
- mouseAndKeyboard
- addLast:(WindowEvent
- for:aView
- type:#pointerLeave:
- arguments:(Array with:state)).
- self notifyEventArrival
-!
-
-buttonRelease:button x:x y:y view:aView
- "mouse button was released- this is sent from the device (Display)"
-
- self button:button inView:aView state:false.
-
- EventListener notNil ifTrue:[
- (EventListener buttonRelease:button x:x y:y view:aView) ifTrue:[^ self]
- ].
- eventListener notNil ifTrue:[
- (eventListener buttonRelease:button x:x y:y view:aView) ifTrue:[^ self]
+ (eventListener buttonMultiPress:button x:x y:y view:aView) ifTrue:[^ self]
].
ignoreUserInput == true ifTrue:[
^ self
].
mouseAndKeyboard
- addLast:(WindowEvent
- for:aView
- type:#buttonRelease:x:y:
- arguments:(Array with:button with:x with:y)).
+ addLast:(WindowEvent
+ for:aView
+ type:#buttonMultiPress:x:y:
+ arguments:(Array with:button with:x with:y)).
self notifyEventArrival
!
@@ -586,10 +644,94 @@
self notifyEventArrival
!
-graphicExposeX:left y:top width:width height:height view:aView
- "a graphic expose event arrived - this is sent from the device (Display)"
+buttonRelease:button x:x y:y view:aView
+ "mouse button was released- this is sent from the device (Display)"
+
+ self button:button inView:aView state:false.
+
+ EventListener notNil ifTrue:[
+ (EventListener buttonRelease:button x:x y:y view:aView) ifTrue:[^ self]
+ ].
+ eventListener notNil ifTrue:[
+ (eventListener buttonRelease:button x:x y:y view:aView) ifTrue:[^ self]
+ ].
+
+ ignoreUserInput == true ifTrue:[
+ ^ self
+ ].
+ mouseAndKeyboard
+ addLast:(WindowEvent
+ for:aView
+ type:#buttonRelease:x:y:
+ arguments:(Array with:button with:x with:y)).
+ self notifyEventArrival
+!
+
+buttonShiftPress:button x:x y:y view:aView
+ "mouse button was pressed - this is sent from the device (Display)"
+
+ self button:button inView:aView state:true.
+
+ EventListener notNil ifTrue:[
+ (EventListener buttonShiftPress:button x:x y:y view:aView) ifTrue:[^ self]
+ ].
+ eventListener notNil ifTrue:[
+ (eventListener buttonShiftPress:button x:x y:y view:aView) ifTrue:[^ self]
+ ].
- self addDamage:(left @ top extent:width @ height) view:aView.
+ ignoreUserInput == true ifTrue:[
+ ^ self
+ ].
+ mouseAndKeyboard
+ addLast:(WindowEvent
+ for:aView
+ type:#buttonShiftPress:x:y:
+ arguments:(Array with:button with:x with:y)).
+ self notifyEventArrival
+!
+
+configureX:x y:y width:w height:h view:aView
+ "a views size or position has changed - this is sent from the device (Display)"
+
+ damage
+ addLast:(WindowEvent
+ for:aView
+ type:#configureX:y:width:height:
+ arguments:(Array with:x with:y with:w with:h)).
+ self notifyEventArrival
+!
+
+coveredBy:sibling view:aView
+ "aView was covered by one of its siblings - this is sent from the device (Display)"
+
+ damage
+ addLast:(WindowEvent
+ for:aView
+ type:#coveredBy:
+ arguments:(Array with:sibling)).
+ self notifyEventArrival
+!
+
+destroyedView:aView
+ "view was destroyed (from window manager) - this is sent from the device (Display)"
+
+ "at this time, the view is already gone; remove
+ all pending events for this one ..."
+
+ self flushEventsFor:aView.
+ damage
+ addLast:(WindowEvent
+ for:aView
+ type:#destroyed).
+ self notifyEventArrival
+!
+
+exposeX:left y:top width:width height:height view:aView
+ "an expose event arrived - this is sent from the device (Display)"
+
+ (self addDamage:(Rectangle left:left top:top width:width height:height) view:aView) ifTrue:[
+ self notifyEventArrival
+ ]
!
focusInView:aView
@@ -602,53 +744,20 @@
self notifyEventArrival
!
-pointerEnter:state x:x y:y view:aView
- "mouse cursor was moved into the view - this is sent from the device (Display)"
-
- EventListener notNil ifTrue:[
- (EventListener pointerEnter:state x:x y:y view:aView) ifTrue:[^ self]
- ].
- eventListener notNil ifTrue:[
- (eventListener pointerEnter:state x:x y:y view:aView) ifTrue:[^ self]
- ].
+focusOutView:aView
+ "view lost input focus - this is sent from the device (Display)"
mouseAndKeyboard
- addLast:(WindowEvent
- for:aView
- type:#pointerEnter:x:y:
- arguments:(Array with:state with:x with:y)).
+ addLast:(WindowEvent
+ for:aView
+ type:#focusOut).
self notifyEventArrival
!
-buttonMultiPress:button x:x y:y view:aView
- "mouse button was pressed - this is sent from the device (Display)"
-
- EventListener notNil ifTrue:[
- (EventListener buttonMultiPress:button x:x y:y view:aView) ifTrue:[^ self]
- ].
- eventListener notNil ifTrue:[
- (eventListener buttonMultiPress:button x:x y:y view:aView) ifTrue:[^ self]
- ].
+graphicExposeX:left y:top width:width height:height view:aView
+ "a graphic expose event arrived - this is sent from the device (Display)"
- ignoreUserInput == true ifTrue:[
- ^ self
- ].
- mouseAndKeyboard
- addLast:(WindowEvent
- for:aView
- type:#buttonMultiPress:x:y:
- arguments:(Array with:button with:x with:y)).
- self notifyEventArrival
-!
-
-mappedView:aView
- "view was mapped (from window manager) - this is sent from the device (Display)"
-
- damage
- addLast:(WindowEvent
- for:aView
- type:#mapped).
- self notifyEventArrival
+ self addDamage:(left @ top extent:width @ height) view:aView.
!
keyPress:key x:x y:y view:aView
@@ -745,71 +854,6 @@
self notifyEventArrival
!
-coveredBy:sibling view:aView
- "aView was covered by one of its siblings - this is sent from the device (Display)"
-
- damage
- addLast:(WindowEvent
- for:aView
- type:#coveredBy:
- arguments:(Array with:sibling)).
- self notifyEventArrival
-!
-
-configureX:x y:y width:w height:h view:aView
- "a views size or position has changed - this is sent from the device (Display)"
-
- damage
- addLast:(WindowEvent
- for:aView
- type:#configureX:y:width:height:
- arguments:(Array with:x with:y with:w with:h)).
- self notifyEventArrival
-!
-
-unmappedView:aView
- "view was unmapped (from window manager) - this is sent from the device (Display)"
-
- damage
- addLast:(WindowEvent
- for:aView
- type:#unmapped).
- self notifyEventArrival
-!
-
-focusOutView:aView
- "view lost input focus - this is sent from the device (Display)"
-
- mouseAndKeyboard
- addLast:(WindowEvent
- for:aView
- type:#focusOut).
- self notifyEventArrival
-!
-
-buttonShiftPress:button x:x y:y view:aView
- "mouse button was pressed - this is sent from the device (Display)"
-
- self button:button inView:aView state:true.
-
- EventListener notNil ifTrue:[
- (EventListener buttonShiftPress:button x:x y:y view:aView) ifTrue:[^ self]
- ].
- eventListener notNil ifTrue:[
- (eventListener buttonShiftPress:button x:x y:y view:aView) ifTrue:[^ self]
- ].
-
- ignoreUserInput == true ifTrue:[
- ^ self
- ].
- mouseAndKeyboard
- addLast:(WindowEvent
- for:aView
- type:#buttonShiftPress:x:y:
- arguments:(Array with:button with:x with:y)).
- self notifyEventArrival
-!
-
keyRelease:key x:x y:y view:aView
"key was released - this is sent from the device (Display)."
@@ -845,14 +889,75 @@
self notifyEventArrival
!
-terminateView:aView
- "view should terminate (from window manager) - this is sent from the device (Display)"
+mappedView:aView
+ "view was mapped (from window manager) - this is sent from the device (Display)"
- self flushEventsFor:aView.
damage
addLast:(WindowEvent
for:aView
- type:#terminate).
+ type:#mapped).
+ self notifyEventArrival
+!
+
+noExposeView:aView
+ "an noexpose event arrived - this is sent from the device (Display)"
+
+ gotExpose := true.
+ exposeEventSemaphore notNil ifTrue:[
+ exposeEventSemaphore signal
+ ]
+!
+
+notifyEventArrival
+ "an event arrived - if there is an eventSemaphore,
+ signal it, to wake up any windowGroup process"
+
+ catchExpose == true ifTrue:[
+ "
+ dont wake up, if we are currently waiting for an expose
+ but remember arrival of something.
+ "
+ gotOtherEvent := true.
+ ^ self
+ ].
+ eventSemaphore notNil ifTrue:[
+ eventSemaphore signal
+ ]
+!
+
+pointerEnter:state x:x y:y view:aView
+ "mouse cursor was moved into the view - this is sent from the device (Display)"
+
+ EventListener notNil ifTrue:[
+ (EventListener pointerEnter:state x:x y:y view:aView) ifTrue:[^ self]
+ ].
+ eventListener notNil ifTrue:[
+ (eventListener pointerEnter:state x:x y:y view:aView) ifTrue:[^ self]
+ ].
+
+ mouseAndKeyboard
+ addLast:(WindowEvent
+ for:aView
+ type:#pointerEnter:x:y:
+ arguments:(Array with:state with:x with:y)).
+ self notifyEventArrival
+!
+
+pointerLeave:state view:aView
+ "mouse cursor was moved out of the view - this is sent from the device (Display)"
+
+ EventListener notNil ifTrue:[
+ (EventListener pointerLeave:state view:aView) ifTrue:[^ self]
+ ].
+ eventListener notNil ifTrue:[
+ (eventListener pointerLeave:state view:aView) ifTrue:[^ self]
+ ].
+
+ mouseAndKeyboard
+ addLast:(WindowEvent
+ for:aView
+ type:#pointerLeave:
+ arguments:(Array with:state)).
self notifyEventArrival
!
@@ -867,58 +972,29 @@
self notifyEventArrival
!
-destroyedView:aView
- "view was destroyed (from window manager) - this is sent from the device (Display)"
-
- "at this time, the view is already gone; remove
- all pending events for this one ..."
+terminateView:aView
+ "view should terminate (from window manager) - this is sent from the device (Display)"
self flushEventsFor:aView.
damage
addLast:(WindowEvent
for:aView
- type:#destroyed).
+ type:#terminate).
+ self notifyEventArrival
+!
+
+unmappedView:aView
+ "view was unmapped (from window manager) - this is sent from the device (Display)"
+
+ damage
+ addLast:(WindowEvent
+ for:aView
+ type:#unmapped).
self notifyEventArrival
! !
!WindowSensor methodsFor:'event queue'!
-nextDamage
- "retrieve the next damage rectangle or nil, if there is none.
- Remove it from the queue."
-
- |d wasBlocked|
-
- [d isNil] whileTrue:[
- damage size == 0 ifTrue:[^ nil].
- "
- be careful: events are inserted at higher prio ...
- "
- wasBlocked := OperatingSystem blockInterrupts.
- d := damage removeFirst.
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ].
- ^ d
-!
-
-nextEvent
- "retrieve the next event or nil, if there is none.
- Remove it from the queue."
-
- |e wasBlocked|
-
- [e isNil] whileTrue:[
- mouseAndKeyboard size == 0 ifTrue:[^ nil].
- "
- be careful: events are inserted at higher prio ...
- "
- wasBlocked := OperatingSystem blockInterrupts.
- e := mouseAndKeyboard removeFirst.
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ].
- ^ e
-!
-
addDamage:aRectangle view:aView
"Add aRectangle to the damage list.
Try to merge incoming rectangles with the existing damage rectangles.
@@ -1063,6 +1139,42 @@
^ true
!
+nextDamage
+ "retrieve the next damage rectangle or nil, if there is none.
+ Remove it from the queue."
+
+ |d wasBlocked|
+
+ [d isNil] whileTrue:[
+ damage size == 0 ifTrue:[^ nil].
+ "
+ be careful: events are inserted at higher prio ...
+ "
+ wasBlocked := OperatingSystem blockInterrupts.
+ d := damage removeFirst.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ].
+ ^ d
+!
+
+nextEvent
+ "retrieve the next event or nil, if there is none.
+ Remove it from the queue."
+
+ |e wasBlocked|
+
+ [e isNil] whileTrue:[
+ mouseAndKeyboard size == 0 ifTrue:[^ nil].
+ "
+ be careful: events are inserted at higher prio ...
+ "
+ wasBlocked := OperatingSystem blockInterrupts.
+ e := mouseAndKeyboard removeFirst.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ].
+ ^ e
+!
+
pendingEvent
"retrieve the next pending user (i.e. non-damage) event.
Return nil, if there is none pending.
@@ -1082,12 +1194,262 @@
^ e
! !
+!WindowSensor methodsFor:'event simulation'!
+
+forwardKeyEventsTo:aView
+ "remove all keyboard events and send them to aViews sensor instead"
+
+"/ 'fwd' printNL.
+ 1 to:mouseAndKeyboard size do:[:i |
+ |anEvent|
+
+ anEvent := mouseAndKeyboard at:i.
+ anEvent notNil ifTrue:[
+ anEvent isKeyEvent ifTrue:[
+ anEvent view:aView.
+ aView sensor pushEvent:anEvent.
+"/ anEvent type printNL.
+ mouseAndKeyboard at:i put:nil
+ ]
+ ]
+ ].
+!
+
+pushEvent:anEvent
+ "manually put an event into the queue - this allows
+ simulation of events (implementation of recorders & playback)
+ or asynchronous communication between view applications."
+
+ mouseAndKeyboard addLast:anEvent.
+ self notifyEventArrival
+
+ "Created: 18.9.1995 / 22:37:57 / claus"
+!
+
+pushUserEvent:aSelector for:aView
+ "manually put an event into the queue - this allows
+ simulation of events (implementation of recorders & playback)
+ or asynchronous communication between view applications.
+ The view will perform a method as specified by aSelector,
+ when it performs event processing; this is different than sending
+ this message directly, since the execution is done by the views process,
+ not by the current process (which is especially worthwhile, if that method
+ shows a modal box or similar)."
+
+ self pushUserEvent:aSelector for:aView withArguments:#()
+
+ "Modified: 18.9.1995 / 22:40:12 / claus"
+!
+
+pushUserEvent:aSelector for:aView withArguments:arguments
+ "manually put an event into the queue - this allows
+ simulation of events (implementation of recorders & playback)
+ or asynchronous communication between view applications.
+ The view will perform a method as specified by aSelector,
+ when it performs event processing; this is different than sending
+ this message directly, since the execution is done by the views process,
+ not by the current process (which is especially worthwhile, if that method
+ shows a modal box or similar)."
+
+ self pushEvent:(WindowEvent
+ for:aView
+ type:aSelector
+ arguments:arguments).
+
+ "
+ |b|
+ b := Button label:'test'.
+ b open.
+ (Delay forSeconds:5) wait.
+ b sensor pushEvent:#pointerEnter:x:y: for:b withArguments:#(0 1 1).
+ (Delay forSeconds:1) wait.
+ b sensor pushEvent:#buttonPress:x:y: for:b withArguments:#(1 1 1).
+ (Delay forSeconds:2) wait.
+ b sensor pushEvent:#buttonRelease:x:y: for:b withArguments:#(1 1 1).
+ (Delay forSeconds:1) wait.
+ b sensor pushEvent:#pointerLeave: for:b withArguments:#(0).
+ "
+! !
+
+!WindowSensor methodsFor:'initialization'!
+
+initialize
+ "initialize the event queues to empty"
+
+ damage := OrderedCollection new.
+ mouseAndKeyboard := OrderedCollection new.
+ gotExpose := true.
+ catchExpose := false.
+
+ compressMotionEvents := translateKeyboardEvents := true.
+ ignoreUserInput := false.
+ shiftDown := ctrlDown := altDown := metaDown := false.
+ leftButtonDown := middleButtonDown := rightButtonDown := false.
+!
+
+reinitialize
+ "called when an image is restarted;
+ reinitialize the event queues to empty; leave other setup as-is"
+
+ self flushUserEvents.
+ self flushExposeEvents.
+ gotExpose := true.
+ catchExpose := false.
+ shiftDown := ctrlDown := altDown := metaDown := false.
+ leftButtonDown := middleButtonDown := rightButtonDown := false.
+! !
+
+!WindowSensor methodsFor:'private'!
+
+compose:key1 with:key2
+ "compose a 2-character sequence into a composed key"
+
+ ComposeTable do:[:entry |
+ |v|
+
+ ((key1 == (entry at:1)) and:[key2 == (entry at:2)]) ifTrue:[
+ v := entry at:3.
+ v isCharacter ifFalse:[v := Character value:v].
+ ^ v
+ ]
+ ].
+ "/
+ "/ for illegal sequence, return 2nd key
+ "/
+"/ key1 print. ' ' print. key2 printNL.
+ ^ key2
+!
+
+isModifierKey:key
+ (key == #Shift
+ or:[key == #'Shift_R'
+ or:[key == #'Shift_L']]) ifTrue:[
+ ^ true
+ ].
+ (key == #Alt
+ or:[key == #'Alt_R' or:[key == #'Alt_L']]) ifTrue:[
+ ^ true
+ ].
+ (key == #Meta
+ or:[key == #'Meta_R' or:[key == #'Meta_L']]) ifTrue:[
+ ^ true
+ ].
+ (key == #Control
+ or:[key == #'Control_R' or:[key == #'Control_L']]) ifTrue:[
+ ^ true
+ ].
+ ^ false
+!
+
+key:key state:onOrOff
+ "update the state of the shiftDown/metaDown and ctrlDown
+ flags"
+
+ (key == #Shift
+ or:[key == #'Shift_R'
+ or:[key == #'Shift_L']]) ifTrue:[
+ shiftDown := onOrOff.
+ ^ self
+ ].
+ (key == #Alt
+ or:[key == #'Alt_R' or:[key == #'Alt_L']]) ifTrue:[
+ altDown := onOrOff.
+ ^ self
+ ].
+ (key == #Meta
+ or:[key == #'Meta_R' or:[key == #'Meta_L']]) ifTrue:[
+ metaDown := onOrOff.
+ ^ self
+ ].
+ (key == #Control
+ or:[key == #'Control_R' or:[key == #'Control_L']]) ifTrue:[
+ ctrlDown := onOrOff.
+ ^ self
+ ].
+! !
+
!WindowSensor methodsFor:'queries '!
-hasEvents
- "return true, if any mouse/keyboard events are pending"
+altDown
+ "return true, if the meta key is currently pressed.
+ Notice, that some keyboards dont have an alt key;
+ it is better to use 'sensor metaDown or:[sensor altDown]'."
+
+ ^ altDown
+!
+
+anyButtonPressed
+ "ST-80 compatibility: return true, if any mouse button is pressed.
+ You should no use it in 'normal' applications.
+ Instead, keep track of the buttons state in your views or controllers
+ button-event methods."
+
+ ^ rightButtonDown or:[middleButtonDown or:[rightButtonDown]]
+!
+
+blueButtonPressed
+ "ST-80 compatibility: return true, if the right mouse button is pressed.
+ You should no use it in 'normal' applications.
+ Instead, keep track of the buttons state in your views or controllers
+ button-event methods."
+
+ ^ rightButtonDown
+!
+
+ctrlDown
+ "return true, if any CTRL key is currently pressed."
+
+ ^ ctrlDown
+!
+
+cursorPoint
+ "ST-80 compatibility:
+ return the position of the mouse pointer on the current display
+ (in screen coordinates)"
+
+ ^ self class cursorPoint
+!
- ^ mouseAndKeyboard size ~~ 0
+eventPending
+ "return true, if either damage or events are pending"
+
+ mouseAndKeyboard size ~~ 0 ifTrue:[^ true].
+ ^ damage size ~~ 0
+!
+
+globalOrigin
+ "ST-80 compatibility:
+ dont know what we should return here ...
+ ... at least the PD program which uses it works when we return 0@0."
+
+ ^ 0@0
+!
+
+hasButtonMotionEventsFor:aView
+ "return true, if any buttonMotion events are pending.
+ If the argument, aView is nil, the information is regarding any
+ view (i.e. is there a motion event for any of my views);
+ otherwise, the information is regrding that specific view."
+
+ ^ self hasEvent:#buttonMotion:x:y: orPendingDeviceEvent:#buttonMotion for:aView
+!
+
+hasButtonPressEventFor:aView
+ "return true, if any buttonPress events are pending.
+ If the argument, aView is nil, the information is regarding any
+ view (i.e. is there a motion event for any of my views);
+ otherwise, the information is regrding that specific view."
+
+ ^ self hasEvent:#buttonPress:x:y: orPendingDeviceEvent:#buttonPress for:aView
+!
+
+hasButtonReleaseEventFor:aView
+ "return true, if any buttonRelease events are pending.
+ If the argument, aView is nil, the information is regarding any
+ view (i.e. is there a motion event for any of my views);
+ otherwise, the information is regrding that specific view."
+
+ ^ self hasEvent:#buttonRelease:x:y: orPendingDeviceEvent:#buttonRelease for:aView
!
hasDamage
@@ -1131,90 +1493,10 @@
^ false
!
-hasButtonMotionEventsFor:aView
- "return true, if any buttonMotion events are pending.
- If the argument, aView is nil, the information is regarding any
- view (i.e. is there a motion event for any of my views);
- otherwise, the information is regrding that specific view."
-
- ^ self hasEvent:#buttonMotion:x:y: orPendingDeviceEvent:#buttonMotion for:aView
-!
-
-hasButtonReleaseEventFor:aView
- "return true, if any buttonRelease events are pending.
- If the argument, aView is nil, the information is regarding any
- view (i.e. is there a motion event for any of my views);
- otherwise, the information is regrding that specific view."
-
- ^ self hasEvent:#buttonRelease:x:y: orPendingDeviceEvent:#buttonRelease for:aView
-!
-
-hasButtonPressEventFor:aView
- "return true, if any buttonPress events are pending.
- If the argument, aView is nil, the information is regarding any
- view (i.e. is there a motion event for any of my views);
- otherwise, the information is regrding that specific view."
-
- ^ self hasEvent:#buttonPress:x:y: orPendingDeviceEvent:#buttonPress for:aView
-!
-
-eventPending
- "return true, if either damage or events are pending"
-
- mouseAndKeyboard size ~~ 0 ifTrue:[^ true].
- ^ damage size ~~ 0
-!
-
-mousePoint
- "ST-80 compatibility:
- return the position of the mouse pointer on the current display
- (in screen coordinates)"
-
- ^ self cursorPoint
-!
+hasEvents
+ "return true, if any mouse/keyboard events are pending"
-cursorPoint
- "ST-80 compatibility:
- return the position of the mouse pointer on the current display
- (in screen coordinates)"
-
- ^ self class cursorPoint
-!
-
-globalOrigin
- "ST-80 compatibility:
- dont know what we should return here ...
- ... at least the PD program which uses it works when we return 0@0."
-
- ^ 0@0
-!
-
-shiftDown
- "return true, if any shift key is currently pressed."
-
- ^ shiftDown
-!
-
-ctrlDown
- "return true, if any CTRL key is currently pressed."
-
- ^ ctrlDown
-!
-
-metaDown
- "return true, if the meta key is currently pressed.
- Notice, that most keyboards dont have a meta key;
- it is better to use 'sensor metaDown or:[sensor altDown]'."
-
- ^ metaDown
-!
-
-altDown
- "return true, if the meta key is currently pressed.
- Notice, that some keyboards dont have an alt key;
- it is better to use 'sensor metaDown or:[sensor altDown]'."
-
- ^ altDown
+ ^ mouseAndKeyboard size ~~ 0
!
leftButtonPressed
@@ -1227,6 +1509,14 @@
^ leftButtonDown
!
+metaDown
+ "return true, if the meta key is currently pressed.
+ Notice, that most keyboards dont have a meta key;
+ it is better to use 'sensor metaDown or:[sensor altDown]'."
+
+ ^ metaDown
+!
+
middleButtonPressed
"return true, if the middle mouse button is pressed.
This has been added to support ST-80 style button polling;
@@ -1237,6 +1527,23 @@
^ middleButtonDown
!
+mousePoint
+ "ST-80 compatibility:
+ return the position of the mouse pointer on the current display
+ (in screen coordinates)"
+
+ ^ self cursorPoint
+!
+
+redButtonPressed
+ "ST-80 compatibility: return true, if the left mouse button is pressed.
+ You should no use it in 'normal' applications.
+ Instead, keep track of the buttons state in your views or controllers
+ button-event methods."
+
+ ^ leftButtonDown
+!
+
rightButtonPressed
"return true, if the right mouse button is pressed.
This has been added to support ST-80 style button polling;
@@ -1247,13 +1554,10 @@
^ rightButtonDown
!
-redButtonPressed
- "ST-80 compatibility: return true, if the left mouse button is pressed.
- You should no use it in 'normal' applications.
- Instead, keep track of the buttons state in your views or controllers
- button-event methods."
+shiftDown
+ "return true, if any shift key is currently pressed."
- ^ leftButtonDown
+ ^ shiftDown
!
yellowButtonPressed
@@ -1263,24 +1567,6 @@
button-event methods."
^ middleButtonDown
-!
-
-blueButtonPressed
- "ST-80 compatibility: return true, if the right mouse button is pressed.
- You should no use it in 'normal' applications.
- Instead, keep track of the buttons state in your views or controllers
- button-event methods."
-
- ^ rightButtonDown
-!
-
-anyButtonPressed
- "ST-80 compatibility: return true, if any mouse button is pressed.
- You should no use it in 'normal' applications.
- Instead, keep track of the buttons state in your views or controllers
- button-event methods."
-
- ^ rightButtonDown or:[middleButtonDown or:[rightButtonDown]]
! !
!WindowSensor methodsFor:'special'!
@@ -1296,6 +1582,24 @@
exposeEventSemaphore := Semaphore new.
!
+waitButton
+ "ST-80 compatibility: wait until any mouse button is pressed.
+ Do not use this in your applications; polling the sensor is
+ bad style."
+
+ [self anyButtonPressed] whileFalse:[
+ (Delay forSeconds:0.01) wait.
+ ].
+
+"/ (leftButtonPressed
+"/ or:[middleButtonPressed
+"/ or:[rightButtonPressed]]) ifTrue:[^ self].
+"/
+"/ [self hasButtonPressEventFor:nil] whileFalse:[
+"/ (Delay forSeconds:0.01) wait.
+"/ ]
+!
+
waitForExposeFor:aView
"wait until a graphicsExpose or a noExpose arrives (after a bitblt).
This may be too X-specific, and things may change in this area
@@ -1349,24 +1653,6 @@
catchExpose := false
!
-waitButton
- "ST-80 compatibility: wait until any mouse button is pressed.
- Do not use this in your applications; polling the sensor is
- bad style."
-
- [self anyButtonPressed] whileFalse:[
- (Delay forSeconds:0.01) wait.
- ].
-
-"/ (leftButtonPressed
-"/ or:[middleButtonPressed
-"/ or:[rightButtonPressed]]) ifTrue:[^ self].
-"/
-"/ [self hasButtonPressEventFor:nil] whileFalse:[
-"/ (Delay forSeconds:0.01) wait.
-"/ ]
-!
-
waitNoButton
"ST-80 compatibility: wait until no mouse button is pressed.
Do not use this in your applications; polling the sensor is
@@ -1384,293 +1670,4 @@
"/ ]
! !
-!WindowSensor methodsFor:'event flushing'!
-
-flushUserEvents
- "throw away all pending user events"
-
- (mouseAndKeyboard isNil or:[mouseAndKeyboard size > 0]) ifTrue:[
- mouseAndKeyboard := OrderedCollection new
- ].
-!
-
-flushExposeEventsFor:aView
- "throw away all pending expose events for aView,
- or any view, if the argument is nil.
- This can be done after a full redraw
- (or in views, which are always doing full redraws -
- instead of drawing the clip-area only)"
-
- |nEvent "{ Class: SmallInteger }"|
-
- damage notNil ifTrue:[
- nEvent := damage size.
- 1 to:nEvent do:[:index |
- |aDamage|
-
- aDamage := damage at:index.
- aDamage notNil ifTrue:[
- (aView isNil or:[aDamage view == aView]) ifTrue:[
- damage at:index put:nil
- ]
- ]
- ]
- ].
-!
-
-flushUserEventsFor:aView
- "throw away all pending user events for aView,
- or any view, if the argument is nil."
-
- |nEvent "{ Class: SmallInteger }"|
-
- mouseAndKeyboard notNil ifTrue:[
- nEvent := mouseAndKeyboard size.
- 1 to:nEvent do:[:i |
- |anEvent|
-
- anEvent := mouseAndKeyboard at:i.
- anEvent notNil ifTrue:[
- (aView isNil or:[anEvent view == aView]) ifTrue:[
- mouseAndKeyboard at:i put:nil
- ]
- ]
- ]
- ].
-!
-
-flushKeyboardFor:aView
- "throw away all pending keyboard events for aView,
- or any view, if the argument is nil."
-
- |nEvent "{ Class: SmallInteger }"|
-
- mouseAndKeyboard notNil ifTrue:[
- nEvent := mouseAndKeyboard size.
- 1 to:nEvent do:[:i |
- |anEvent|
-
- anEvent := mouseAndKeyboard at:i.
- (anEvent notNil and:[anEvent isKeyEvent]) ifTrue:[
- (aView isNil or:[anEvent view == aView]) ifTrue:[
- mouseAndKeyboard at:i put:nil
- ]
- ]
- ]
- ].
-!
-
-flushEventsFor:aView
- "throw away all events for aView,
- or any view, if the argument is nil."
-
- self flushExposeEventsFor:aView.
- self flushUserEventsFor:aView.
-!
-
-flushExposeEvents
- "throw away all pending expose events; this
- can be done after a full redraw (or in views, which are
- doing full redraws anly)"
-
- (damage isNil or:[damage size > 0]) ifTrue:[
- damage := OrderedCollection new
- ].
-!
-
-flushKeyboard
- "ST-80 compatibility: throw away all pending keyboard events"
-
- self flushKeyboardFor:nil
-!
-
-compressKeyPressEventsWithKey:aKey
- "count and remove multiple pending keyPress events for the
- same key, aKey. This is currently used in TextViews to compress
- multiple cursorUp/cursorDown events and do the scroll in one
- operation. (to avoid run-after-cursor on slow displays)"
-
- |n ev|
-
- n := 0.
- ev := self pendingEvent.
- [ev notNil and:[ev isKeyPressEvent]] whileTrue:[
- ((ev arguments at:1) == aKey) ifTrue:[
- n := n + 1.
- self nextEvent.
- ev := self pendingEvent.
- ] ifFalse:[
- ev := nil
- ]
- ].
- ^ n
-! !
-
-!WindowSensor methodsFor:'event simulation'!
-
-pushEvent:anEvent
- "manually put an event into the queue - this allows
- simulation of events (implementation of recorders & playback)
- or asynchronous communication between view applications."
-
- mouseAndKeyboard addLast:anEvent.
- self notifyEventArrival
-
- "Created: 18.9.1995 / 22:37:57 / claus"
-!
-
-pushUserEvent:aSelector for:aView
- "manually put an event into the queue - this allows
- simulation of events (implementation of recorders & playback)
- or asynchronous communication between view applications.
- The view will perform a method as specified by aSelector,
- when it performs event processing; this is different than sending
- this message directly, since the execution is done by the views process,
- not by the current process (which is especially worthwhile, if that method
- shows a modal box or similar)."
-
- self pushUserEvent:aSelector for:aView withArguments:#()
-
- "Modified: 18.9.1995 / 22:40:12 / claus"
-!
-
-pushUserEvent:aSelector for:aView withArguments:arguments
- "manually put an event into the queue - this allows
- simulation of events (implementation of recorders & playback)
- or asynchronous communication between view applications.
- The view will perform a method as specified by aSelector,
- when it performs event processing; this is different than sending
- this message directly, since the execution is done by the views process,
- not by the current process (which is especially worthwhile, if that method
- shows a modal box or similar)."
-
- self pushEvent:(WindowEvent
- for:aView
- type:aSelector
- arguments:arguments).
-
- "
- |b|
- b := Button label:'test'.
- b open.
- (Delay forSeconds:5) wait.
- b sensor pushEvent:#pointerEnter:x:y: for:b withArguments:#(0 1 1).
- (Delay forSeconds:1) wait.
- b sensor pushEvent:#buttonPress:x:y: for:b withArguments:#(1 1 1).
- (Delay forSeconds:2) wait.
- b sensor pushEvent:#buttonRelease:x:y: for:b withArguments:#(1 1 1).
- (Delay forSeconds:1) wait.
- b sensor pushEvent:#pointerLeave: for:b withArguments:#(0).
- "
-!
-
-forwardKeyEventsTo:aView
- "remove all keyboard events and send them to aViews sensor instead"
-
-"/ 'fwd' printNL.
- 1 to:mouseAndKeyboard size do:[:i |
- |anEvent|
-
- anEvent := mouseAndKeyboard at:i.
- anEvent notNil ifTrue:[
- anEvent isKeyEvent ifTrue:[
- anEvent view:aView.
- aView sensor pushEvent:anEvent.
-"/ anEvent type printNL.
- mouseAndKeyboard at:i put:nil
- ]
- ]
- ].
-! !
-
-!WindowSensor methodsFor:'accessing'!
-
-eventSemaphore
- "return the semaphore used to signal event arrival"
-
- ^ eventSemaphore
-!
-
-eventSemaphore:aSemaphore
- "set the semaphore used to signal event arrival"
-
- eventSemaphore := aSemaphore
-!
-
-ignoreUserInput:aBoolean
- "turn on/off ignoring of Ctrl-C processing"
-
- ignoreUserInput := aBoolean
-!
-
-ignoreUserInput
- "return true, if Ctrl-C processing is currently turned off"
-
- ^ ignoreUserInput
-!
-
-compressMotionEvents:aBoolean
- "turn on/off motion event compression"
-
- compressMotionEvents := aBoolean
-!
-
-eventListener:aListener
- "set the eventListener
- - see documentation for what this can be used for"
-
- eventListener := aListener
-
-!
-
-eventListener
- "return the eventListener
- - see documentation for what this can be used for"
-
- ^ eventListener
-!
-
-keyboardListener
- "return the keyboardListener
- - see documentation for what this can be used for"
-
- ^ keyboardListener
-!
-
-keyboardListener:aListener
- "set the keyboardListener
- - see documentation for what this can be used for"
-
- keyboardListener := aListener
-
-! !
-
-!WindowSensor methodsFor:'initialization'!
-
-initialize
- "initialize the event queues to empty"
-
- damage := OrderedCollection new.
- mouseAndKeyboard := OrderedCollection new.
- gotExpose := true.
- catchExpose := false.
-
- compressMotionEvents := translateKeyboardEvents := true.
- ignoreUserInput := false.
- shiftDown := ctrlDown := altDown := metaDown := false.
- leftButtonDown := middleButtonDown := rightButtonDown := false.
-!
-
-reinitialize
- "called when an image is restarted;
- reinitialize the event queues to empty; leave other setup as-is"
-
- self flushUserEvents.
- self flushExposeEvents.
- gotExpose := true.
- catchExpose := false.
- shiftDown := ctrlDown := altDown := metaDown := false.
- leftButtonDown := middleButtonDown := rightButtonDown := false.
-! !
-
WindowSensor initialize!