hg/stx-libview: comparison DeviceWorkstation.st

equal deleted inserted replaced

-:8f9c629a4245
+:ea2bf46eb669
 DeviceWorkstation comment:'
 COPYRIGHT (c) 1993 by Claus Gittinger
 	      All Rights Reserved
-$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.22 1994-11-28 21:00:42 claus Exp $
+$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.23 1995-02-06 00:36:13 claus Exp $
 '!
 !DeviceWorkstation class methodsFor:'documentation'!
 copyright
 "
 !
 version
 "
-$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.22 1994-11-28 21:00:42 claus Exp $
+$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.23 1995-02-06 00:36:13 claus Exp $
 "
 !
 documentation
 "
 setInputFocusTo:aWindowId
 ^ self subclassResponsibility
 ! !
-!DeviceWorkstation methodsFor:'enumeration'!
+!DeviceWorkstation methodsFor:'enumerating'!
 allViewsDo:aBlock
 "evaluate the argument, aBlock for all known views"
 "/    idToViewMapping notNil ifTrue:[
 sendKeyPress:untranslatedKey x:x y:y to:someone
 "forward a key-press event to some handler;
 the key is translated via the translation table here."
-|xlatedKey|
+|xlatedKey delegate dest|
 xlatedKey := self translateKey:untranslatedKey.
 xlatedKey notNil ifTrue:[
-	someone delegate notNil ifTrue:[
+	(delegate := someone delegate) notNil ifTrue:[
-	    someone delegate keyPress:xlatedKey x:x y:y view:someone
+	    delegate keyPress:xlatedKey x:x y:y view:someone
 	] ifFalse:[
-	    someone keyPress:xlatedKey x:x y:y
+	    (dest := someone controller) isNil ifTrue:[
+		dest := someone
+	    ].
+	    dest keyPress:xlatedKey x:x y:y
 	]
 ]
 !
 sendKeyRelease:untranslatedKey x:x y:y to:someone
 "forward a key-release event to some handler;
 the key is translated via the translation table here."
-|xlatedKey|
+|xlatedKey delegate dest|
 xlatedKey := self translateKey:untranslatedKey.
 xlatedKey notNil ifTrue:[
-	someone delegate notNil ifTrue:[
+	(delegate := someone delegate) notNil ifTrue:[
-	    someone delegate keyRelease:xlatedKey x:x y:y view:someone
+	    delegate keyRelease:xlatedKey x:x y:y view:someone
 	] ifFalse:[
-	    someone keyRelease:xlatedKey x:x y:y
+	    (dest := someone controller) isNil ifTrue:[
+		dest := someone
+	    ].
+	    dest keyRelease:xlatedKey x:x y:y
 	]
 ]
 !
 translateKey:untranslatedKey
 "Return the key translated via the translation table.
+Your application program should never depend on the values returned
+by this method, but instead use symbolic keys (such as #FindNext).
+Doing so allows easier reconfiguration by changing the translation map
+in the 'smalltalk.rc' or 'display.rc' startup files.
 First, the modifier is prepended, making character X into
 AltX, CtrlX or CmdX (on most systems, no separate Cmd (or Meta)
 key exists; on those we always get AltX).
+If multiple modifiers are active, the symbol becoms the concatenation
+as in AltCtrlq (for control-alt-q). Shift will affect the last component,
+thus the above with shift becoms: AltCtrlQ instead.
+Some keyboards offer both Alt and Meta keys - on those, the first has a
+prefix of Alt, the second has Cmd as prefix. Keyboards with only an Alt
+key will will create prefix codes of Cmd for that.
+For symbolic keys (i.e.Tab, Backspace etc, shift is ignored).
 Then the result is used as a key into the translation keyboardMap
 to get the final return value."
 |xlatedKey|
 xlatedKey := untranslatedKey.
 controlDown ifTrue:[
-	(xlatedKey size == 1) ifTrue:[   "a single character"
+	xlatedKey := ('Ctrl' , xlatedKey asString) asSymbol
-	    xlatedKey := ('Ctrl' , untranslatedKey asString) asSymbol
-	].
 ].
 metaDown ifTrue:[
-	(untranslatedKey isMemberOf:Character) ifTrue:[
+	xlatedKey := ('Cmd' , xlatedKey asString) asSymbol
-	    xlatedKey := ('Cmd' , untranslatedKey asString) asSymbol
-	]
 ].
 altDown ifTrue:[
-	(untranslatedKey isMemberOf:Character) ifTrue:[
+	xlatedKey := ('Alt' , xlatedKey asString) asSymbol
-	    xlatedKey := ('Alt' , untranslatedKey asString) asSymbol
-	]
 ].
 xlatedKey := keyboardMap valueFor:xlatedKey.
 ^ xlatedKey
 ! !
 allFonts := self listOfAvailableFonts.
 allFonts isNil ifTrue:[^ nil].
 families := Set new.
 allFonts do:[:fntDescr |
-"/ old:
-"/        family := fntDescr at:1.
-"/ new:
 	family := fntDescr family.
 	family notNil ifTrue:[
 	    families add:family
 	]
 ].
-^ families
+^ families asSortedCollection
 "
 Display fontFamilies
 "
 !
 allFonts := self listOfAvailableFonts.
 allFonts isNil ifTrue:[^ nil].
 faces := Set new.
 allFonts do:[:fntDescr |
-"/ old:
-"/        family := fntDescr at:1.
-"/        (family = aFamilyName) ifTrue:[
-"/            face := fntDescr at:2.
-"/            faces add:face
-"/        ]
-"/ new:
 	aFamilyName = fntDescr family ifTrue:[
 	    faces add:(fntDescr face)
 	]
 ].
-^ faces
+^ faces asSortedCollection
 "
 Display facesInFamily:'times'
 Display facesInFamily:'fixed'
 "
 allFonts := self listOfAvailableFonts.
 allFonts isNil ifTrue:[^ nil].
 styles := Set new.
 allFonts do:[:fntDescr |
-"/ old:
-"/        family := fntDescr at:1.
-"/        (family = aFamilyName) ifTrue:[
-"/            face := fntDescr at:2.
-"/            (face = aFaceName) ifTrue:[
-"/                style := fntDescr at:3.
-"/                styles add:style
-"/            ]
-"/        ]
 	(aFamilyName = fntDescr family) ifTrue:[
 	    (aFaceName = fntDescr face) ifTrue:[
 		styles add:fntDescr style
 	    ]
 	]
 ].
-^ styles
+^ styles asSortedCollection
 "
 Display stylesInFamily:'times' face:'medium'
 Display stylesInFamily:'times' face:'bold'
 "
 "change color in map at:index to rgb (0..100)"
 ^ self subclassResponsibility
 !
+redComponentOfColor:colorId
+"get red component (0..100) of color in map at:index"
+self getRGBFrom:colorId into:[:r :g :b | ^ r]
+!
+greenComponentOfColor:colorId
+"get green component (0..100) of color in map at:index"
+self getRGBFrom:colorId into:[:r :g :b | ^ g]
+!
+blueComponentOfColor:colorId
+"get blue component (0..100) of color in map at:index"
+self getRGBFrom:colorId into:[:r :g :b | ^ b]
+!
 getRGBFromName:colorName into:aBlock
 "get rgb components (0..100) of color named colorName,
 and evaluate the 3-arg block, aBlock with them.
 The method here only handles some often used colors;
 getRGBFromName should not be used, since colorNames other

changeset 89	ea2bf46eb669
parent 86	032006651226
child 94	8931597dfa3c