.
--- a/Cursor.st Fri May 12 20:10:19 1995 +0200
+++ b/Cursor.st Tue May 16 19:17:11 1995 +0200
@@ -28,7 +28,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Cursor.st,v 1.16 1995-04-11 15:54:27 claus Exp $
+$Header: /cvs/stx/stx/libview/Cursor.st,v 1.17 1995-05-16 17:12:35 claus Exp $
'!
!Cursor class methodsFor:'documentation'!
@@ -49,13 +49,15 @@
version
"
-$Header: /cvs/stx/stx/libview/Cursor.st,v 1.16 1995-04-11 15:54:27 claus Exp $
+$Header: /cvs/stx/stx/libview/Cursor.st,v 1.17 1995-05-16 17:12:35 claus Exp $
"
!
documentation
"
I represents cursors in a device independent manner.
+ Normally, cursors are defined at view creation time,
+ via 'aView cursor:aCursor'.
Instance variables:
@@ -78,6 +80,132 @@
...
"
+!
+
+examples
+"
+ get a standard cursor:
+
+ Cursor wait
+ Cursor stop
+ Cursor normal
+
+ create a custom cursor:
+
+ Cursor extent:16@16
+ fromArray:#[ 2r00000000 2r00000000
+ 2r00000000 2r00000000
+ 2r00000000 2r00000000
+ 2r11111111 2r11111111
+ 2r11111111 2r11111111
+ 2r00000000 2r00000000
+ 2r00000000 2r00000000
+ 2r11111111 2r11111111
+ 2r11111111 2r11111111
+ 2r00000000 2r00000000
+ 2r00000000 2r00000000
+ 2r11111111 2r11111111
+ 2r11111111 2r11111111
+ 2r00000000 2r00000000
+ 2r00000000 2r00000000
+ 2r00000000 2r00000000]
+ offset:-8@-8
+
+ define a cursor for a view:
+
+ |v|
+
+ v := View new.
+ v cursor:Cursor stop.
+ v open.
+
+ with above custom cursor:
+
+ |v|
+
+ v := View new.
+ v cursor:(
+ Cursor extent:16@16
+ fromArray:#[ 2r00000000 2r00000000
+ 2r00000000 2r00000000
+ 2r00000000 2r00000000
+ 2r11111111 2r11111111
+ 2r11111111 2r11111111
+ 2r00000000 2r00000000
+ 2r00000000 2r00000000
+ 2r11111111 2r11111111
+ 2r11111111 2r11111111
+ 2r00000000 2r00000000
+ 2r00000000 2r00000000
+ 2r11111111 2r11111111
+ 2r11111111 2r11111111
+ 2r00000000 2r00000000
+ 2r00000000 2r00000000
+ 2r00000000 2r00000000]
+ offset:-8@-8).
+ v open.
+
+ with multiple views:
+
+ |v1 v2 top|
+
+ top := StandardSystemView new.
+ top extent:300@300.
+ v1 := View origin:0.0@0.0 corner:1.0@0.5 in:top.
+ v1 viewBackground:(Color grey:75).
+ v1 cursor:Cursor thumbsUp.
+ v2 := View origin:0.0@0.5 corner:1.0@1.0 in:top.
+ v2 viewBackground:(Color white).
+ v2 cursor:Cursor wait.
+ top open.
+
+
+ show a cursor in ALL ST/X views for a while:
+
+ Cursor wait
+ showWhile:[
+ (Delay forSeconds:5) wait
+ ]
+
+
+ show a cursor in a single view for a while:
+
+ |v1 v2 top|
+
+ top := StandardSystemView new.
+ top extent:300@300.
+ v1 := View origin:0.0@0.0 corner:1.0@0.5 in:top.
+ v1 viewBackground:(Color grey:75).
+ v2 := View origin:0.0@0.5 corner:1.0@1.0 in:top.
+ v2 viewBackground:(Color white).
+ top open.
+
+ v1 withCursor:Cursor wait
+ do:[
+ (Delay forSeconds:10) wait
+ ]
+
+
+ show a cursor in all views belonging to a windowGroup:
+ (have to wait until top is visible to access windowGroup)
+
+ |v1 v2 top|
+
+ top := StandardSystemView new.
+ top extent:300@300.
+ v1 := View origin:0.0@0.0 corner:1.0@0.5 in:top.
+ v1 viewBackground:(Color grey:75).
+ v2 := View origin:0.0@0.5 corner:1.0@1.0 in:top.
+ v2 viewBackground:(Color white).
+ top open.
+
+ [top shown] whileFalse:[Processor yield].
+ top windowGroup
+ withCursor:Cursor wait
+ do:[
+ (Delay forSeconds:10) wait
+ ]
+"
! !
!Cursor class methodsFor:'initialization'!
--- a/DevWorkst.st Fri May 12 20:10:19 1995 +0200
+++ b/DevWorkst.st Tue May 16 19:17:11 1995 +0200
@@ -35,7 +35,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/DevWorkst.st,v 1.34 1995-05-12 18:00:00 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/DevWorkst.st,v 1.35 1995-05-16 17:12:50 claus Exp $
'!
!DeviceWorkstation class methodsFor:'documentation'!
@@ -56,7 +56,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/DevWorkst.st,v 1.34 1995-05-12 18:00:00 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/DevWorkst.st,v 1.35 1995-05-16 17:12:50 claus Exp $
"
!
@@ -127,7 +127,7 @@
ButtonTranslation := #(1 2 3) "identity translation"
! !
-!DeviceWorkstation class methodsFor:'signal access'!
+!DeviceWorkstation class methodsFor:'Signal constants'!
deviceErrorSignal
"return the signal used for device error reporting"
@@ -279,30 +279,33 @@
^ self subclassResponsibility
!
-errorInterrupt:errorID
- "device-error interrupt.
- Handles errorInterrupts for #DisplayError specially,
- by looking if a signal handler for DeviceErrorSignal is present,
- and - if so raising the signal. If not handled, simply output a
- message and continue. Other errors are handled as usual."
+errorInterrupt
+ "DisplayError interrupt.
+ This is invoked via
+ XError->errorInterrupt:#DisplayError->registeredErrorInterruptHandlers
+
+ looks if a signal handler for DeviceErrorSignal is present,
+ and - if so raises the signal. If the signal not handled, simply output a
+ message and continue.
+ This allows for non disrupted error reporting OR to catch and
+ investigate errors as required."
|badId badResource msg|
- errorID == #DisplayError ifTrue:[
- badId := self resourceIdOfLastError.
- badId ~~ 0 ifTrue:[
- badResource := self resourceOfId:badId.
- ].
- msg := 'Display error: ' , (self lastErrorString).
- DeviceErrorSignal isHandled ifFalse:[
- msg printNL.
- ^ self
- ].
- ^ DeviceErrorSignal
+ badId := self resourceIdOfLastError.
+ badId ~~ 0 ifTrue:[
+ badResource := self resourceOfId:badId.
+ ].
+ msg := 'Display error: ' , (self lastErrorString).
+
+ DeviceErrorSignal isHandled ifFalse:[
+ msg errorPrintNL.
+ ^ self
+ ].
+
+ ^ DeviceErrorSignal
raiseRequestWith:badResource
errorString:msg
- ].
- ^ super errorInterrupt:errorID
!
resourceOfId:id
@@ -1177,13 +1180,25 @@
xlatedKey := untranslatedKey.
controlDown ifTrue:[
- xlatedKey := ('Ctrl' , xlatedKey asString) asSymbol
+ (untranslatedKey ~~ #Control
+ and:[untranslatedKey ~~ #'Control_L'
+ and:[untranslatedKey ~~ #'Control_R']]) ifTrue:[
+ xlatedKey := ('Ctrl' , xlatedKey asString) asSymbol
+ ]
].
metaDown ifTrue:[
- xlatedKey := ('Cmd' , xlatedKey asString) asSymbol
+ (untranslatedKey ~~ #Cmd
+ and:[untranslatedKey ~~ #'Cmd _L'
+ and:[untranslatedKey ~~ #'Cmd _R']]) ifTrue:[
+ xlatedKey := ('Cmd' , xlatedKey asString) asSymbol
+ ]
].
altDown ifTrue:[
- xlatedKey := ('Alt' , xlatedKey asString) asSymbol
+ (untranslatedKey ~~ #Alt
+ and:[untranslatedKey ~~ #'Alt_L'
+ and:[untranslatedKey ~~ #'Alt_R']]) ifTrue:[
+ xlatedKey := ('Alt' , xlatedKey asString) asSymbol
+ ]
].
xlatedKey := keyboardMap valueFor:xlatedKey.
--- a/DeviceWorkstation.st Fri May 12 20:10:19 1995 +0200
+++ b/DeviceWorkstation.st Tue May 16 19:17:11 1995 +0200
@@ -35,7 +35,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.34 1995-05-12 18:00:00 claus Exp $
+$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.35 1995-05-16 17:12:50 claus Exp $
'!
!DeviceWorkstation class methodsFor:'documentation'!
@@ -56,7 +56,7 @@
version
"
-$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.34 1995-05-12 18:00:00 claus Exp $
+$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.35 1995-05-16 17:12:50 claus Exp $
"
!
@@ -127,7 +127,7 @@
ButtonTranslation := #(1 2 3) "identity translation"
! !
-!DeviceWorkstation class methodsFor:'signal access'!
+!DeviceWorkstation class methodsFor:'Signal constants'!
deviceErrorSignal
"return the signal used for device error reporting"
@@ -279,30 +279,33 @@
^ self subclassResponsibility
!
-errorInterrupt:errorID
- "device-error interrupt.
- Handles errorInterrupts for #DisplayError specially,
- by looking if a signal handler for DeviceErrorSignal is present,
- and - if so raising the signal. If not handled, simply output a
- message and continue. Other errors are handled as usual."
+errorInterrupt
+ "DisplayError interrupt.
+ This is invoked via
+ XError->errorInterrupt:#DisplayError->registeredErrorInterruptHandlers
+
+ looks if a signal handler for DeviceErrorSignal is present,
+ and - if so raises the signal. If the signal not handled, simply output a
+ message and continue.
+ This allows for non disrupted error reporting OR to catch and
+ investigate errors as required."
|badId badResource msg|
- errorID == #DisplayError ifTrue:[
- badId := self resourceIdOfLastError.
- badId ~~ 0 ifTrue:[
- badResource := self resourceOfId:badId.
- ].
- msg := 'Display error: ' , (self lastErrorString).
- DeviceErrorSignal isHandled ifFalse:[
- msg printNL.
- ^ self
- ].
- ^ DeviceErrorSignal
+ badId := self resourceIdOfLastError.
+ badId ~~ 0 ifTrue:[
+ badResource := self resourceOfId:badId.
+ ].
+ msg := 'Display error: ' , (self lastErrorString).
+
+ DeviceErrorSignal isHandled ifFalse:[
+ msg errorPrintNL.
+ ^ self
+ ].
+
+ ^ DeviceErrorSignal
raiseRequestWith:badResource
errorString:msg
- ].
- ^ super errorInterrupt:errorID
!
resourceOfId:id
@@ -1177,13 +1180,25 @@
xlatedKey := untranslatedKey.
controlDown ifTrue:[
- xlatedKey := ('Ctrl' , xlatedKey asString) asSymbol
+ (untranslatedKey ~~ #Control
+ and:[untranslatedKey ~~ #'Control_L'
+ and:[untranslatedKey ~~ #'Control_R']]) ifTrue:[
+ xlatedKey := ('Ctrl' , xlatedKey asString) asSymbol
+ ]
].
metaDown ifTrue:[
- xlatedKey := ('Cmd' , xlatedKey asString) asSymbol
+ (untranslatedKey ~~ #Cmd
+ and:[untranslatedKey ~~ #'Cmd _L'
+ and:[untranslatedKey ~~ #'Cmd _R']]) ifTrue:[
+ xlatedKey := ('Cmd' , xlatedKey asString) asSymbol
+ ]
].
altDown ifTrue:[
- xlatedKey := ('Alt' , xlatedKey asString) asSymbol
+ (untranslatedKey ~~ #Alt
+ and:[untranslatedKey ~~ #'Alt_L'
+ and:[untranslatedKey ~~ #'Alt_R']]) ifTrue:[
+ xlatedKey := ('Alt' , xlatedKey asString) asSymbol
+ ]
].
xlatedKey := keyboardMap valueFor:xlatedKey.
--- a/Font.st Fri May 12 20:10:19 1995 +0200
+++ b/Font.st Tue May 16 19:17:11 1995 +0200
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Font.st,v 1.17 1995-03-31 02:55:26 claus Exp $
+$Header: /cvs/stx/stx/libview/Font.st,v 1.18 1995-05-16 17:12:57 claus Exp $
'!
!Font class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Font.st,v 1.17 1995-03-31 02:55:26 claus Exp $
+$Header: /cvs/stx/stx/libview/Font.st,v 1.18 1995-05-16 17:12:57 claus Exp $
"
!
@@ -310,19 +310,19 @@
|id f alternative|
- alternative := Replacements at:family.
+ alternative := Replacements at:family ifAbsent:nil.
alternative notNil ifTrue:[
id := aDevice getFontWithFamily:alternative
face:face
style:style
size:size
encoding:encoding.
- id notNil ifTrue:[
- ('replaced ' , family , '- with ' , alternative , '-font') print.
- ] ifFalse:[
- id := aDevice getDefaultFont.
- ('replaced ' , family , '- with default-font') print.
- ]
+ ].
+ id notNil ifTrue:[
+ ('replaced ' , family , '- with ' , alternative , '-font') print.
+ ] ifFalse:[
+ id := aDevice getDefaultFont.
+ ('replaced ' , family , '- with default-font') print.
].
id isNil ifTrue:[
"oops did not work - this is a serious an error"
--- a/Image.st Fri May 12 20:10:19 1995 +0200
+++ b/Image.st Tue May 16 19:17:11 1995 +0200
@@ -28,7 +28,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Image.st,v 1.30 1995-05-03 00:03:51 claus Exp $
+$Header: /cvs/stx/stx/libview/Image.st,v 1.31 1995-05-16 17:13:10 claus Exp $
'!
!Image class methodsFor:'documentation'!
@@ -49,7 +49,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Image.st,v 1.30 1995-05-03 00:03:51 claus Exp $
+$Header: /cvs/stx/stx/libview/Image.st,v 1.31 1995-05-16 17:13:10 claus Exp $
"
!
@@ -560,7 +560,7 @@
padding. This is stupid, and may be changed in ST/X with future versions.
"
dstRowBytes := img bytesPerRow.
- srcRowBytes := ((w * d + 31) bitShift:-5) bitShift:2.
+ srcRowBytes := ((w * d + padding - 1) bitShift:-5) bitShift:2.
newBits := ByteArray new:(dstRowBytes * h).
srcIndex := 1.
--- a/KeybdFwd.st Fri May 12 20:10:19 1995 +0200
+++ b/KeybdFwd.st Tue May 16 19:17:11 1995 +0200
@@ -24,14 +24,19 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/KeybdFwd.st,v 1.5 1995-05-12 18:00:26 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/KeybdFwd.st,v 1.6 1995-05-16 17:13:19 claus Exp $
"
!
documentation
"
- Instances of this class can be used as delegates to forward keyboard
- events to some object or other view (via aView delegate:).
+ Instances of this class can be used to forward keyboard
+ events to some object or other view (install them via aView delegate:).
+ Event delegation allows to add additional keyboard functions to views
+ WITHOUT modifying their code or changing controllers.
+ Also, it allows to catch certain individual keys to ignore them or
+ perform different functions.
+
Notice, that delegates dont have to be instances of
myself; any object with a protocol similar to mine can be used as
a delegate.
@@ -41,12 +46,17 @@
However, I provide the most common functions required for conditional
event delegation and instances of myself are for example used to forward
events from elements of some dialogBoxes to the enterfield/fieldGroup -
- this allows keyboard input to be forwarded to the active text-field even
- while the mouse pointer is somewhere else.
+ (which allows keyboard input to be forwarded to the active text-field even
+ while the mouse pointer is somewhere else)
Another application of delegation is to catch keyboard input to some standard
widget, optionally processing and resending the key-event.
+ I can either forward the key event to another view, or to some general
+ object - the difference is that views are sent a #keyXXX:x:y: message,
+ while general destinations get a #keyXXX:x:y:view: message, with the original
+ view (the one in which the event occurred) as additional argument.
+
Instance Variables:
destinationView <View> the view which shall receive
@@ -64,6 +74,79 @@
The #noFocus condition will only forward
events if no explicit focus has been
set in the windowGroup.
+
+ <Block> condition block - event is forwarded,
+ if it evaluates to true.
+ The block gets 3 arguments:
+ eventType #keyPress or #keyRelease
+ key the key
+ view the originating view
+
+ For more info on event handling/forwarding, see the documentation in
+ WindowSensor, WindowGroup and especially in WindowEvent.
+"
+!
+
+examples
+"
+ catch an enterfields input:
+
+ |top field forwarder catcher|
+
+ catcher := Plug new.
+ catcher respondTo:#keyPress:x:y:view:
+ with:[:key :x :y :view | Transcript showCr:'cought keyPress: ' , key printString.].
+ catcher respondTo:#keyRelease:x:y:view:
+ with:[:key :x :y :view | Transcript showCr:'cought keyRelease: ' , key printString.].
+
+ top := StandardSystemView new.
+ top extent:200@200.
+
+ field := EditField in:top.
+ field origin:0.0@0.0; width:1.0.
+
+ forwarder := KeyboardForwarder to:catcher.
+ field delegate:forwarder.
+
+ top open
+
+
+ catch an enterfields return-key only:
+
+ |top field forwarder catcher|
+
+ catcher := Plug new.
+ catcher respondTo:#keyPress:x:y:view:
+ with:[:key :x :y :view | Transcript showCr:'cought return'].
+
+ top := StandardSystemView new.
+ top extent:200@200.
+
+ field := EditField in:top.
+ field origin:0.0@0.0; width:1.0.
+
+ forwarder := KeyboardForwarder
+ to:catcher
+ condition:[:type :key :view | (type == #keyPress) & (key == #Return)].
+ field delegate:forwarder.
+
+ top open
+
+
+ catch all of an enterfields input and ignore it:
+
+ |top field forwarder|
+
+ top := StandardSystemView new.
+ top extent:200@200.
+
+ field := EditField in:top.
+ field origin:0.0@0.0; width:1.0.
+
+ forwarder := KeyboardForwarder to:nil.
+ field delegate:forwarder.
+
+ top open
"
!
@@ -124,55 +207,70 @@
^ self new destination:destination
!
-toView:destinationView condition:aConditionSymbol
+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
- occurred) but only, if some condition as specified by aConditionSymbol
+ occurred) but only, if some condition as specified by aCondition
is met. 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; condition:aConditionSymbol
+ ^ self new destinationView:destinationView; condition:aCondition
!
-to:destination condition:aConditionSymbol
+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 aConditionSymbol
+ 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:aConditionSymbol
+ ^ self new destination:destination; condition:aCondition
! !
-!KeyboardForwarder methodsFor:'private accessing'!
+!KeyboardForwarder methodsFor:'accessing'!
condition:aCondition
+ "set the condition - typically a block"
+
condition := aCondition
!
destinationView:aView
+ "set the destination view"
+
destinationView := aView
!
destinationView
+ "return the destination view"
+
^ destinationView
!
destination:anObject
+ "set the destination
+ - that one will get the event with an additional view arg."
+
destination := anObject
!
destination
+ "return the destination"
+
^ destination
!
sourceView:aView
+ "set the sourceView - if nonNil, only events from this view will be forwarded"
+
sourceView := aView
!
sourceView
+ "get the sourceView - if nonNil, only events from this view will be forwarded"
+
^ sourceView
! !
@@ -184,14 +282,13 @@
^ 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."
-
+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:[
@@ -200,20 +297,20 @@
^ true
!
+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."
- condition notNil ifTrue:[
- condition == #noFocus ifTrue:[
- aView windowGroup focusView notNil ifTrue:[^ false]
- ]
- ].
- sourceView notNil ifTrue:[
- ^ aView == sourceView
- ].
- ^ true
+ ^ self checkCondition:#keyRelease key:key view:aView
! !
!KeyboardForwarder methodsFor:'event forwarding'!
@@ -233,11 +330,12 @@
destination notNil ifTrue:[
destination keyPress:key x:-1 y:-1 view:aView.
] ifFalse:[
- WindowEvent
- sendEvent:#keyPress:x:y:
- arguments:(Array with:key with:-1 with:-1)
- view:destinationView
-"/ destinationView keyPress:key x:-1 y:-1
+ destinationView notNil ifTrue:[
+ WindowEvent
+ sendEvent:#keyPress:x:y:
+ arguments:(Array with:key with:-1 with:-1)
+ view:destinationView
+ ]
]
!
@@ -254,12 +352,13 @@
].
destination notNil ifTrue:[
- WindowEvent
- sendEvent:#keyRelease:x:y:
- arguments:(Array with:key with:-1 with:-1)
- view:destinationView
-"/ destinationView keyRelease:key x:-1 y:-1 view:aView
+ destination keyRelease:key x:-1 y:-1 view:aView
] ifFalse:[
- destinationView keyRelease:key x:-1 y:-1
+ destinationView notNil ifTrue:[
+ WindowEvent
+ sendEvent:#keyRelease:x:y:
+ arguments:(Array with:key with:-1 with:-1)
+ view:destinationView
+ ]
]
! !
--- a/KeyboardForwarder.st Fri May 12 20:10:19 1995 +0200
+++ b/KeyboardForwarder.st Tue May 16 19:17:11 1995 +0200
@@ -24,14 +24,19 @@
version
"
-$Header: /cvs/stx/stx/libview/KeyboardForwarder.st,v 1.5 1995-05-12 18:00:26 claus Exp $
+$Header: /cvs/stx/stx/libview/KeyboardForwarder.st,v 1.6 1995-05-16 17:13:19 claus Exp $
"
!
documentation
"
- Instances of this class can be used as delegates to forward keyboard
- events to some object or other view (via aView delegate:).
+ Instances of this class can be used to forward keyboard
+ events to some object or other view (install them via aView delegate:).
+ Event delegation allows to add additional keyboard functions to views
+ WITHOUT modifying their code or changing controllers.
+ Also, it allows to catch certain individual keys to ignore them or
+ perform different functions.
+
Notice, that delegates dont have to be instances of
myself; any object with a protocol similar to mine can be used as
a delegate.
@@ -41,12 +46,17 @@
However, I provide the most common functions required for conditional
event delegation and instances of myself are for example used to forward
events from elements of some dialogBoxes to the enterfield/fieldGroup -
- this allows keyboard input to be forwarded to the active text-field even
- while the mouse pointer is somewhere else.
+ (which allows keyboard input to be forwarded to the active text-field even
+ while the mouse pointer is somewhere else)
Another application of delegation is to catch keyboard input to some standard
widget, optionally processing and resending the key-event.
+ I can either forward the key event to another view, or to some general
+ object - the difference is that views are sent a #keyXXX:x:y: message,
+ while general destinations get a #keyXXX:x:y:view: message, with the original
+ view (the one in which the event occurred) as additional argument.
+
Instance Variables:
destinationView <View> the view which shall receive
@@ -64,6 +74,79 @@
The #noFocus condition will only forward
events if no explicit focus has been
set in the windowGroup.
+
+ <Block> condition block - event is forwarded,
+ if it evaluates to true.
+ The block gets 3 arguments:
+ eventType #keyPress or #keyRelease
+ key the key
+ view the originating view
+
+ For more info on event handling/forwarding, see the documentation in
+ WindowSensor, WindowGroup and especially in WindowEvent.
+"
+!
+
+examples
+"
+ catch an enterfields input:
+
+ |top field forwarder catcher|
+
+ catcher := Plug new.
+ catcher respondTo:#keyPress:x:y:view:
+ with:[:key :x :y :view | Transcript showCr:'cought keyPress: ' , key printString.].
+ catcher respondTo:#keyRelease:x:y:view:
+ with:[:key :x :y :view | Transcript showCr:'cought keyRelease: ' , key printString.].
+
+ top := StandardSystemView new.
+ top extent:200@200.
+
+ field := EditField in:top.
+ field origin:0.0@0.0; width:1.0.
+
+ forwarder := KeyboardForwarder to:catcher.
+ field delegate:forwarder.
+
+ top open
+
+
+ catch an enterfields return-key only:
+
+ |top field forwarder catcher|
+
+ catcher := Plug new.
+ catcher respondTo:#keyPress:x:y:view:
+ with:[:key :x :y :view | Transcript showCr:'cought return'].
+
+ top := StandardSystemView new.
+ top extent:200@200.
+
+ field := EditField in:top.
+ field origin:0.0@0.0; width:1.0.
+
+ forwarder := KeyboardForwarder
+ to:catcher
+ condition:[:type :key :view | (type == #keyPress) & (key == #Return)].
+ field delegate:forwarder.
+
+ top open
+
+
+ catch all of an enterfields input and ignore it:
+
+ |top field forwarder|
+
+ top := StandardSystemView new.
+ top extent:200@200.
+
+ field := EditField in:top.
+ field origin:0.0@0.0; width:1.0.
+
+ forwarder := KeyboardForwarder to:nil.
+ field delegate:forwarder.
+
+ top open
"
!
@@ -124,55 +207,70 @@
^ self new destination:destination
!
-toView:destinationView condition:aConditionSymbol
+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
- occurred) but only, if some condition as specified by aConditionSymbol
+ occurred) but only, if some condition as specified by aCondition
is met. 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; condition:aConditionSymbol
+ ^ self new destinationView:destinationView; condition:aCondition
!
-to:destination condition:aConditionSymbol
+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 aConditionSymbol
+ 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:aConditionSymbol
+ ^ self new destination:destination; condition:aCondition
! !
-!KeyboardForwarder methodsFor:'private accessing'!
+!KeyboardForwarder methodsFor:'accessing'!
condition:aCondition
+ "set the condition - typically a block"
+
condition := aCondition
!
destinationView:aView
+ "set the destination view"
+
destinationView := aView
!
destinationView
+ "return the destination view"
+
^ destinationView
!
destination:anObject
+ "set the destination
+ - that one will get the event with an additional view arg."
+
destination := anObject
!
destination
+ "return the destination"
+
^ destination
!
sourceView:aView
+ "set the sourceView - if nonNil, only events from this view will be forwarded"
+
sourceView := aView
!
sourceView
+ "get the sourceView - if nonNil, only events from this view will be forwarded"
+
^ sourceView
! !
@@ -184,14 +282,13 @@
^ 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."
-
+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:[
@@ -200,20 +297,20 @@
^ true
!
+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."
- condition notNil ifTrue:[
- condition == #noFocus ifTrue:[
- aView windowGroup focusView notNil ifTrue:[^ false]
- ]
- ].
- sourceView notNil ifTrue:[
- ^ aView == sourceView
- ].
- ^ true
+ ^ self checkCondition:#keyRelease key:key view:aView
! !
!KeyboardForwarder methodsFor:'event forwarding'!
@@ -233,11 +330,12 @@
destination notNil ifTrue:[
destination keyPress:key x:-1 y:-1 view:aView.
] ifFalse:[
- WindowEvent
- sendEvent:#keyPress:x:y:
- arguments:(Array with:key with:-1 with:-1)
- view:destinationView
-"/ destinationView keyPress:key x:-1 y:-1
+ destinationView notNil ifTrue:[
+ WindowEvent
+ sendEvent:#keyPress:x:y:
+ arguments:(Array with:key with:-1 with:-1)
+ view:destinationView
+ ]
]
!
@@ -254,12 +352,13 @@
].
destination notNil ifTrue:[
- WindowEvent
- sendEvent:#keyRelease:x:y:
- arguments:(Array with:key with:-1 with:-1)
- view:destinationView
-"/ destinationView keyRelease:key x:-1 y:-1 view:aView
+ destination keyRelease:key x:-1 y:-1 view:aView
] ifFalse:[
- destinationView keyRelease:key x:-1 y:-1
+ destinationView notNil ifTrue:[
+ WindowEvent
+ sendEvent:#keyRelease:x:y:
+ arguments:(Array with:key with:-1 with:-1)
+ view:destinationView
+ ]
]
! !
--- a/Make.proto Fri May 12 20:10:19 1995 +0200
+++ b/Make.proto Tue May 16 19:17:11 1995 +0200
@@ -1,4 +1,4 @@
-# $Header: /cvs/stx/stx/libview/Make.proto,v 1.29 1995-05-10 02:26:41 claus Exp $
+# $Header: /cvs/stx/stx/libview/Make.proto,v 1.30 1995-05-16 17:15:21 claus Exp $
#
# -------------- no need to change anything below ----------
@@ -87,6 +87,7 @@
Model.$(O) \
AppModel.$(O) \
ValModel.$(O) \
+ PlugAdptr.$(O) \
ValHolder.$(O) \
ProtAdptr.$(O) \
AspctAdptr.$(O) \
@@ -217,6 +218,7 @@
Model.$(O): Model.st $(OBJECT)
AppModel.$(O): AppModel.st $(MODEL)
ValModel.$(O): ValModel.st $(MODEL)
+PlugAdptr.$(O): PlugAdptr.st $(I)/ValModel.H $(I)/Model.H $(OBJECT)
ValHolder.$(O): ValHolder.st $(I)/ValModel.H $(I)/Model.H $(OBJECT)
ProtAdptr.$(O): ProtAdptr.st $(VALHOLDER)
AspctAdptr.$(O): AspctAdptr.st $(I)/ProtAdptr.H $(VALHOLDER)
--- a/ModalBox.st Fri May 12 20:10:19 1995 +0200
+++ b/ModalBox.st Tue May 16 19:17:11 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1990 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/ModalBox.st,v 1.23 1995-05-10 02:25:28 claus Exp $
+$Header: /cvs/stx/stx/libview/ModalBox.st,v 1.24 1995-05-16 17:13:24 claus Exp $
'!
!ModalBox class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/ModalBox.st,v 1.23 1995-05-10 02:25:28 claus Exp $
+$Header: /cvs/stx/stx/libview/ModalBox.st,v 1.24 1995-05-16 17:13:24 claus Exp $
"
!
@@ -86,8 +86,8 @@
UseTransientViews := aBoolean.
"
- ModalBox useTransient:false
- ModalBox useTransient:true
+ ModalBox useTransientViews:false
+ ModalBox useTransientViews:true
"
! !
@@ -105,8 +105,9 @@
label := 'Popup'.
UseTransientViews ifFalse:[
- (StyleSheet at:#popupShadow default:false) ifTrue:[
- shadowView := (ShadowView on:device) for:self
+"/ (StyleSheet at:#popupShadow default:false) ifTrue:[
+ PopUpView shadows ifTrue:[
+ shadowView := (ShadowView onDevice:device) for:self
].
form := Form width:8 height:8
--- a/PopUpView.st Fri May 12 20:10:19 1995 +0200
+++ b/PopUpView.st Tue May 16 19:17:11 1995 +0200
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/PopUpView.st,v 1.12 1995-05-10 02:25:39 claus Exp $
+$Header: /cvs/stx/stx/libview/PopUpView.st,v 1.13 1995-05-16 17:13:40 claus Exp $
'!
!PopUpView class methodsFor:'documentation'!
@@ -43,7 +43,7 @@
version
"
-$Header: /cvs/stx/stx/libview/PopUpView.st,v 1.12 1995-05-10 02:25:39 claus Exp $
+$Header: /cvs/stx/stx/libview/PopUpView.st,v 1.13 1995-05-16 17:13:40 claus Exp $
"
!
@@ -77,6 +77,21 @@
DefaultLevel := StyleSheet at:'popupLevel'.
DefaultBorderWidth := StyleSheet at:'popupBorderWidth'.
DefaultBorderColor := StyleSheet colorAt:'popupBorderColor'.
+!
+
+shadows:aBoolean
+ "turn on/off shadows under popUpViews.
+ On slow displays, turning them off makes menus appear a bit snappier.
+ The default is set via the styleSheet and changes when the viewStyle
+ is changed."
+
+ DefaultShadow := aBoolean
+!
+
+shadows
+ "return the shadows-flag. False means: turned off."
+
+ ^ DefaultShadow
! !
!PopUpView methodsFor:'initialize / release'!
--- a/ResourcePack.st Fri May 12 20:10:19 1995 +0200
+++ b/ResourcePack.st Tue May 16 19:17:11 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/ResourcePack.st,v 1.14 1995-05-03 00:25:14 claus Exp $
+$Header: /cvs/stx/stx/libview/ResourcePack.st,v 1.15 1995-05-16 17:13:52 claus Exp $
'!
!ResourcePack class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/ResourcePack.st,v 1.14 1995-05-03 00:25:14 claus Exp $
+$Header: /cvs/stx/stx/libview/ResourcePack.st,v 1.15 1995-05-16 17:13:52 claus Exp $
"
!
@@ -303,6 +303,58 @@
inStream close.
!
+processLine:aLine
+ |lineString name stream l rest macroName value|
+
+ lineString := lineString withoutSeparators.
+ name := nil.
+ (lineString at:1) == $' ifTrue:[
+ stream := ReadStream on:lineString.
+ name := String
+ readFrom:stream
+ onError:['RESOURCEPACK: invalid line <',lineString,'>' errorPrintNl. nil].
+ l := stream position.
+
+"/ l := lineString indexOf:$' startingAt:2.
+"/ l ~~ 0 ifTrue:[
+"/ name := (lineString copyFrom:2 to:l-1).
+"/ l := l + 1
+"/ ]
+ ] ifFalse:[
+ l := lineString indexOfSeparatorStartingAt:1.
+ l ~~ 0 ifTrue:[
+ name := lineString copyFrom:1 to:l-1.
+ ]
+ ].
+ name notNil ifTrue:[
+ rest := (lineString copyFrom:l) withoutSeparators.
+ "
+ skip <type> if present
+ "
+ (rest startsWith:$<) ifTrue:[
+ l := lineString indexOf:$> startingAt:l.
+ rest := (lineString copyFrom:l+1) withoutSeparators.
+ ].
+ (rest startsWith:$=) ifTrue:[
+ rest := rest copyFrom:2.
+ stream := ReadStream on:rest.
+ macroName := stream nextAlphaNumericWord.
+ rest := stream upToEnd.
+ value := self at:macroName.
+ value := Compiler evaluate:('self ' , rest)
+ receiver:value
+ notifying:nil
+ compile:false.
+ ] ifFalse:[
+ value := Compiler evaluate:rest compile:false.
+ (value == #Error) ifTrue:[
+ Transcript show:('error in resource:' , name).
+ ]
+ ].
+ self at:name put:value.
+ ]
+!
+
readFromResourceStream:inStream in:dirName
|lineString rest value ifLevel skipping l name first str macroName|
--- a/RsrcPack.st Fri May 12 20:10:19 1995 +0200
+++ b/RsrcPack.st Tue May 16 19:17:11 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/RsrcPack.st,v 1.14 1995-05-03 00:25:14 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/RsrcPack.st,v 1.15 1995-05-16 17:13:52 claus Exp $
'!
!ResourcePack class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/RsrcPack.st,v 1.14 1995-05-03 00:25:14 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/RsrcPack.st,v 1.15 1995-05-16 17:13:52 claus Exp $
"
!
@@ -303,6 +303,58 @@
inStream close.
!
+processLine:aLine
+ |lineString name stream l rest macroName value|
+
+ lineString := lineString withoutSeparators.
+ name := nil.
+ (lineString at:1) == $' ifTrue:[
+ stream := ReadStream on:lineString.
+ name := String
+ readFrom:stream
+ onError:['RESOURCEPACK: invalid line <',lineString,'>' errorPrintNl. nil].
+ l := stream position.
+
+"/ l := lineString indexOf:$' startingAt:2.
+"/ l ~~ 0 ifTrue:[
+"/ name := (lineString copyFrom:2 to:l-1).
+"/ l := l + 1
+"/ ]
+ ] ifFalse:[
+ l := lineString indexOfSeparatorStartingAt:1.
+ l ~~ 0 ifTrue:[
+ name := lineString copyFrom:1 to:l-1.
+ ]
+ ].
+ name notNil ifTrue:[
+ rest := (lineString copyFrom:l) withoutSeparators.
+ "
+ skip <type> if present
+ "
+ (rest startsWith:$<) ifTrue:[
+ l := lineString indexOf:$> startingAt:l.
+ rest := (lineString copyFrom:l+1) withoutSeparators.
+ ].
+ (rest startsWith:$=) ifTrue:[
+ rest := rest copyFrom:2.
+ stream := ReadStream on:rest.
+ macroName := stream nextAlphaNumericWord.
+ rest := stream upToEnd.
+ value := self at:macroName.
+ value := Compiler evaluate:('self ' , rest)
+ receiver:value
+ notifying:nil
+ compile:false.
+ ] ifFalse:[
+ value := Compiler evaluate:rest compile:false.
+ (value == #Error) ifTrue:[
+ Transcript show:('error in resource:' , name).
+ ]
+ ].
+ self at:name put:value.
+ ]
+!
+
readFromResourceStream:inStream in:dirName
|lineString rest value ifLevel skipping l name first str macroName|
--- a/SimpleView.st Fri May 12 20:10:19 1995 +0200
+++ b/SimpleView.st Tue May 16 19:17:11 1995 +0200
@@ -44,7 +44,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.6 1995-05-12 18:00:55 claus Exp $
+$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.7 1995-05-16 17:14:01 claus Exp $
'!
!SimpleView class methodsFor:'documentation'!
@@ -65,7 +65,7 @@
version
"
-$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.6 1995-05-12 18:00:55 claus Exp $
+$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.7 1995-05-16 17:14:01 claus Exp $
"
!
@@ -1376,7 +1376,7 @@
"
mhmh - ST-80 seems to send some to the model and
others (copy/cut/paste) to the controller/view
- Simulate this behavior, by looking ehat the model resonds to.
+ Simulate this behavior, by looking what the model resonds to.
"
(actionSelector notNil
and:[actionSelector isSymbol]) ifTrue:[
@@ -2348,7 +2348,9 @@
Views which want to resize themselfes as appropriate to their contents
should cease to do so and take their current size if sizeFixed is set to
true. Currently, only supported by Labels.
- Added here to provide a common protocol for all views"
+ This does NOT prevent the window manager from resizing the view,
+ instead it tell the view to NOT resize ITSELF.
+ Added here to provide a common protocol for all views."
^ self
!
@@ -3534,7 +3536,7 @@
(in this case, it should set all of its style-dependent things, but
leave the state and contents as-is)"
- |ext controllerClass|
+ |ext myClass controllerClass|
super initialize.
@@ -3545,24 +3547,19 @@
"fill in some defaults - some of them are usually redefined in subclasses
initialize methods"
- name := self class name asString asLowercaseFirst.
- ext := self class defaultExtent.
-
- level := 0.
+ myClass := self class.
+ name := myClass name "asString" asLowercaseFirst.
+ ext := myClass defaultExtent.
+ resources := myClass classResources.
+
+ level := margin := 0.
margin := 0.
- resources := self class classResources.
-
self initStyle.
- left := 0.
- top := 0.
+ left := top := 0.
width := ext x.
height := ext y.
-"/ leftInset := 0.
-"/ topInset := 0.
-"/ rightInset := 0.
-"/ bottomInset := 0.
originChanged := extentChanged := false.
bitGravity := nil.
--- a/StandardSystemView.st Fri May 12 20:10:19 1995 +0200
+++ b/StandardSystemView.st Tue May 16 19:17:11 1995 +0200
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/StandardSystemView.st,v 1.26 1995-05-12 18:01:16 claus Exp $
+$Header: /cvs/stx/stx/libview/StandardSystemView.st,v 1.27 1995-05-16 17:14:13 claus Exp $
'!
!StandardSystemView class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libview/StandardSystemView.st,v 1.26 1995-05-12 18:01:16 claus Exp $
+$Header: /cvs/stx/stx/libview/StandardSystemView.st,v 1.27 1995-05-16 17:14:13 claus Exp $
"
!
@@ -731,9 +731,34 @@
"this prevents the view from resizing itself when realized.
For normal topViews, this is void, since they dont do this anyway.
However, modalBoxes typically resize themselfes to the preferedExtent
- of their components, which can be turned off by setting sizeFixed to true."
+ of their components, which can be turned off by setting sizeFixed to true.
+ To avoid confusion:
+ This does NOT prevent the window manager from resizing the view,
+ instead it tell the view to NOT resize ITSELF."
+
+ sizeFixed := aBoolean.
+
+ "example: dialog which resizes itself on #open:
+ (thereby ignoring the 200@200 extent)
+
+ |dialog|
- sizeFixed := aBoolean
+ dialog := Dialog new.
+ dialog addInputFieldOn:'' asValue.
+ dialog addOkButton.
+ dialog extent:200@200.
+ dialog open.
+
+ using sizeFixed:
+
+ |dialog|
+
+ dialog := Dialog new.
+ dialog addInputFieldOn:'' asValue.
+ dialog addOkButton.
+ dialog extent:200@200; sizeFixed:true.
+ dialog open.
+ "
!
application
--- a/StdSysV.st Fri May 12 20:10:19 1995 +0200
+++ b/StdSysV.st Tue May 16 19:17:11 1995 +0200
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/StdSysV.st,v 1.26 1995-05-12 18:01:16 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/StdSysV.st,v 1.27 1995-05-16 17:14:13 claus Exp $
'!
!StandardSystemView class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/StdSysV.st,v 1.26 1995-05-12 18:01:16 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/StdSysV.st,v 1.27 1995-05-16 17:14:13 claus Exp $
"
!
@@ -731,9 +731,34 @@
"this prevents the view from resizing itself when realized.
For normal topViews, this is void, since they dont do this anyway.
However, modalBoxes typically resize themselfes to the preferedExtent
- of their components, which can be turned off by setting sizeFixed to true."
+ of their components, which can be turned off by setting sizeFixed to true.
+ To avoid confusion:
+ This does NOT prevent the window manager from resizing the view,
+ instead it tell the view to NOT resize ITSELF."
+
+ sizeFixed := aBoolean.
+
+ "example: dialog which resizes itself on #open:
+ (thereby ignoring the 200@200 extent)
+
+ |dialog|
- sizeFixed := aBoolean
+ dialog := Dialog new.
+ dialog addInputFieldOn:'' asValue.
+ dialog addOkButton.
+ dialog extent:200@200.
+ dialog open.
+
+ using sizeFixed:
+
+ |dialog|
+
+ dialog := Dialog new.
+ dialog addInputFieldOn:'' asValue.
+ dialog addOkButton.
+ dialog extent:200@200; sizeFixed:true.
+ dialog open.
+ "
!
application
--- a/WEvent.st Fri May 12 20:10:19 1995 +0200
+++ b/WEvent.st Tue May 16 19:17:11 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/WEvent.st,v 1.17 1995-05-12 18:09:21 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/WEvent.st,v 1.18 1995-05-16 17:14:32 claus Exp $
'!
!WindowEvent class methodsFor:'documentation'!
@@ -42,16 +42,85 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/WEvent.st,v 1.17 1995-05-12 18:09:21 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/WEvent.st,v 1.18 1995-05-16 17:14:32 claus Exp $
"
!
documentation
"
Instances of WindowEvent are created for every event coming from
- the graphics device, to be handled by a windowGroup.
- Usually, they are queued by a sensor, and processed in some event loop
- in the window group.
+ the graphics device.
+ Usually, they are enqueued by the event dispatcher process into
+ a sensors input queue, and dequeued & processed by a windowGroup process
+ in its event loop.
+
+ WindowEvents hold the event type and additional information (such as key,
+ x/y coordinates etc). Also, windowEvents know how to send themself to some
+ destination. To provide a common (single) place where event dispatching is
+ implemented, this forwarding is done by a clas method here (i.e. not by the
+ window group itself).
+
+ The algorithm for event dispatching is:
+
+ - if the destination view has a keyboard focus set,
+ AND the event is a keyboard event,
+ THEN recursively invoke the event dispatching method,
+ sending the event to the focus view (or its delegate, as below)
+
+ - if the destination view has a delegate,
+ AND its a keyboard, button or pointer event,
+ AND the delegate is interrested in that event
+ (i.e. implements & responds to #handlesXXX with true)
+ THEN send the event to the delegate, passing the original view
+ as additional argument
+
+ - if the view has a nonNil controller,
+ AND its a key, button or pointer event,
+ THEN send the event to the controller
+
+ - otherwise send the event to the view
+
+
+ If the view has a non-nil transformation, the event is sent as a
+ #deviceXXX message, passing device coordinates. Typically, subclasses
+ of view do not redefine this method and the inherited default method
+ translates these device coordinates into logical coordinates and resends
+ an XXX message.
+ If the view has no transformation, the XXX message is directly sent here.
+
+ For example, a 'buttonPress:button x:x y:y' event leads to sending of
+ 'aView deviceButtonPress:button x:x y:y' which resends
+ 'aView buttonPress:button x:(x-logical) y:(y-logical)'
+
+ This allows views which are interrested in deviceCoordinates to get them
+ (by redefining #deviceXXX) and other views to transparently get & use
+ logical coordinates.
+
+ Therefore, for a delegated keyPress messages, the flow is:
+
+ sendEvent
+ view has delegate
+ ------> ask delegate via 'handlesKeyPress:key inView:view'
+ <------ returns true
+ ------> 'delegate keyPress:key x:x y:y view:view'
+ -----> delegate does whatever it wants to do
+ (typically sends the event to some other view)
+
+ for an undelegated message:
+
+ sendEvent
+ view has delegate
+ ------> ask delegate via 'handlesKeyPress:key inView:view'
+ <------ returns false
+ view has controller
+ ------> 'controller keyPress:key x:x y:y'
+ view has no controller
+ view has transformation
+ ----> 'view deviceKeyPress:key x:x y:y'
+ inverse transform x/y
+ ----> 'self keyPress:key x:xLogical y:yLogical'
+ view has no transformation
+ ----> 'view keyPress:key x:x y:y'
"
! !
@@ -262,6 +331,7 @@
delegateQuery := #'handlesPointerEnter:inView:'.
] ifFalse:[ (type == #'pointerLeave:') ifTrue:[
isPointerEvent := true.
+ deviceMessage := #'pointerLeave:view:'.
delegateMessage := #'pointerLeave:view:'.
delegateQuery := #'handlesPointerLeave:inView:'.
] ifFalse:[ (type == #'exposeX:y:width:height:') ifTrue:[
@@ -358,7 +428,7 @@
view transformation notNil ifTrue:[
(isKeyEvent
or:[isButtonEvent
- or:[(type == #'pointerEnter:x:y:')
+ or:[isPointerEvent
or:[(type == #'exposeX:y:width:height:')
or:[(type == #'graphicExposeX:y:width:height:')]]]]) ifTrue:[
selector := deviceMessage
@@ -370,16 +440,18 @@
!WindowEvent methodsFor:'sending'!
sendEvent
- "forward the event represented by the receiver to the delegate,
- the controller or the view."
+ "forward the event represented by the receiver to the views delegate,
+ the views controller or the view. Ignore any focusView."
self sendEventWithFocusOn:nil
!
sendEventWithFocusOn:focusView
- "forward the event represented by the receiver to the delegate,
- the controller or the view. If focusView is nonNil, and it is a keyboard
- event, the event is forwarded to the focusView instead of the target view."
+ "forward the event represented by the receiver to the views delegate,
+ the views controller or the view.
+ If focusView is nonNil, and the receiver is a keyboard event,
+ the event will be forwarded to the focusView instead
+ (or its delegate, or its controller)."
self class
sendEvent:type
@@ -392,7 +464,7 @@
!WindowEvent methodsFor:'private accessing'!
for:aView type:aSymbol arguments:argArray
- "set the instances of the window event"
+ "set the instance variables of the event"
view := aView.
type := aSymbol.
--- a/WGroup.st Fri May 12 20:10:19 1995 +0200
+++ b/WGroup.st Tue May 16 19:17:11 1995 +0200
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/WGroup.st,v 1.25 1995-05-10 02:26:27 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/WGroup.st,v 1.26 1995-05-16 17:14:37 claus Exp $
'!
!WindowGroup class methodsFor:'documentation'!
@@ -43,7 +43,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/WGroup.st,v 1.25 1995-05-10 02:26:27 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/WGroup.st,v 1.26 1995-05-16 17:14:37 claus Exp $
"
!
@@ -55,22 +55,28 @@
There is no polling in controllers (not even conceptionally).
WindowGroups are responsible to wait for and forward events for a group of
- windows. All views in a group share a single input event queue.
+ windows. All views in a group share a single windowSensor which holdes the
+ event queue (therefore views all share the same input event queue).
+
Except for modal boxes, a separate process is created for each windowGroup
- which waits for and forwards them to a controller (*).
+ which waits for events and processes them, by sending corresponding
+ event messages to the views controller or the view (*).
Therefore, multiple applications run in parallel.
Modal boxes create an extra window group for the components of the modal
- box, but execute in the original process - therefore, the original windowgroup
- is blocked for the duration of the modal interaction.
+ box, but execute the event-processing loop in the original process -
+ therefore, the original windowgroup is blocked for the duration of the modal
+ interaction (**).
Normally, one windowgroup is associated to each topview (StandardSystemView)
- and all of its subviews. However, this is not required; it is possible
- to create extra windowgroups for subviews, which will let them run in
- parallel (for example, the FileBrowsers kill Button is created that way,
- to allow a kill of an executing unix command, while the browser itself
- reads the pipe for incoming text).
- On the other hand, multiple topviews can be associated in the same windowGroup;
- this allows for multiview applications, of which only one communicates with
+ and all of its subviews. However, this is not strictly required;
+ it is possible to create extra windowgroups for subviews, which will let them
+ run in parallel
+ (for example, the FileBrowsers kill Button is created that
+ way, to allow a kill of an executing unix command, while the browser
+ itself reads the pipeStream for incoming text).
+
+ On the other hand, multiple topviews can be placed into the same windowGroup;
+ which allows for multiview applications, of which only one communicates with
the user at a time.
Although currently not implemented, it is planned for a future version,
@@ -90,6 +96,7 @@
created for you automatically, when a view is opened.
instance variables:
+
views collection of views of this group
topViews collection of topviews of this group
@@ -112,15 +119,23 @@
ActiveGroup the currently active windowGroup
- ScheduledWindowGroups -- not currently used --
+ ScheduledWindowGroups -- not currently implemented / used --
- (*) due to historic reasons, many views have the controller functionality
+ (*)
+ due to historic reasons, many views have the controller functionality
integrated, and handle events themself. The windowSensor takes care
of this, by checking if a view has a controller, and, if so, forwarding
the events to it. Otherwise, events are sent directly to the view.
- In the future, all views will be rewritten to actually use a controller;
- currently, only buttons, toggles and subclasses do so.
+
+ In the future, all views will be rewritten to actually use a controller.
+ Currently (being in the middle of this migration), only some views
+ (buttons, toggles and subclasses) do so.
+
+ (**)
+ the modal-event loop peeks into the original groups damage queue
+ in regular time intervals - therefore, view updating is still done in
+ the blocked group.
For more information, read 'introduction to view programming' in the
doc/online directory.
@@ -140,11 +155,13 @@
"WindowGroup initialize"
! !
-!WindowGroup class methodsFor:'signal access'!
+!WindowGroup class methodsFor:'Signal constants'!
leaveSignal
"return the signal which is used to exit a modal loop.
- This private signal, is always cought while a modalbox is active."
+ This private signal, is always cought while a modalbox is active.
+ Raising it will exit the modal loop and return from the views #openModal
+ method."
^ LeaveSignal
! !
@@ -295,7 +312,7 @@
!WindowGroup methodsFor:'special'!
showCursor:aCursor
- "change the cursor to aCursor in all of my views"
+ "change the cursor to aCursor in all of my views."
|c|
@@ -334,7 +351,7 @@
aBlock valueNowOrOnUnwindDo:[
"
- restore cursors
+ restore cursors from the mapping
"
oldCursors keysAndValuesDo:[:view :cursor |
view cursor:cursor
@@ -787,7 +804,7 @@
printOn:aStream
"return a printed representation;
- just for more user friendlyness, add name of process."
+ just for more user friendlyness: add name of process."
myProcess isNil ifTrue:[
(previousGroup notNil and:[previousGroup process notNil]) ifTrue:[
--- a/WSensor.st Fri May 12 20:10:19 1995 +0200
+++ b/WSensor.st Tue May 16 19:17:11 1995 +0200
@@ -14,9 +14,9 @@
Object subclass:#WindowSensor
instanceVariableNames:'eventSemaphore damage mouseAndKeyboard compressMotionEvents
- ignoreUserInput buttonState exposeEventSemaphore catchExpose
- gotExpose gotOtherEvent translateKeyboardEvents shiftPressed
- controlPressed metaPressed eventListener keyboardListener'
+ ignoreUserInput exposeEventSemaphore catchExpose
+ gotExpose gotOtherEvent translateKeyboardEvents shiftDown
+ controlDown metaDown altDown eventListener keyboardListener'
classVariableNames:'ControlCEnabled EventListener'
poolDictionaries:''
category:'Interface-Support'
@@ -26,7 +26,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/WSensor.st,v 1.23 1995-05-09 00:23:17 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/WSensor.st,v 1.24 1995-05-16 17:14:42 claus Exp $
'!
!WindowSensor class methodsFor:'documentation'!
@@ -47,7 +47,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/WSensor.st,v 1.23 1995-05-09 00:23:17 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/WSensor.st,v 1.24 1995-05-16 17:14:42 claus Exp $
"
!
@@ -55,10 +55,42 @@
"
Instances of this class keep track of events and damage areas for a group of
views. All incoming expose rectangles and events (from Workstation) are
- collected here, until someone gets a chance to handle them.
+ collected here, until someone (usually the windowGroup process)
+ gets a chance to handle them.
+ In contrast to ST-80 (which has one windowSensor per window), ST/X usually
+ only assigns one sensor per windowGroup.
+ (however, you could manually arrange for per view private sensors - at least, theoretically)
+
When adding an expose rectangle, WindowSensor tries to merge the rectangle
with the list of existing damages to minimize redrawing.
+ Beside the above, windowSensors provide facilities (hooks) to allow
+ a so-called 'eventListener' to get the events before it is enterred into
+ the queue. There are 3 possible listening hooks available:
+
+ a global EventListener - gets keybd/mouse events for all views
+ a per-sensor eventListener - gets only keybd/mouse events for this sensors wGroup
+ a per-sensor keyboardListener - only gets keyboard events for this sensors wGroup
+
+ (actually, there is a fourth mechanism, event delegation which allows
+ delegation of key- and buttonEvents of a specific view)
+
+ The global eventListener is installed via a class method (eventListener:) to
+ the WindowSensor class; local listeners are installed via instance methods.
+ Each listener should return true, if it handled the event and that event should
+ therefore NOT be enqueued. Likewise, if it returns false, the event is
+ processed as usual.
+ The global listener is called before the local listener, which is called
+ before the keyboard listener. If any returns true, later listeners wont get
+ the event.
+ EventListeners were added to allow the implementation of event recorders
+ or other spy functionality.
+
+ Notice, that beside event listening, you can also define a delegate for
+ a views keyboard and button events.
+ Read the documentation in WindowEvent for more info.
+
+
instance variables:
eventSemaphore <Semaphore> the semaphore to be signalled when an event
(or damage) arrives
@@ -76,7 +108,11 @@
(usually set to true by WindowGroup, while a
modalbox covers a view)
- buttonState the current state (currently unused)
+ shiftDown <Boolean> true while shift/meta/control-key is pressed
+ metaDown (to support ST-80 style query: sensor shiftDown)
+ controlDown
+ altDown (notice, that on most systems, alt and meta key is
+ the same, both reported as #Alt)
exposeEventSemaphore <Semaphore> X-special: semaphore to be signalled when
expose event arrives after a copyArea.
@@ -149,24 +185,15 @@
!WindowSensor class methodsFor:'accessing'!
-disableControlC
- "disable Control-C processing. If enabled,
- pressing CNTL-C in a view will interrupt it and bring
+controlCEnabled:aBoolean
+ "enable/disable Control-C processing.
+ If enabled, pressing CNTL-C in a view will interrupt it and bring
its process into the debugger (actually raising signal).
Otherwise, CNTL-C is sent to the view like any other key.
+ The default is true (enabled).
"
- ControlCEnabled := false
-!
-
-enableControlC
- "enable Control-C processing. If enabled,
- pressing CNTL-C in a view will interrupt it and bring
- its process into the debugger (actually raising signal).
- Otherwise, CNTL-C is sent to the view like any other key.
- "
-
- ControlCEnabled := true
+ ControlCEnabled := aBoolean
!
eventListener:aListener
@@ -215,6 +242,33 @@
]
!
+key:key state:onOrOff
+ "update the state of the shiftDown/metaDown and controlDown
+ 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:[
+ controlDown := onOrOff.
+ ^ self
+ ].
+!
+
noExposeView:aView
"an noexpose event arrived - this is sent from the device (Display)"
@@ -227,8 +281,9 @@
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.
- self notifyEventArrival
+ (self addDamage:(Rectangle left:left top:top width:width height:height) view:aView) ifTrue:[
+ self notifyEventArrival
+ ]
!
buttonMotion:state x:x y:y view:aView
@@ -402,6 +457,8 @@
|xlatedKey group process|
+ self key:key state:true.
+
EventListener notNil ifTrue:[
(EventListener keyPress:key x:x y:y view:aView) ifTrue:[^ self]
].
@@ -523,6 +580,8 @@
|xlatedKey|
+ self key:key state:false.
+
EventListener notNil ifTrue:[
(EventListener keyRelease:key x:x y:y view:aView) ifTrue:[^ self]
].
@@ -625,12 +684,15 @@
^ e
!
-addDamage: aRectangle view:aView
+addDamage:aRectangle view:aView
"Add aRectangle to the damage list.
- We try to merge incoming rectangles with the existing damage by discarding
- incoming rectangles which are contained in the existing damage or replacing
- any existing damage rectangle with incoming rectangles that completely contain it.
- There could be much more optimization here (for example joining rectangles)..."
+ Try to merge incoming rectangles with the existing damage rectangles.
+ Incoming rectangles which are completely contained in any existing damage rect are ignored,
+ any existing damage rectangle which is completely contained in the incoming rectangle
+ is replaced.
+ There could be much more optimization here (for example joining rectangles) ...
+ Except for special cases (moveOpaque of a view over one of my views),
+ these optimizations are not noticable."
|count temp index newEvent
sz "{ Class: SmallInteger }" |
@@ -639,7 +701,7 @@
sz == 0 ifTrue: [
newEvent := WindowEvent damageFor:aView rectangle:aRectangle.
damage := OrderedCollection with:newEvent.
- ^ self
+ ^ true
].
"
@@ -650,7 +712,7 @@
aDamage notNil ifTrue:[
aDamage isDamage ifTrue:[
aDamage view == aView ifTrue:[
- ((aDamage rectangle) contains:aRectangle) ifTrue: [^self]
+ ((aDamage rectangle) contains:aRectangle) ifTrue: [^false]
]
]
].
@@ -679,6 +741,7 @@
"
if we nilled more then 10 events, reorganize the queue
+ (this avoids excessive reorganization of the input queue)
"
count > 10 ifTrue: [
temp := OrderedCollection new:(sz - count + 1).
@@ -692,6 +755,7 @@
].
newEvent := WindowEvent damageFor:aView rectangle:aRectangle.
damage add:newEvent.
+ ^ true
!
pendingEvent
@@ -770,9 +834,38 @@
globalOrigin
"ST-80 compatibility:
- dont know what we should return here ..."
+ 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
+!
+
+controlDown
+ "return true, if any CTRL key is currently pressed."
+
+ ^ controlDown
+!
+
+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
! !
!WindowSensor methodsFor:'special'!
@@ -1041,9 +1134,9 @@
gotExpose := true.
catchExpose := false.
- compressMotionEvents := true.
+ compressMotionEvents := translateKeyboardEvents := true.
ignoreUserInput := false.
- translateKeyboardEvents := true
+ shiftDown := controlDown := altDown := metaDown := false
!
reinitialize
--- a/WindowEvent.st Fri May 12 20:10:19 1995 +0200
+++ b/WindowEvent.st Tue May 16 19:17:11 1995 +0200
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/WindowEvent.st,v 1.17 1995-05-12 18:09:21 claus Exp $
+$Header: /cvs/stx/stx/libview/WindowEvent.st,v 1.18 1995-05-16 17:14:32 claus Exp $
'!
!WindowEvent class methodsFor:'documentation'!
@@ -42,16 +42,85 @@
version
"
-$Header: /cvs/stx/stx/libview/WindowEvent.st,v 1.17 1995-05-12 18:09:21 claus Exp $
+$Header: /cvs/stx/stx/libview/WindowEvent.st,v 1.18 1995-05-16 17:14:32 claus Exp $
"
!
documentation
"
Instances of WindowEvent are created for every event coming from
- the graphics device, to be handled by a windowGroup.
- Usually, they are queued by a sensor, and processed in some event loop
- in the window group.
+ the graphics device.
+ Usually, they are enqueued by the event dispatcher process into
+ a sensors input queue, and dequeued & processed by a windowGroup process
+ in its event loop.
+
+ WindowEvents hold the event type and additional information (such as key,
+ x/y coordinates etc). Also, windowEvents know how to send themself to some
+ destination. To provide a common (single) place where event dispatching is
+ implemented, this forwarding is done by a clas method here (i.e. not by the
+ window group itself).
+
+ The algorithm for event dispatching is:
+
+ - if the destination view has a keyboard focus set,
+ AND the event is a keyboard event,
+ THEN recursively invoke the event dispatching method,
+ sending the event to the focus view (or its delegate, as below)
+
+ - if the destination view has a delegate,
+ AND its a keyboard, button or pointer event,
+ AND the delegate is interrested in that event
+ (i.e. implements & responds to #handlesXXX with true)
+ THEN send the event to the delegate, passing the original view
+ as additional argument
+
+ - if the view has a nonNil controller,
+ AND its a key, button or pointer event,
+ THEN send the event to the controller
+
+ - otherwise send the event to the view
+
+
+ If the view has a non-nil transformation, the event is sent as a
+ #deviceXXX message, passing device coordinates. Typically, subclasses
+ of view do not redefine this method and the inherited default method
+ translates these device coordinates into logical coordinates and resends
+ an XXX message.
+ If the view has no transformation, the XXX message is directly sent here.
+
+ For example, a 'buttonPress:button x:x y:y' event leads to sending of
+ 'aView deviceButtonPress:button x:x y:y' which resends
+ 'aView buttonPress:button x:(x-logical) y:(y-logical)'
+
+ This allows views which are interrested in deviceCoordinates to get them
+ (by redefining #deviceXXX) and other views to transparently get & use
+ logical coordinates.
+
+ Therefore, for a delegated keyPress messages, the flow is:
+
+ sendEvent
+ view has delegate
+ ------> ask delegate via 'handlesKeyPress:key inView:view'
+ <------ returns true
+ ------> 'delegate keyPress:key x:x y:y view:view'
+ -----> delegate does whatever it wants to do
+ (typically sends the event to some other view)
+
+ for an undelegated message:
+
+ sendEvent
+ view has delegate
+ ------> ask delegate via 'handlesKeyPress:key inView:view'
+ <------ returns false
+ view has controller
+ ------> 'controller keyPress:key x:x y:y'
+ view has no controller
+ view has transformation
+ ----> 'view deviceKeyPress:key x:x y:y'
+ inverse transform x/y
+ ----> 'self keyPress:key x:xLogical y:yLogical'
+ view has no transformation
+ ----> 'view keyPress:key x:x y:y'
"
! !
@@ -262,6 +331,7 @@
delegateQuery := #'handlesPointerEnter:inView:'.
] ifFalse:[ (type == #'pointerLeave:') ifTrue:[
isPointerEvent := true.
+ deviceMessage := #'pointerLeave:view:'.
delegateMessage := #'pointerLeave:view:'.
delegateQuery := #'handlesPointerLeave:inView:'.
] ifFalse:[ (type == #'exposeX:y:width:height:') ifTrue:[
@@ -358,7 +428,7 @@
view transformation notNil ifTrue:[
(isKeyEvent
or:[isButtonEvent
- or:[(type == #'pointerEnter:x:y:')
+ or:[isPointerEvent
or:[(type == #'exposeX:y:width:height:')
or:[(type == #'graphicExposeX:y:width:height:')]]]]) ifTrue:[
selector := deviceMessage
@@ -370,16 +440,18 @@
!WindowEvent methodsFor:'sending'!
sendEvent
- "forward the event represented by the receiver to the delegate,
- the controller or the view."
+ "forward the event represented by the receiver to the views delegate,
+ the views controller or the view. Ignore any focusView."
self sendEventWithFocusOn:nil
!
sendEventWithFocusOn:focusView
- "forward the event represented by the receiver to the delegate,
- the controller or the view. If focusView is nonNil, and it is a keyboard
- event, the event is forwarded to the focusView instead of the target view."
+ "forward the event represented by the receiver to the views delegate,
+ the views controller or the view.
+ If focusView is nonNil, and the receiver is a keyboard event,
+ the event will be forwarded to the focusView instead
+ (or its delegate, or its controller)."
self class
sendEvent:type
@@ -392,7 +464,7 @@
!WindowEvent methodsFor:'private accessing'!
for:aView type:aSymbol arguments:argArray
- "set the instances of the window event"
+ "set the instance variables of the event"
view := aView.
type := aSymbol.
--- a/WindowGroup.st Fri May 12 20:10:19 1995 +0200
+++ b/WindowGroup.st Tue May 16 19:17:11 1995 +0200
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/WindowGroup.st,v 1.25 1995-05-10 02:26:27 claus Exp $
+$Header: /cvs/stx/stx/libview/WindowGroup.st,v 1.26 1995-05-16 17:14:37 claus Exp $
'!
!WindowGroup class methodsFor:'documentation'!
@@ -43,7 +43,7 @@
version
"
-$Header: /cvs/stx/stx/libview/WindowGroup.st,v 1.25 1995-05-10 02:26:27 claus Exp $
+$Header: /cvs/stx/stx/libview/WindowGroup.st,v 1.26 1995-05-16 17:14:37 claus Exp $
"
!
@@ -55,22 +55,28 @@
There is no polling in controllers (not even conceptionally).
WindowGroups are responsible to wait for and forward events for a group of
- windows. All views in a group share a single input event queue.
+ windows. All views in a group share a single windowSensor which holdes the
+ event queue (therefore views all share the same input event queue).
+
Except for modal boxes, a separate process is created for each windowGroup
- which waits for and forwards them to a controller (*).
+ which waits for events and processes them, by sending corresponding
+ event messages to the views controller or the view (*).
Therefore, multiple applications run in parallel.
Modal boxes create an extra window group for the components of the modal
- box, but execute in the original process - therefore, the original windowgroup
- is blocked for the duration of the modal interaction.
+ box, but execute the event-processing loop in the original process -
+ therefore, the original windowgroup is blocked for the duration of the modal
+ interaction (**).
Normally, one windowgroup is associated to each topview (StandardSystemView)
- and all of its subviews. However, this is not required; it is possible
- to create extra windowgroups for subviews, which will let them run in
- parallel (for example, the FileBrowsers kill Button is created that way,
- to allow a kill of an executing unix command, while the browser itself
- reads the pipe for incoming text).
- On the other hand, multiple topviews can be associated in the same windowGroup;
- this allows for multiview applications, of which only one communicates with
+ and all of its subviews. However, this is not strictly required;
+ it is possible to create extra windowgroups for subviews, which will let them
+ run in parallel
+ (for example, the FileBrowsers kill Button is created that
+ way, to allow a kill of an executing unix command, while the browser
+ itself reads the pipeStream for incoming text).
+
+ On the other hand, multiple topviews can be placed into the same windowGroup;
+ which allows for multiview applications, of which only one communicates with
the user at a time.
Although currently not implemented, it is planned for a future version,
@@ -90,6 +96,7 @@
created for you automatically, when a view is opened.
instance variables:
+
views collection of views of this group
topViews collection of topviews of this group
@@ -112,15 +119,23 @@
ActiveGroup the currently active windowGroup
- ScheduledWindowGroups -- not currently used --
+ ScheduledWindowGroups -- not currently implemented / used --
- (*) due to historic reasons, many views have the controller functionality
+ (*)
+ due to historic reasons, many views have the controller functionality
integrated, and handle events themself. The windowSensor takes care
of this, by checking if a view has a controller, and, if so, forwarding
the events to it. Otherwise, events are sent directly to the view.
- In the future, all views will be rewritten to actually use a controller;
- currently, only buttons, toggles and subclasses do so.
+
+ In the future, all views will be rewritten to actually use a controller.
+ Currently (being in the middle of this migration), only some views
+ (buttons, toggles and subclasses) do so.
+
+ (**)
+ the modal-event loop peeks into the original groups damage queue
+ in regular time intervals - therefore, view updating is still done in
+ the blocked group.
For more information, read 'introduction to view programming' in the
doc/online directory.
@@ -140,11 +155,13 @@
"WindowGroup initialize"
! !
-!WindowGroup class methodsFor:'signal access'!
+!WindowGroup class methodsFor:'Signal constants'!
leaveSignal
"return the signal which is used to exit a modal loop.
- This private signal, is always cought while a modalbox is active."
+ This private signal, is always cought while a modalbox is active.
+ Raising it will exit the modal loop and return from the views #openModal
+ method."
^ LeaveSignal
! !
@@ -295,7 +312,7 @@
!WindowGroup methodsFor:'special'!
showCursor:aCursor
- "change the cursor to aCursor in all of my views"
+ "change the cursor to aCursor in all of my views."
|c|
@@ -334,7 +351,7 @@
aBlock valueNowOrOnUnwindDo:[
"
- restore cursors
+ restore cursors from the mapping
"
oldCursors keysAndValuesDo:[:view :cursor |
view cursor:cursor
@@ -787,7 +804,7 @@
printOn:aStream
"return a printed representation;
- just for more user friendlyness, add name of process."
+ just for more user friendlyness: add name of process."
myProcess isNil ifTrue:[
(previousGroup notNil and:[previousGroup process notNil]) ifTrue:[
--- a/WindowSensor.st Fri May 12 20:10:19 1995 +0200
+++ b/WindowSensor.st Tue May 16 19:17:11 1995 +0200
@@ -14,9 +14,9 @@
Object subclass:#WindowSensor
instanceVariableNames:'eventSemaphore damage mouseAndKeyboard compressMotionEvents
- ignoreUserInput buttonState exposeEventSemaphore catchExpose
- gotExpose gotOtherEvent translateKeyboardEvents shiftPressed
- controlPressed metaPressed eventListener keyboardListener'
+ ignoreUserInput exposeEventSemaphore catchExpose
+ gotExpose gotOtherEvent translateKeyboardEvents shiftDown
+ controlDown metaDown altDown eventListener keyboardListener'
classVariableNames:'ControlCEnabled EventListener'
poolDictionaries:''
category:'Interface-Support'
@@ -26,7 +26,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/WindowSensor.st,v 1.23 1995-05-09 00:23:17 claus Exp $
+$Header: /cvs/stx/stx/libview/WindowSensor.st,v 1.24 1995-05-16 17:14:42 claus Exp $
'!
!WindowSensor class methodsFor:'documentation'!
@@ -47,7 +47,7 @@
version
"
-$Header: /cvs/stx/stx/libview/WindowSensor.st,v 1.23 1995-05-09 00:23:17 claus Exp $
+$Header: /cvs/stx/stx/libview/WindowSensor.st,v 1.24 1995-05-16 17:14:42 claus Exp $
"
!
@@ -55,10 +55,42 @@
"
Instances of this class keep track of events and damage areas for a group of
views. All incoming expose rectangles and events (from Workstation) are
- collected here, until someone gets a chance to handle them.
+ collected here, until someone (usually the windowGroup process)
+ gets a chance to handle them.
+ In contrast to ST-80 (which has one windowSensor per window), ST/X usually
+ only assigns one sensor per windowGroup.
+ (however, you could manually arrange for per view private sensors - at least, theoretically)
+
When adding an expose rectangle, WindowSensor tries to merge the rectangle
with the list of existing damages to minimize redrawing.
+ Beside the above, windowSensors provide facilities (hooks) to allow
+ a so-called 'eventListener' to get the events before it is enterred into
+ the queue. There are 3 possible listening hooks available:
+
+ a global EventListener - gets keybd/mouse events for all views
+ a per-sensor eventListener - gets only keybd/mouse events for this sensors wGroup
+ a per-sensor keyboardListener - only gets keyboard events for this sensors wGroup
+
+ (actually, there is a fourth mechanism, event delegation which allows
+ delegation of key- and buttonEvents of a specific view)
+
+ The global eventListener is installed via a class method (eventListener:) to
+ the WindowSensor class; local listeners are installed via instance methods.
+ Each listener should return true, if it handled the event and that event should
+ therefore NOT be enqueued. Likewise, if it returns false, the event is
+ processed as usual.
+ The global listener is called before the local listener, which is called
+ before the keyboard listener. If any returns true, later listeners wont get
+ the event.
+ EventListeners were added to allow the implementation of event recorders
+ or other spy functionality.
+
+ Notice, that beside event listening, you can also define a delegate for
+ a views keyboard and button events.
+ Read the documentation in WindowEvent for more info.
+
+
instance variables:
eventSemaphore <Semaphore> the semaphore to be signalled when an event
(or damage) arrives
@@ -76,7 +108,11 @@
(usually set to true by WindowGroup, while a
modalbox covers a view)
- buttonState the current state (currently unused)
+ shiftDown <Boolean> true while shift/meta/control-key is pressed
+ metaDown (to support ST-80 style query: sensor shiftDown)
+ controlDown
+ altDown (notice, that on most systems, alt and meta key is
+ the same, both reported as #Alt)
exposeEventSemaphore <Semaphore> X-special: semaphore to be signalled when
expose event arrives after a copyArea.
@@ -149,24 +185,15 @@
!WindowSensor class methodsFor:'accessing'!
-disableControlC
- "disable Control-C processing. If enabled,
- pressing CNTL-C in a view will interrupt it and bring
+controlCEnabled:aBoolean
+ "enable/disable Control-C processing.
+ If enabled, pressing CNTL-C in a view will interrupt it and bring
its process into the debugger (actually raising signal).
Otherwise, CNTL-C is sent to the view like any other key.
+ The default is true (enabled).
"
- ControlCEnabled := false
-!
-
-enableControlC
- "enable Control-C processing. If enabled,
- pressing CNTL-C in a view will interrupt it and bring
- its process into the debugger (actually raising signal).
- Otherwise, CNTL-C is sent to the view like any other key.
- "
-
- ControlCEnabled := true
+ ControlCEnabled := aBoolean
!
eventListener:aListener
@@ -215,6 +242,33 @@
]
!
+key:key state:onOrOff
+ "update the state of the shiftDown/metaDown and controlDown
+ 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:[
+ controlDown := onOrOff.
+ ^ self
+ ].
+!
+
noExposeView:aView
"an noexpose event arrived - this is sent from the device (Display)"
@@ -227,8 +281,9 @@
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.
- self notifyEventArrival
+ (self addDamage:(Rectangle left:left top:top width:width height:height) view:aView) ifTrue:[
+ self notifyEventArrival
+ ]
!
buttonMotion:state x:x y:y view:aView
@@ -402,6 +457,8 @@
|xlatedKey group process|
+ self key:key state:true.
+
EventListener notNil ifTrue:[
(EventListener keyPress:key x:x y:y view:aView) ifTrue:[^ self]
].
@@ -523,6 +580,8 @@
|xlatedKey|
+ self key:key state:false.
+
EventListener notNil ifTrue:[
(EventListener keyRelease:key x:x y:y view:aView) ifTrue:[^ self]
].
@@ -625,12 +684,15 @@
^ e
!
-addDamage: aRectangle view:aView
+addDamage:aRectangle view:aView
"Add aRectangle to the damage list.
- We try to merge incoming rectangles with the existing damage by discarding
- incoming rectangles which are contained in the existing damage or replacing
- any existing damage rectangle with incoming rectangles that completely contain it.
- There could be much more optimization here (for example joining rectangles)..."
+ Try to merge incoming rectangles with the existing damage rectangles.
+ Incoming rectangles which are completely contained in any existing damage rect are ignored,
+ any existing damage rectangle which is completely contained in the incoming rectangle
+ is replaced.
+ There could be much more optimization here (for example joining rectangles) ...
+ Except for special cases (moveOpaque of a view over one of my views),
+ these optimizations are not noticable."
|count temp index newEvent
sz "{ Class: SmallInteger }" |
@@ -639,7 +701,7 @@
sz == 0 ifTrue: [
newEvent := WindowEvent damageFor:aView rectangle:aRectangle.
damage := OrderedCollection with:newEvent.
- ^ self
+ ^ true
].
"
@@ -650,7 +712,7 @@
aDamage notNil ifTrue:[
aDamage isDamage ifTrue:[
aDamage view == aView ifTrue:[
- ((aDamage rectangle) contains:aRectangle) ifTrue: [^self]
+ ((aDamage rectangle) contains:aRectangle) ifTrue: [^false]
]
]
].
@@ -679,6 +741,7 @@
"
if we nilled more then 10 events, reorganize the queue
+ (this avoids excessive reorganization of the input queue)
"
count > 10 ifTrue: [
temp := OrderedCollection new:(sz - count + 1).
@@ -692,6 +755,7 @@
].
newEvent := WindowEvent damageFor:aView rectangle:aRectangle.
damage add:newEvent.
+ ^ true
!
pendingEvent
@@ -770,9 +834,38 @@
globalOrigin
"ST-80 compatibility:
- dont know what we should return here ..."
+ 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
+!
+
+controlDown
+ "return true, if any CTRL key is currently pressed."
+
+ ^ controlDown
+!
+
+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
! !
!WindowSensor methodsFor:'special'!
@@ -1041,9 +1134,9 @@
gotExpose := true.
catchExpose := false.
- compressMotionEvents := true.
+ compressMotionEvents := translateKeyboardEvents := true.
ignoreUserInput := false.
- translateKeyboardEvents := true
+ shiftDown := controlDown := altDown := metaDown := false
!
reinitialize
--- a/XWorkstat.st Fri May 12 20:10:19 1995 +0200
+++ b/XWorkstat.st Tue May 16 19:17:11 1995 +0200
@@ -34,7 +34,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/Attic/XWorkstat.st,v 1.42 1995-05-12 18:09:36 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/XWorkstat.st,v 1.43 1995-05-16 17:15:05 claus Exp $
'!
!XWorkstation class methodsFor:'documentation'!
@@ -55,7 +55,7 @@
version
"
-$Header: /cvs/stx/stx/libview/Attic/XWorkstat.st,v 1.42 1995-05-12 18:09:36 claus Exp $
+$Header: /cvs/stx/stx/libview/Attic/XWorkstat.st,v 1.43 1995-05-16 17:15:05 claus Exp $
"
!
@@ -215,8 +215,8 @@
%{
/*
- * catch X-errors and forward as errorInterrupt,
- * (which itself raises an exceptionSignal)
+ * catch X-errors and forward as errorInterrupt:#DisplayError,
+ * (which itself invokes my handler and optionally raises an exceptionSignal)
* the implementation below is somewhat wrong: it will
* report all errors for Display, even though there could be
* more than one display connection.
@@ -370,7 +370,7 @@
Arguments notNil ifTrue:[
index := Arguments indexOf:'-display'.
(index between:1 and:(Arguments size - 1)) ifTrue:[
- dpyName := Arguments at:index+1
+ dpyName := Arguments at:index+1
]
]
].
@@ -578,7 +578,8 @@
self initializeSpecialFlags.
self initializeKeyboardMap.
- ObjectMemory errorInterruptHandler:self class.
+"/ ObjectMemory errorInterruptHandler:self class.
+ ObjectMemory registerErrorInterruptHandler:self class forID:#XError.
!
initializeEventBuffer
@@ -944,7 +945,7 @@
%{ /* NOCONTEXT */
RETURN (_MKSMALLINT( ExposureMask | StructureNotifyMask |
- KeyPressMask |
+ KeyPressMask | KeyReleaseMask |
ButtonPressMask | ButtonMotionMask | ButtonReleaseMask ));
%}
!
@@ -1640,7 +1641,7 @@
#ifdef OLD
/* these may not be disabled */
xswa.event_mask |= ExposureMask | StructureNotifyMask |
- KeyPressMask |
+ KeyPressMask | KeyReleaseMask |
ButtonPressMask | ButtonMotionMask | ButtonReleaseMask;
#endif
@@ -2542,78 +2543,121 @@
^ theId
].
+"/ new:
xlatedStyle := styleString.
- "oblique is named italic in times font"
- ((familyString = 'Times') or:[familyString = 'times']) ifTrue:[
- ((styleString = 'Oblique') or:[styleString = 'oblique']) ifTrue:[
- xlatedStyle := 'italic'
- ]
- ].
- (xlatedStyle = 'italic') ifTrue:[
- xlatedStyle := 'i'
- ] ifFalse:[
- (xlatedStyle = 'roman') ifTrue:[
- xlatedStyle := 'r'
- ] ifFalse:[
- (xlatedStyle = 'oblique') ifTrue:[
- xlatedStyle := 'o'
- ]
- ]
+ xlatedStyle notNil ifTrue:[
+ xlatedStyle := xlatedStyle first asString
].
- theId := nil.
- theSize := sizeArg.
- [theId isNil] whileTrue:[
- "this works only on Release >= 3 - X-servers"
- enc := encodingSym.
- enc isNil ifTrue:[
- enc := '*'
- ].
- theName := ('-*-' , familyString ,
- '-' , faceString ,
- '-' , xlatedStyle , '-*-*-*-'
- , theSize printString , '0-*-*-*-*-'
- , enc , '-*').
-"
-Transcript showCr:theName; endEntry.
-"
- theId := self createFontFor:theName.
- theId isNil ifTrue:[
- "could not get the font - try next smaller one"
- theSize := theSize - 1.
- (theSize < (sizeArg // 2)) ifTrue:[
- "thats too much - give up"
- ^ self getDefaultFont
- "^ nil"
- ]
- ]
- ].
- (theSize ~~ sizeArg) ifTrue:[
- Transcript show:'next smaller font: '.
- Transcript showCr:theName
- ].
- ^ theId
+ ^ self
+ getFontWithFoundry:'*'
+ family:familyString asLowercase
+ weight:faceString
+ slant:xlatedStyle
+ spacing:'normal'
+ pixelSize:nil
+ size:sizeArg
+ registry:'*'
+ encoding:encodingSym.
+
+
+"/ old:
+"/ xlatedStyle := styleString.
+"/ "oblique is named italic in times font"
+"/ ((familyString = 'Times') or:[familyString = 'times']) ifTrue:[
+"/ ((styleString = 'Oblique') or:[styleString = 'oblique']) ifTrue:[
+"/ xlatedStyle := 'italic'
+"/ ]
+"/ ].
+"/ (xlatedStyle = 'italic') ifTrue:[
+"/ xlatedStyle := 'i'
+"/ ] ifFalse:[
+"/ (xlatedStyle = 'roman') ifTrue:[
+"/ xlatedStyle := 'r'
+"/ ] ifFalse:[
+"/ (xlatedStyle = 'oblique') ifTrue:[
+"/ xlatedStyle := 'o'
+"/ ]
+"/ ]
+"/ ].
+"/
+"/ theId := nil.
+"/ theSize := sizeArg.
+"/ [theId isNil] whileTrue:[
+"/ "this works only on Release >= 3 - X-servers"
+"/ enc := encodingSym.
+"/ enc isNil ifTrue:[
+"/ enc := '*'
+"/ ].
+"/ theName := ('-*-' , familyString ,
+"/ '-' , faceString ,
+"/ '-' , xlatedStyle , '-*-*-*-'
+"/ , theSize printString , '0-*-*-*-*-'
+"/ , enc , '-*').
+"/"
+"/Transcript showCr:theName; endEntry.
+"/"
+"/ theId := self createFontFor:theName.
+"/ theId isNil ifTrue:[
+"/ "could not get the font - try next smaller one"
+"/ theSize := theSize - 1.
+"/ (theSize < (sizeArg // 2)) ifTrue:[
+"/ "thats too much - give up"
+"/ ^ self getDefaultFont
+"/ "^ nil"
+"/ ]
+"/ ]
+"/ ].
+"/ (theSize ~~ sizeArg) ifTrue:[
+"/ Transcript show:'next smaller font: '.
+"/ Transcript showCr:theName
+"/ ].
+"/ ^ theId
!
getFontWithFoundry:foundry family:family weight:weight
- slant:slant size:size registry:registry encoding:encoding
+ slant:slant spacing:spc pixelSize:pSize size:size
+ registry:registry encoding:encoding
"get the specified font, if not available, return nil.
This is the new font creation method - all others will be changed to
- use this wntry."
-
- |theName|
+ use this entry.
+ Individual attributes can be left empty (i.e. '') or nil to match any.
+
+ foundry: 'adobe', 'misc', 'dec', 'schumacher' ... usually '*'
+ family: 'helvetica' 'courier' 'times' ...
+ weight: 'bold' 'medium' 'demi' ...
+ slant: 'r(oman)' 'i(talic)' 'o(blique)'
+ spacing: 'narrow' 'normal' semicondensed' ... usually '*'
+ pixelSize: 16,18 ... usually left empty
+ size: size in point (1/72th of an inch)
+ registry: iso8859, sgi ... '*'
+ "
+
+ |theName sMatch|
"this works only on 'Release >= 3' - X-servers"
- theName := ('-' , foundry ,
- '-' , family ,
- '-' , weight ,
- '-' , slant ,
- '-*-*-*' ,
- '-' , size printString , '0' ,
+ "name is:
+ -foundry-family -weight -slant-
+ sony helvetica bold r
+ adobe courier medium i
+ msic fixed o
+ ... ...
+ "
+
+ size isNil ifTrue:[sMatch := '*'] ifFalse:[sMatch := size printString , '0'].
+
+ theName := ('-' , (foundry isNil ifTrue:['*'] ifFalse:[foundry]),
+ '-' , (family isNil ifTrue:['*'] ifFalse:[family]),
+ '-' , (weight isNil ifTrue:['*'] ifFalse:[weight]) ,
+ '-' , (slant isNil ifTrue:['*'] ifFalse:[slant]) ,
+ '-' , (spc isNil ifTrue:['*'] ifFalse:[spc]) ,
+ '-*' ,
+ '-' , (pSize isNil ifTrue:['*'] ifFalse:[pSize printString]),
+ '-' , sMatch ,
'-*-*-*-*' ,
- '-' , registry ,
- '-' , encoding).
+ '-' , (registry isNil ifTrue:['*'] ifFalse:[registry]) ,
+ '-' , (encoding isNil ifTrue:['*'] ifFalse:[encoding])).
Transcript showCr:theName; endEntry.
^ self createFontFor:theName.
@@ -5336,7 +5380,7 @@
#ifdef OLD
/* these may not be disabled */
mask |= ExposureMask | StructureNotifyMask |
- KeyPressMask |
+ KeyPressMask | KeyReleaseMask |
ButtonPressMask | ButtonMotionMask | ButtonReleaseMask;
#endif
--- a/XWorkstation.st Fri May 12 20:10:19 1995 +0200
+++ b/XWorkstation.st Tue May 16 19:17:11 1995 +0200
@@ -34,7 +34,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.42 1995-05-12 18:09:36 claus Exp $
+$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.43 1995-05-16 17:15:05 claus Exp $
'!
!XWorkstation class methodsFor:'documentation'!
@@ -55,7 +55,7 @@
version
"
-$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.42 1995-05-12 18:09:36 claus Exp $
+$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.43 1995-05-16 17:15:05 claus Exp $
"
!
@@ -215,8 +215,8 @@
%{
/*
- * catch X-errors and forward as errorInterrupt,
- * (which itself raises an exceptionSignal)
+ * catch X-errors and forward as errorInterrupt:#DisplayError,
+ * (which itself invokes my handler and optionally raises an exceptionSignal)
* the implementation below is somewhat wrong: it will
* report all errors for Display, even though there could be
* more than one display connection.
@@ -370,7 +370,7 @@
Arguments notNil ifTrue:[
index := Arguments indexOf:'-display'.
(index between:1 and:(Arguments size - 1)) ifTrue:[
- dpyName := Arguments at:index+1
+ dpyName := Arguments at:index+1
]
]
].
@@ -578,7 +578,8 @@
self initializeSpecialFlags.
self initializeKeyboardMap.
- ObjectMemory errorInterruptHandler:self class.
+"/ ObjectMemory errorInterruptHandler:self class.
+ ObjectMemory registerErrorInterruptHandler:self class forID:#XError.
!
initializeEventBuffer
@@ -944,7 +945,7 @@
%{ /* NOCONTEXT */
RETURN (_MKSMALLINT( ExposureMask | StructureNotifyMask |
- KeyPressMask |
+ KeyPressMask | KeyReleaseMask |
ButtonPressMask | ButtonMotionMask | ButtonReleaseMask ));
%}
!
@@ -1640,7 +1641,7 @@
#ifdef OLD
/* these may not be disabled */
xswa.event_mask |= ExposureMask | StructureNotifyMask |
- KeyPressMask |
+ KeyPressMask | KeyReleaseMask |
ButtonPressMask | ButtonMotionMask | ButtonReleaseMask;
#endif
@@ -2542,78 +2543,121 @@
^ theId
].
+"/ new:
xlatedStyle := styleString.
- "oblique is named italic in times font"
- ((familyString = 'Times') or:[familyString = 'times']) ifTrue:[
- ((styleString = 'Oblique') or:[styleString = 'oblique']) ifTrue:[
- xlatedStyle := 'italic'
- ]
- ].
- (xlatedStyle = 'italic') ifTrue:[
- xlatedStyle := 'i'
- ] ifFalse:[
- (xlatedStyle = 'roman') ifTrue:[
- xlatedStyle := 'r'
- ] ifFalse:[
- (xlatedStyle = 'oblique') ifTrue:[
- xlatedStyle := 'o'
- ]
- ]
+ xlatedStyle notNil ifTrue:[
+ xlatedStyle := xlatedStyle first asString
].
- theId := nil.
- theSize := sizeArg.
- [theId isNil] whileTrue:[
- "this works only on Release >= 3 - X-servers"
- enc := encodingSym.
- enc isNil ifTrue:[
- enc := '*'
- ].
- theName := ('-*-' , familyString ,
- '-' , faceString ,
- '-' , xlatedStyle , '-*-*-*-'
- , theSize printString , '0-*-*-*-*-'
- , enc , '-*').
-"
-Transcript showCr:theName; endEntry.
-"
- theId := self createFontFor:theName.
- theId isNil ifTrue:[
- "could not get the font - try next smaller one"
- theSize := theSize - 1.
- (theSize < (sizeArg // 2)) ifTrue:[
- "thats too much - give up"
- ^ self getDefaultFont
- "^ nil"
- ]
- ]
- ].
- (theSize ~~ sizeArg) ifTrue:[
- Transcript show:'next smaller font: '.
- Transcript showCr:theName
- ].
- ^ theId
+ ^ self
+ getFontWithFoundry:'*'
+ family:familyString asLowercase
+ weight:faceString
+ slant:xlatedStyle
+ spacing:'normal'
+ pixelSize:nil
+ size:sizeArg
+ registry:'*'
+ encoding:encodingSym.
+
+
+"/ old:
+"/ xlatedStyle := styleString.
+"/ "oblique is named italic in times font"
+"/ ((familyString = 'Times') or:[familyString = 'times']) ifTrue:[
+"/ ((styleString = 'Oblique') or:[styleString = 'oblique']) ifTrue:[
+"/ xlatedStyle := 'italic'
+"/ ]
+"/ ].
+"/ (xlatedStyle = 'italic') ifTrue:[
+"/ xlatedStyle := 'i'
+"/ ] ifFalse:[
+"/ (xlatedStyle = 'roman') ifTrue:[
+"/ xlatedStyle := 'r'
+"/ ] ifFalse:[
+"/ (xlatedStyle = 'oblique') ifTrue:[
+"/ xlatedStyle := 'o'
+"/ ]
+"/ ]
+"/ ].
+"/
+"/ theId := nil.
+"/ theSize := sizeArg.
+"/ [theId isNil] whileTrue:[
+"/ "this works only on Release >= 3 - X-servers"
+"/ enc := encodingSym.
+"/ enc isNil ifTrue:[
+"/ enc := '*'
+"/ ].
+"/ theName := ('-*-' , familyString ,
+"/ '-' , faceString ,
+"/ '-' , xlatedStyle , '-*-*-*-'
+"/ , theSize printString , '0-*-*-*-*-'
+"/ , enc , '-*').
+"/"
+"/Transcript showCr:theName; endEntry.
+"/"
+"/ theId := self createFontFor:theName.
+"/ theId isNil ifTrue:[
+"/ "could not get the font - try next smaller one"
+"/ theSize := theSize - 1.
+"/ (theSize < (sizeArg // 2)) ifTrue:[
+"/ "thats too much - give up"
+"/ ^ self getDefaultFont
+"/ "^ nil"
+"/ ]
+"/ ]
+"/ ].
+"/ (theSize ~~ sizeArg) ifTrue:[
+"/ Transcript show:'next smaller font: '.
+"/ Transcript showCr:theName
+"/ ].
+"/ ^ theId
!
getFontWithFoundry:foundry family:family weight:weight
- slant:slant size:size registry:registry encoding:encoding
+ slant:slant spacing:spc pixelSize:pSize size:size
+ registry:registry encoding:encoding
"get the specified font, if not available, return nil.
This is the new font creation method - all others will be changed to
- use this wntry."
-
- |theName|
+ use this entry.
+ Individual attributes can be left empty (i.e. '') or nil to match any.
+
+ foundry: 'adobe', 'misc', 'dec', 'schumacher' ... usually '*'
+ family: 'helvetica' 'courier' 'times' ...
+ weight: 'bold' 'medium' 'demi' ...
+ slant: 'r(oman)' 'i(talic)' 'o(blique)'
+ spacing: 'narrow' 'normal' semicondensed' ... usually '*'
+ pixelSize: 16,18 ... usually left empty
+ size: size in point (1/72th of an inch)
+ registry: iso8859, sgi ... '*'
+ "
+
+ |theName sMatch|
"this works only on 'Release >= 3' - X-servers"
- theName := ('-' , foundry ,
- '-' , family ,
- '-' , weight ,
- '-' , slant ,
- '-*-*-*' ,
- '-' , size printString , '0' ,
+ "name is:
+ -foundry-family -weight -slant-
+ sony helvetica bold r
+ adobe courier medium i
+ msic fixed o
+ ... ...
+ "
+
+ size isNil ifTrue:[sMatch := '*'] ifFalse:[sMatch := size printString , '0'].
+
+ theName := ('-' , (foundry isNil ifTrue:['*'] ifFalse:[foundry]),
+ '-' , (family isNil ifTrue:['*'] ifFalse:[family]),
+ '-' , (weight isNil ifTrue:['*'] ifFalse:[weight]) ,
+ '-' , (slant isNil ifTrue:['*'] ifFalse:[slant]) ,
+ '-' , (spc isNil ifTrue:['*'] ifFalse:[spc]) ,
+ '-*' ,
+ '-' , (pSize isNil ifTrue:['*'] ifFalse:[pSize printString]),
+ '-' , sMatch ,
'-*-*-*-*' ,
- '-' , registry ,
- '-' , encoding).
+ '-' , (registry isNil ifTrue:['*'] ifFalse:[registry]) ,
+ '-' , (encoding isNil ifTrue:['*'] ifFalse:[encoding])).
Transcript showCr:theName; endEntry.
^ self createFontFor:theName.
@@ -5336,7 +5380,7 @@
#ifdef OLD
/* these may not be disabled */
mask |= ExposureMask | StructureNotifyMask |
- KeyPressMask |
+ KeyPressMask | KeyReleaseMask |
ButtonPressMask | ButtonMotionMask | ButtonReleaseMask;
#endif
--- a/styles/generic.style Fri May 12 20:10:19 1995 +0200
+++ b/styles/generic.style Tue May 16 19:17:11 1995 +0200
@@ -26,7 +26,7 @@
; all of them for new styles.
;
;
-; $Header: /cvs/stx/stx/libview/styles/generic.style,v 1.3 1995-04-11 15:56:14 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/generic.style,v 1.4 1995-05-16 17:15:37 claus Exp $
;
; agenda:
@@ -67,6 +67,10 @@
; if it some type of 3D style
; (affects default levels, borderWidth and spacing between views etc.)
; all styles which have 3D effects should set this to true
+
+comment 'not a usable style\\use as a reference for new styles'
+
+
is3D false
;
@@ -109,14 +113,14 @@
; when drawing shadow and light (3D-effect)
; ignored if is3D is false
;
-shadowColor nil "means: use viewBackground darkened"
-lightColor nil "means: use viewBackground lightened"
-halfShadowColor nil "means: some default"
-halfLightColor nil "means: some default"
+shadowColor nil "nil means: use viewBackground darkened"
+lightColor nil "nil means: use viewBackground lightened"
+halfShadowColor nil "nil means: some default"
+halfLightColor nil "nil means: some default"
;
; how are views highlighted when the focus is stepped
-; via the keyboard (Ctrl-CursorRight / Ctrl-CursorLeft) ?
+; via the keyboard (#FocusNext i.e. Ctrl-CursorRight / #FocusPrevious i.e. Ctrl-CursorLeft) ?
;
focusColor Color red "red is the default anyway"
focusBorderWidth 2 "2 is the default anyway"
@@ -156,20 +160,24 @@
; pullDownMenu takes menu style if not specified otherwise
;
pullDownMenuViewBackground =menuViewBackground
+pullDownMenuForegroundColor =menuForegroundColor
+pullDownMenuBackgroundColor =menuBackgroundColor
pullDownMenuHilightForegroundColor =menuHilightForegroundColor
pullDownMenuHilightBackgroundColor =menuHilightBackgroundColor
pullDownMenuShadowColor =menuShadowColor
pullDownMenuLightColor =menuLightColor
-pullDownMenuForegroundColor =menuForegroundColor
-pullDownMenuBackgroundColor =menuBackgroundColor
pullDownMenuFont =menuFont
pullDownMenuEdgeStyle nil "or #soft"
+pullDownMenuSeparatingLines true
+pullDownMenuLevel 1
+pullDownMenuHilightLevel =menuHilightLevel "ifnil: 0"
;
;if true, menu stays pulled if button is released (as in motif, mswindows)
;otherwise, it hides itself on button release.
;
pullDownMenuKeepMenu false
+pullDownMenuToggleKeep false
;
; label defaults
@@ -182,32 +190,35 @@
;
; buttons, toggles etc.
;
-buttonFont nil "means: use font"
-buttonEdgeStyle nil "or #soft"
-buttonBorderWidth nil "means: use value of borderWidth"
+buttonFont nil "nil means: use font"
+buttonEdgeStyle nil "or #soft"
+buttonBorderWidth nil "nil means: use value of borderWidth"
buttonActiveLevel -1
buttonPassiveLevel 1
-buttonForegroundColor nil "means: use label-value"
-buttonBackgroundColor nil "means: use label-value"
-buttonFont nil "means: use label-value"
+buttonForegroundColor nil "nil means: use label-value"
+buttonBackgroundColor nil "nil means: use label-value"
+buttonFont nil "nil means: use label-value"
buttonDisabledForegroundColor Color grey
-buttonDisabledBackgroundColor nil "means: use bgColor"
-buttonEnteredForegroundColor nil "means: use fgColor"
-buttonEnteredBackgroundColor nil "means: use bgColor"
-buttonActiveForegroundColor nil "means: use fgColor"
-buttonActiveBackgroundColor nil "means: use bgColor"
-buttonReturnButtonHasImage true
-buttonReturnButtonHasBorder false
+buttonDisabledBackgroundColor nil "nil means: use bgColor"
+buttonEnteredForegroundColor nil "nil means: use fgColor"
+buttonEnteredBackgroundColor nil "nil means: use bgColor"
+buttonActiveForegroundColor nil "nil means: use fgColor"
+buttonActiveBackgroundColor nil "nil means: use bgColor"
+buttonReturnButtonHasImage true "place a return-icon into defaultButtons"
+buttonReturnButtonHasBorder false "place a border around defaultButtons"
; arrow buttons in scrollBars
;
-arrowButtonStyle nil "choose one of (#st80 #motif #mswindows nil)"
-arrowButtonForegroundColor nil
-arrowButtonActiveForegroundColor nil
-arrowButtonUpFormFile 'ScrollUp.xbm'
-arrowButtonDownFormFile 'ScrollDn.xbm'
-arrowButtonLeftFormFile 'ScrollLt.xbm'
-arrowButtonRightFormFile 'ScrollRt.xbm'
+arrowButtonStyle nil "choose one of (#st80 #motif #mswindows nil)"
+arrowButtonForegroundColor nil "nil means: use buttons default"
+arrowButtonActiveForegroundColor nil "nil means: use buttons default"
+arrowButtonActiveBackgroundColor nil "nil means: use buttons default"
+arrowButtonUpFormFile 'ScrollUp.xbm'
+arrowButtonDownFormFile 'ScrollDn.xbm'
+arrowButtonLeftFormFile 'ScrollLt.xbm'
+arrowButtonRightFormFile 'ScrollRt.xbm'
+arrowButtonActiveLevel nil "nil means: use buttons default"
+arrowButtonPassiveLevel nil "nil means: use buttons default"
;
; show a little lamp (a la IRIS) in toggles ?
@@ -219,6 +230,8 @@
; the color of checkmarks (normally black; IRIS shows them red)
;
checkToggleCheckColor Color black
+checkToggleBitmapFile 'CheckOn.xbm'
+checkToggleStyle #cross "or #check only taken if file is nil"
;
; text view backgrounds - this is not the same as
@@ -309,14 +322,15 @@
;
; scrollbar position in scrolled views
;
-scrollBarPosition #left "#right"
+scrollBarPosition #left "or: #right"
;
; scrollbars
;
-scrollBarButtonPositions #around "#top #bottom"
-scrollBarLevel 0
-scrollBarElementSpacing 0
+scrollBarButtonPositions #around "or: #top #bottom"
+scrollBarLevel 0 "level of scrollBar"
+scrollBarElementSpacing 0 "spacing betwen buttons & thumb"
+scrollBarDisableButtons false "shall we disable buttons if appropriate"
;
; scrollers (also used in scrollBars)
@@ -340,7 +354,7 @@
;
sliderNTallyMarks 1
sliderTallyLevel -1
-sliderLevel nil "means inherit from scroller"
+sliderLevel nil "nil means: means inherit from scroller"
;
; framed boxes
@@ -348,9 +362,9 @@
framedBoxForegroundColor Color black
framedBoxLabelPosition #topCenter "#topLeft #topRight #bottomLeft #bottomCenter #bottomRight"
-rulerForegroundColor nil "use foregroundColor or Black or White"
-rulerBackgroundColor nil "use viewBackground"
-rulerMetric nil "use #mm for german, #inch for all others"
+rulerForegroundColor nil "nil means: use foregroundColor or Black or White"
+rulerBackgroundColor nil "nil means: use viewBackground"
+rulerMetric nil "nil means: use #mm for german, #inch for all others"
;
; dialog boxes
--- a/styles/greenPC.style Fri May 12 20:10:19 1995 +0200
+++ b/styles/greenPC.style Tue May 16 19:17:11 1995 +0200
@@ -10,10 +10,12 @@
; On my SGI, this one looks great; on VGA's, the colors come out
; a bit too dark.
;
-; $Header: /cvs/stx/stx/libview/styles/greenPC.style,v 1.1 1995-03-23 16:54:38 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/greenPC.style,v 1.2 1995-05-16 17:15:40 claus Exp $
#include 'motif.style'
+comment 'like motif style;\\with different viewbackground'
+
#if Display hasGreyscales
wooden (Image fromFile:'bitmaps/wood2H.tiff')
granite (Image fromFile:'bitmaps/granite.tiff')
--- a/styles/iris.style Fri May 12 20:10:19 1995 +0200
+++ b/styles/iris.style Tue May 16 19:17:11 1995 +0200
@@ -3,7 +3,9 @@
; silicon graphics style
; (somwehat like motif, but with smooth edges and bells&whistles)
;
-; $Header: /cvs/stx/stx/libview/styles/iris.style,v 1.2 1995-03-31 02:59:23 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/iris.style,v 1.3 1995-05-16 17:15:43 claus Exp $
+
+comment 'Silicon graphics'' iris look alike'
is3D true
name #iris
--- a/styles/iris_light.style Fri May 12 20:10:19 1995 +0200
+++ b/styles/iris_light.style Tue May 16 19:17:11 1995 +0200
@@ -6,6 +6,8 @@
#include 'iris.style'
+comment 'like iris.style;\\with brighter colors (better on some VGAs)'
+
viewGrey Color grey:80
viewBackground =viewGrey
scrollerThumbColor =viewGrey
--- a/styles/motif.style Fri May 12 20:10:19 1995 +0200
+++ b/styles/motif.style Tue May 16 19:17:11 1995 +0200
@@ -7,7 +7,7 @@
; on VGA displays, where the colors are a bit darkish,
; use motif_light
;
-; $Header: /cvs/stx/stx/libview/styles/motif.style,v 1.1 1995-03-23 16:54:42 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/motif.style,v 1.2 1995-05-16 17:15:49 claus Exp $
#if Display hasGreyscales
viewGrey Color grey:50
@@ -15,6 +15,8 @@
#include 'motif.common'
+comment 'motif look alike.\\maybe too dark on some VGA screens'
+
fatFont Font family:'helvetica' face:'bold' style:'roman' size:12
selectionFont =fatFont
--- a/styles/motif2.style Fri May 12 20:10:19 1995 +0200
+++ b/styles/motif2.style Tue May 16 19:17:11 1995 +0200
@@ -3,11 +3,13 @@
; just a demo:
; like motif, but with different (red) menu-hilighting
;
-; $Header: /cvs/stx/stx/libview/styles/motif2.style,v 1.1 1995-03-23 16:54:44 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/motif2.style,v 1.2 1995-05-16 17:15:52 claus Exp $
#include 'motif.style'
+comment 'like motif.style;\\with changed menu & selection colors'
+
menuHilightForegroundColor Color white
menuHilightBackgroundColor Color red
menuHilightLevel 1
--- a/styles/motif3.style Fri May 12 20:10:19 1995 +0200
+++ b/styles/motif3.style Tue May 16 19:17:11 1995 +0200
@@ -4,11 +4,13 @@
; like motif, but with different menu-hilighting
; (yellow text on grey - looks like lighted with a lamp from behind ...)
;
-; $Header: /cvs/stx/stx/libview/styles/motif3.style,v 1.1 1995-03-23 16:54:46 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/motif3.style,v 1.2 1995-05-16 17:15:55 claus Exp $
#include 'motif.style'
+comment 'like motif.style;\\with changed menu, selection & button colors'
+
menuHilightForegroundColor Color yellow
menuHilightBackgroundColor =viewGrey
menuHilightLevel 0
@@ -27,4 +29,3 @@
buttonActiveForegroundColor Color yellow
buttonForegroundColor Color black
-
--- a/styles/motif_blue.style Fri May 12 20:10:19 1995 +0200
+++ b/styles/motif_blue.style Tue May 16 19:17:11 1995 +0200
@@ -8,7 +8,7 @@
; on VGA displays, where the colors are a bit darkish,
; use motif_blue_light
;
-; $Header: /cvs/stx/stx/libview/styles/motif_blue.style,v 1.1 1995-03-23 16:54:48 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/motif_blue.style,v 1.2 1995-05-16 17:15:58 claus Exp $
#if Display hasGreyscales
viewGrey Color red:15 green:20 blue:45
@@ -16,6 +16,8 @@
#include 'motif.common'
+comment 'like motif.style;\\with blueish colors'
+
selectionForegroundColor Color white
selectionBackgroundColor =shadowColor
selectionShadowColor Color black "/ =shadowColor darkened
--- a/styles/motif_blue_light.style Fri May 12 20:10:19 1995 +0200
+++ b/styles/motif_blue_light.style Tue May 16 19:17:11 1995 +0200
@@ -8,7 +8,7 @@
; use this (instead of motif_blue) on VGA displays,
; where the colors are a bit darkish
;
-; $Header: /cvs/stx/stx/libview/styles/motif_blue_light.style,v 1.1 1995-03-23 16:54:49 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/motif_blue_light.style,v 1.2 1995-05-16 17:16:01 claus Exp $
#if Display hasGreyscales
viewGrey Color red:22 green:30 blue:67
@@ -16,6 +16,8 @@
#include 'motif.common'
+comment 'like motif.style;\\with brighter blueish colors'
+
selectionForegroundColor Color white
selectionBackgroundColor =shadowColor
selectionShadowColor Color black "/ =shadowColor darkened
--- a/styles/motif_blue_red.style Fri May 12 20:10:19 1995 +0200
+++ b/styles/motif_blue_red.style Tue May 16 19:17:11 1995 +0200
@@ -5,10 +5,12 @@
; another demo - not good to work with
; (thats how the views look in the style-guide ;-)
;
-; $Header: /cvs/stx/stx/libview/styles/motif_blue_red.style,v 1.1 1995-03-23 16:54:53 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/motif_blue_red.style,v 1.2 1995-05-16 17:16:04 claus Exp $
#include 'motif_blue.style'
+comment 'like motif.style;\\with blueish colors and red menus'
+
menuForegroundColor Color white
menuBackgroundColor Color red:45 green:5 blue:5
menuShadowColor =menuBackgroundColor darkened
--- a/styles/motif_dec.style Fri May 12 20:10:19 1995 +0200
+++ b/styles/motif_dec.style Tue May 16 19:17:11 1995 +0200
@@ -4,7 +4,7 @@
; like motif, but using different colors
;
;
-; $Header: /cvs/stx/stx/libview/styles/motif_dec.style,v 1.1 1995-03-23 16:54:55 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/motif_dec.style,v 1.2 1995-05-16 17:16:07 claus Exp $
#if Display hasGreyscales
# if Display hasColors
@@ -18,6 +18,8 @@
#include 'motif.common'
+comment 'DEC motif look alike\\like motif.style with brownish colors'
+
menuFont Font family:'helvetica' face:'medium' style:'roman' size:14
#if Display hasColors
--- a/styles/motif_dec2.style Fri May 12 20:10:19 1995 +0200
+++ b/styles/motif_dec2.style Tue May 16 19:17:11 1995 +0200
@@ -4,7 +4,7 @@
; like motif, but using different (brown, pessimistic) colors
;
;
-; $Header: /cvs/stx/stx/libview/styles/motif_dec2.style,v 1.1 1995-03-23 16:54:57 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/motif_dec2.style,v 1.2 1995-05-16 17:16:10 claus Exp $
#if Display hasGreyscales
# if Display hasColors
@@ -18,6 +18,8 @@
#include 'motif.common'
+comment 'another DEC motif look alike\\like motif.style - with blueish colors'
+
menuFont Font family:'helvetica' face:'medium' style:'roman' size:14
#if Display hasColors
--- a/styles/motif_left.style Fri May 12 20:10:19 1995 +0200
+++ b/styles/motif_left.style Tue May 16 19:17:11 1995 +0200
@@ -3,10 +3,12 @@
; like motif, but with scrollbars at the left side
; (I am used to it)
;
-; $Header: /cvs/stx/stx/libview/styles/motif_left.style,v 1.1 1995-03-23 16:54:59 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/motif_left.style,v 1.2 1995-05-16 17:16:13 claus Exp $
#include 'motif.style'
+comment 'like motif.style\\scrollbars on the left'
+
scrollBarPosition #left
--- a/styles/motif_left_light.style Fri May 12 20:10:19 1995 +0200
+++ b/styles/motif_left_light.style Tue May 16 19:17:11 1995 +0200
@@ -3,10 +3,12 @@
; like motif_light, but with scrollbars at the left side
; (I am used to it)
;
-; $Header: /cvs/stx/stx/libview/styles/motif_left_light.style,v 1.1 1995-03-23 16:55:01 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/motif_left_light.style,v 1.2 1995-05-16 17:16:17 claus Exp $
#include 'motif_light.style'
+comment 'like motif.style;\\brighter colors & scrollbars on the left'
+
scrollBarPosition #left
--- a/styles/motif_light.style Fri May 12 20:10:19 1995 +0200
+++ b/styles/motif_light.style Tue May 16 19:17:11 1995 +0200
@@ -5,7 +5,7 @@
; use this (instead of motif) on VGA displays,
; where the colors are a bit darkish
;
-; $Header: /cvs/stx/stx/libview/styles/motif_light.style,v 1.3 1995-05-12 18:10:19 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/motif_light.style,v 1.4 1995-05-16 17:16:20 claus Exp $
;
#if Display hasGreyscales
@@ -14,6 +14,8 @@
#include 'motif.common'
+comment 'like motif.style\\with brighter colors'
+
lightColor Color grey:80
shadowColor Color grey:25
--- a/styles/motif_red.style Fri May 12 20:10:19 1995 +0200
+++ b/styles/motif_red.style Tue May 16 19:17:11 1995 +0200
@@ -8,7 +8,7 @@
; on VGA displays, where the colors are a bit darkish,
; use motif_red_light
;
-; $Header: /cvs/stx/stx/libview/styles/motif_red.style,v 1.1 1995-03-23 16:55:05 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/motif_red.style,v 1.2 1995-05-16 17:16:23 claus Exp $
#if Display hasGreyscales
viewGrey Color red:45 green:5 blue:5
@@ -16,6 +16,8 @@
#include 'motif.common'
+comment 'like motif.style\\with redish colors'
+
selectionForegroundColor Color white
selectionBackgroundColor =shadowColor
selectionShadowColor Color black "/ =shadowColor darkened
--- a/styles/motif_redButtons.style Fri May 12 20:10:19 1995 +0200
+++ b/styles/motif_redButtons.style Tue May 16 19:17:11 1995 +0200
@@ -2,13 +2,14 @@
;
; just an example - take motif-style as a base, change buttons to red
;
-; $Header: /cvs/stx/stx/libview/styles/motif_redButtons.style,v 1.1 1995-03-23 16:55:06 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/motif_redButtons.style,v 1.2 1995-05-16 17:16:26 claus Exp $
#include 'motif.style'
+comment 'like motif.style\\with redish buttons'
-buttonRed Color red:45 green:5 blue:5
+buttonRed Color red:45 green:5 blue:5
buttonBackgroundColor =buttonRed
buttonActiveBackgroundColor =buttonRed lightened
--- a/styles/motif_red_light.style Fri May 12 20:10:19 1995 +0200
+++ b/styles/motif_red_light.style Tue May 16 19:17:11 1995 +0200
@@ -8,7 +8,7 @@
; use this (instead of motif_red) on VGA displays,
; where the colors are a bit darkish
;
-; $Header: /cvs/stx/stx/libview/styles/motif_red_light.style,v 1.1 1995-03-23 16:55:09 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/motif_red_light.style,v 1.2 1995-05-16 17:16:28 claus Exp $
#if Display hasGreyscales
viewGrey Color red:67 green:8 blue:8
@@ -16,6 +16,8 @@
#include 'motif.common'
+comment 'like motif.style\\with brighter redish colors'
+
selectionForegroundColor Color white
selectionBackgroundColor =shadowColor
selectionShadowColor Color black "/ =shadowColor darkened
--- a/styles/mswindows.style Fri May 12 20:10:19 1995 +0200
+++ b/styles/mswindows.style Tue May 16 19:17:11 1995 +0200
@@ -2,7 +2,7 @@
;
; this is not yet completed
;
-; $Header: /cvs/stx/stx/libview/styles/mswindows.style,v 1.1 1995-03-23 16:55:10 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/mswindows.style,v 1.2 1995-05-16 17:16:31 claus Exp $
;this seems not fully true, buttons
;and scrollers show some 3D.
@@ -12,4 +12,5 @@
#include 'mswindows.common'
+comment 'ms windows look alike'
--- a/styles/mswindows2.style Fri May 12 20:10:19 1995 +0200
+++ b/styles/mswindows2.style Tue May 16 19:17:11 1995 +0200
@@ -7,14 +7,12 @@
; (the name mswindows is still hardcoded in some places ...)
;
;
-; $Header: /cvs/stx/stx/libview/styles/mswindows2.style,v 1.1 1995-03-23 16:55:12 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/mswindows2.style,v 1.2 1995-05-16 17:16:34 claus Exp $
viewGrey Color white
#include 'mswindows.common'
-textViewBackgroundColor Color red:50 green:68 blue:57
-
+comment 'ms windows look alike;\\with different text background'
-
-
+textViewBackgroundColor Color red:50 green:68 blue:57
--- a/styles/next.style Fri May 12 20:10:19 1995 +0200
+++ b/styles/next.style Tue May 16 19:17:11 1995 +0200
@@ -3,7 +3,9 @@
; NeXT look-alike - almost like motif or iris,
; but with smoother edges and frames around scrollbars and selections
;
-; $Header: /cvs/stx/stx/libview/styles/next.style,v 1.1 1995-03-23 16:55:13 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/next.style,v 1.2 1995-05-16 17:16:37 claus Exp $
+
+comment 'NeXT look alike'
is3D true
name #next
--- a/styles/normal.style Fri May 12 20:10:19 1995 +0200
+++ b/styles/normal.style Tue May 16 19:17:11 1995 +0200
@@ -3,7 +3,9 @@
; the good-old normal 2D style - actually not bad to work
; with. Also the best to use on black&white displays
;
-; $Header: /cvs/stx/stx/libview/styles/normal.style,v 1.1 1995-03-23 16:55:15 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/normal.style,v 1.2 1995-05-16 17:16:40 claus Exp $
+
+comment 'plain good old 2D style'
is3D false
name #normal
--- a/styles/normal2.style Fri May 12 20:10:19 1995 +0200
+++ b/styles/normal2.style Tue May 16 19:17:11 1995 +0200
@@ -2,10 +2,12 @@
;
; like good-old normal style - with some added colors
;
-; $Header: /cvs/stx/stx/libview/styles/normal2.style,v 1.1 1995-03-23 16:55:17 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/normal2.style,v 1.2 1995-05-16 17:16:43 claus Exp $
#include 'normal.style'
+comment 'plain good old 2D style\\with changed selection colors'
+
selectionHilightBackgroundColor Color blue
selectionHilightFrameColor Color black
--- a/styles/oldStyles/AEG_sailer.style Fri May 12 20:10:19 1995 +0200
+++ b/styles/oldStyles/AEG_sailer.style Tue May 16 19:17:11 1995 +0200
@@ -5,9 +5,11 @@
;
; this is Mr. Sailers personal preference ;-)
;
-; $Header: /cvs/stx/stx/libview/styles/oldStyles/AEG_sailer.style,v 1.1 1995-03-23 16:54:21 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/oldStyles/AEG_sailer.style,v 1.2 1995-05-16 17:15:25 claus Exp $
#include 'iris.style'
+comment 'like iris style;\\scrollbars are on the right side'
+
scrollBarPosition #right
--- a/styles/oldStyles/fun_iris.style Fri May 12 20:10:19 1995 +0200
+++ b/styles/oldStyles/fun_iris.style Tue May 16 19:17:11 1995 +0200
@@ -7,11 +7,13 @@
; notice, that the light- and dark brown shadow colors are computed from the bitmaps;
; if you replace them by some (say reddish) image, they will change too.
;
-; $Header: /cvs/stx/stx/libview/styles/oldStyles/fun_iris.style,v 1.1 1995-03-23 16:54:25 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/oldStyles/fun_iris.style,v 1.2 1995-05-16 17:15:28 claus Exp $
;
#include 'iris.style'
+comment 'like iris style;\\with different viewbackground'
+
#viewBackground (Image fromFile:'bitmaps/granite.tiff')
viewBackground (Image fromFile:'bitmaps/granite_small.tiff')
lightColor Color grey:66
--- a/styles/oldStyles/fun_motif.style Fri May 12 20:10:19 1995 +0200
+++ b/styles/oldStyles/fun_motif.style Tue May 16 19:17:11 1995 +0200
@@ -2,11 +2,13 @@
;
; like motif, but with different viewbackground
;
-; $Header: /cvs/stx/stx/libview/styles/oldStyles/fun_motif.style,v 1.1 1995-03-23 16:54:29 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/oldStyles/fun_motif.style,v 1.2 1995-05-16 17:15:31 claus Exp $
#include 'motif.style'
+comment 'like motif style;\\with different viewbackground'
+
#viewBackground (Image fromFile:'bitmaps/granite.tiff')
viewBackground (Image fromFile:'bitmaps/granite_small.tiff')
wooden (Image fromFile:'bitmaps/wood2H.tiff')
--- a/styles/oldStyles/fun_sofia.style Fri May 12 20:10:19 1995 +0200
+++ b/styles/oldStyles/fun_sofia.style Tue May 16 19:17:11 1995 +0200
@@ -4,11 +4,13 @@
; fun style for my little daughter ...
; like motif, but with different view background
;
-; $Header: /cvs/stx/stx/libview/styles/oldStyles/fun_sofia.style,v 1.1 1995-03-23 16:54:31 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/oldStyles/fun_sofia.style,v 1.2 1995-05-16 17:15:33 claus Exp $
#include 'motif.style'
+comment 'like motif style;\\with changed viewbackground (kids love it)'
+
shadowColor Color black
lightColor Color lightGrey
@@ -22,5 +24,3 @@
scrollerViewBackground =viewBackground
buttonActiveBackgroundColor =viewBackground
buttonActiveForegroundColor Color white
-
-
--- a/styles/oldStyles/rocky.style Fri May 12 20:10:19 1995 +0200
+++ b/styles/oldStyles/rocky.style Tue May 16 19:17:11 1995 +0200
@@ -5,10 +5,12 @@
; needs some rework to make text readable in selectionInListViews
; and menus.
;
-; $Header: /cvs/stx/stx/libview/styles/oldStyles/rocky.style,v 1.1 1995-03-23 16:55:22 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/oldStyles/rocky.style,v 1.2 1995-05-16 17:16:53 claus Exp $
#include 'motif.style'
+comment 'like motif - with rock solid views'
+
shadowColor Color black
lightColor Color lightGrey
--- a/styles/oldStyles/rocky2.style Fri May 12 20:10:19 1995 +0200
+++ b/styles/oldStyles/rocky2.style Tue May 16 19:17:11 1995 +0200
@@ -5,11 +5,13 @@
; needs some rework to make text readable in selectionInListViews
; and menus.
;
-; $Header: /cvs/stx/stx/libview/styles/oldStyles/rocky2.style,v 1.1 1995-03-23 16:55:24 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/oldStyles/rocky2.style,v 1.2 1995-05-16 17:16:56 claus Exp $
#include 'motif.style'
+comment 'like motif\with rock solid views\and changed selection colors'
+
shadowColor Color black
lightColor Color lightGrey
@@ -38,4 +40,3 @@
buttonActiveBackgroundColor =brightGranite
buttonForegroundColor Color grey:80
buttonBackgroundColor =brightGranite
-
--- a/styles/oldStyles/rocky3.style Fri May 12 20:10:19 1995 +0200
+++ b/styles/oldStyles/rocky3.style Tue May 16 19:17:11 1995 +0200
@@ -3,11 +3,13 @@
; rock solid windows (flintstones ?)
; fun style; like motif, but with different view background
;
-; $Header: /cvs/stx/stx/libview/styles/oldStyles/rocky3.style,v 1.1 1995-03-23 16:55:26 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/oldStyles/rocky3.style,v 1.2 1995-05-16 17:16:59 claus Exp $
#include 'motif.style'
+comment 'like motif - with rock solid views'
+
viewBackground (Image fromFile:'bitmaps/granite2.tiff')
shadowColor Color black
--- a/styles/oldStyles/rocky_yellow.style Fri May 12 20:10:19 1995 +0200
+++ b/styles/oldStyles/rocky_yellow.style Tue May 16 19:17:11 1995 +0200
@@ -3,11 +3,13 @@
; rock solid windows (flintstones ?)
; fun style; like motif, but with different view background
;
-; $Header: /cvs/stx/stx/libview/styles/oldStyles/rocky_yellow.style,v 1.1 1995-03-23 16:55:28 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/oldStyles/rocky_yellow.style,v 1.2 1995-05-16 17:17:02 claus Exp $
#include 'motif.style'
+comment 'like motif;\with rock solid views\and changed selection color'
+
shadowColor Color black
lightColor Color lightGrey
--- a/styles/openwin.style Fri May 12 20:10:19 1995 +0200
+++ b/styles/openwin.style Tue May 16 19:17:11 1995 +0200
@@ -4,9 +4,11 @@
; are not openwin-like (and since SUN dropped openwin, no
; effort will probably ever be spent on changing this).
;
-; $Header: /cvs/stx/stx/libview/styles/openwin.style,v 1.1 1995-03-23 16:55:19 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/openwin.style,v 1.2 1995-05-16 17:16:47 claus Exp $
;
+comment 'SUN openwin look alike'
+
is3D true
name #openwin
--- a/styles/os2.style Fri May 12 20:10:19 1995 +0200
+++ b/styles/os2.style Tue May 16 19:17:11 1995 +0200
@@ -2,26 +2,44 @@
;
; this is not yet completed
;
-; $Header: /cvs/stx/stx/libview/styles/os2.style,v 1.1 1995-03-23 16:55:20 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/os2.style,v 1.2 1995-05-16 17:16:50 claus Exp $
+
+comment 'OS/2 look alike'
is3D true
name #os2
-viewGrey Color grey:67
+; viewGrey Color grey:80
+; darkerGrey Color grey:67
+viewGrey Color grey:67
+darkerGrey Color grey:50
+yellow Color red:100 green:100 blue:70
+
+
borderWidth 0
viewBackground =viewGrey
+fatFont Font family:'variable' face:nil style:nil size:nil encoding:nil "/ Font family:'helvetica' face:'bold' style:'roman' size:12
+thinFont Font family:'helvetica' face:'medium' style:'roman' size:12
+
scrollBarPosition #right
scrollBarButtonPositions #around
-scrollBarLevel 0
+scrollBarLevel -1
scrollBarElementSpacing 0
+scrollBarDisableButtons true
-scrollerLevel 1
-scrollerViewBackground =viewGrey
-scrollerThumbColor Color black
-scrollerThumbLevel 0
-scrollerThumbInset 3
+scrollerLevel 0
+scrollerViewBackground =darkerGrey
+scrollerThumbColor =viewGrey
+scrollerThumbLevel 1
+scrollerThumbInset 0
+
+buttonEdgeStyle #soft
+buttonActiveLevel -1
+buttonPassiveLevel 3
+buttonReturnButtonHasBorder true
+buttonActiveBackgroundColor =darkerGrey
textCursorType #solidCaret
textCursorBackgroundColor Color black
@@ -30,11 +48,50 @@
popupShadowColor Color black
popupBorderWidth 1
-arrowButtonStyle #os2
-arrowButtonForegroundColor Color white
+arrowButtonStyle #os2
+arrowButtonForegroundColor Color black
arrowButtonActiveForegroundColor Color white
arrowButtonActiveBackgroundColor =viewGrey
+arrowButtonUpFormFile 'ScrollUp.os2.14.xbm'.
+arrowButtonDownFormFile 'ScrollDn.os2.14.xbm'.
+arrowButtonLeftFormFile 'ScrollLt.os2.14.xbm'.
+arrowButtonRightFormFile 'ScrollRt.os2.14.xbm'.
+arrowButtonActiveLevel -1 "/ 0
+arrowButtonPassiveLevel 1
-selectionFont Font family:'helvetica' face:'medium' style:'roman' size:12
+buttonDisabledForegroundColor Color white
+
+checkToggleCheckColor Color black
+
+selectionFont =fatFont
+labelFont =thinFont
+
+selectionBackgroundColor =yellow
+selectionHilightForegroundColor Color white
+selectionHilightBackgroundColor Color grey:50
+selectionHilightFrameColor Color grey:25
+selectionHilightLevel 0
+selectionRightArrowLevel 0
+
+editFieldBackgroundColor =yellow
+editFieldSelectionBackgroundColor Color black
+editFieldSelectionForegroundColor Color white
+;
+; since menus inherit from selectionInList,
+; redefine the yellow settings ...
+;
+menuBackgroundColor =viewGrey
+menuShadowColor =menuBackgroundColor darkened
+menuLightColor =menuBackgroundColor lightened
+menuHilightForegroundColor Color white
+menuHilightBackgroundColor =darkerGrey
+menuHilightLevel 2
+menuViewBackground =viewGrey
+pullDownMenuFont =selectionFont
+pullDownMenuSeparatingLines false
+pullDownMenuLevel 0
+pullDownMenuHilightLevel 2
+pullDownMenuKeepMenu true
+; pullDownMenuToggleKeep true
--- a/styles/show_buttons.style Fri May 12 20:10:19 1995 +0200
+++ b/styles/show_buttons.style Tue May 16 19:17:11 1995 +0200
@@ -5,11 +5,12 @@
;
; notice, that the light- and shadow colors are computed from the bitmaps;
;
-; $Header: /cvs/stx/stx/libview/styles/Attic/show_buttons.style,v 1.1 1995-03-23 16:55:30 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/Attic/show_buttons.style,v 1.2 1995-05-16 17:17:05 claus Exp $
;
#include 'mswindows.style'
+comment 'like mswindows;\\with stony buttons'
rock (Image fromFile:'bitmaps/granite_small.tiff')
rockShadow =rock darkened
@@ -23,4 +24,3 @@
buttonActiveLevel -5
buttonPassiveLevel 5
-
--- a/styles/st80.style Fri May 12 20:10:19 1995 +0200
+++ b/styles/st80.style Tue May 16 19:17:11 1995 +0200
@@ -2,7 +2,9 @@
;
; simulation of the old st80 style - looks somewhat like os2
;
-; $Header: /cvs/stx/stx/libview/styles/st80.style,v 1.1 1995-03-23 16:55:31 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/st80.style,v 1.2 1995-05-16 17:17:08 claus Exp $
+
+comment 'old ST80 3D look alike'
name #st80
--- a/styles/st80_left.style Fri May 12 20:10:19 1995 +0200
+++ b/styles/st80_left.style Tue May 16 19:17:11 1995 +0200
@@ -3,10 +3,12 @@
; like st80, but with scrollbars at the left side
; (I am used to it)
;
-; $Header: /cvs/stx/stx/libview/styles/st80_left.style,v 1.2 1995-03-25 22:17:13 claus Exp $
+; $Header: /cvs/stx/stx/libview/styles/st80_left.style,v 1.3 1995-05-16 17:17:11 claus Exp $
#include 'st80.style'
+comment 'old ST80 3D look alike;\\with scrollbars on the left'
+
name #st80
scrollBarPosition #left