--- a/Color.st Wed Jun 25 11:13:58 2014 +0100
+++ b/Color.st Mon Sep 08 16:53:24 2014 +0100
@@ -53,6 +53,12 @@
which will return a color with the same rgb values as the receiver but specific
for that device.
+ Most of the device dependent coding was to support limited graphics devices (non-true color)
+ in a transparent way. This was required at that time (late 80's, early 90's),
+ but is now almost obsolete, as these days, virtually any graphic systems supports it.
+ It is arguably, if that stuff should remain here, or if we should simply give up support
+ for old VGA-like displays.
+
Colors can be pure or dithered, depending on the capabilities of the device.
For plain colors, the colorId-instvar is a handle (usually lookup-table entry) for that
device. For dithered colors, the colorId is nil and ditherForm specifies the form
@@ -88,11 +94,11 @@
MaxValue <Integer> r/g/b components are scaled relative to this maximum
Lobby <Registry> all colors in use - keeps track of already allocated
- colors for reuse and finalization.
- (dont use it: this will be moved to the device)
+ colors for reuse and finalization.
+ (dont use it: this will be moved to the device)
Cells <Registry> keeps track of allocated writable color cells
- (dont use it: this will be moved to the device)
+ (dont use it: this will be moved to the device)
FixColors <Array> preallocated colors for dithering on Display
NumRedFix <Integer> number of distinct red values in FixColors
@@ -114,39 +120,39 @@
Blue <Color> blue, for dithering
DitherColors <Collection> some preallocated colors for dithering
- (kept, so they are available when needed)
+ (kept, so they are available when needed)
RetryAllocation <Boolean> this flag controls how a request for a
- color should be handled which failed previously.
- I.e. a color is asked for, which was dithered
- the last time. Since it could happen, that in
- the meantime more colors became free, the request
- might succeed this time - however, your screen may
- look a bit funny, due to having both dithered and
- undithered versions around.
- The default is true, which means: do retry
+ color should be handled which failed previously.
+ I.e. a color is asked for, which was dithered
+ the last time. Since it could happen, that in
+ the meantime more colors became free, the request
+ might succeed this time - however, your screen may
+ look a bit funny, due to having both dithered and
+ undithered versions around.
+ The default is true, which means: do retry
compatibility issues:
- ST-80 seems to represent colors internally with scaled smallInteger
- components (this can be guessed from uses of
- scaledRed:scaledGreen:scaledBlue:). The main instance creation method is
- via 'ColorValue red:green:blue:', passing components in 0..1.
- In ST/X, component are internally represented as percent.
- For more compatibility (when subclassing color), these internals may
- change in the near future. For migration, a compatibility subclass
- called ColorValue is provided.
- After the change, Color will be renamed to ColorValue and Color
- be made a subclass of ColorValue (offering the 0..100 interface for
- backward compatibility).
+ ST-80 seems to represent colors internally with scaled smallInteger
+ components (this can be guessed from uses of
+ scaledRed:scaledGreen:scaledBlue:). The main instance creation method is
+ via 'ColorValue red:green:blue:', passing components in 0..1.
+ In ST/X, component are internally represented as percent.
+ For more compatibility (when subclassing color), these internals may
+ change in the near future. For migration, a compatibility subclass
+ called ColorValue is provided.
+ After the change, Color will be renamed to ColorValue and Color
+ be made a subclass of ColorValue (offering the 0..100 interface for
+ backward compatibility).
[see also:]
- DeviceWorkstation
- GraphicsContext DeviceDrawable Form Image Colormap
- Font Cursor
+ DeviceWorkstation
+ GraphicsContext DeviceDrawable Form Image Colormap
+ Font Cursor
[author:]
- Claus Gittinger
+ Claus Gittinger
"
! !
@@ -3591,8 +3597,8 @@
"return names known as instance creation messages"
^ #(white black
- grey mediumGrey veryLightGrey lightGrey darkGrey veryDarkGrey
- red green blue cyan yellow pink orange magenta)
+ grey mediumGray veryLightGray lightGray darkGray veryDarkGray
+ red green blue cyan yellow pink orange magenta)
"Modified: 2.5.1996 / 11:34:05 / cg"
!
@@ -4473,26 +4479,33 @@
fromLiteralArrayEncoding:encoding
"read my values from an encoding.
The encoding is supposed to be either of the form:
- (#Color redPart greenPart bluePart)
+ (#Color redPart greenPart bluePart)
or:
- (#Color constantColorSymbol)
+ (#Color constantColorSymbol)
This is the reverse operation to #literalArrayEncoding."
- |clr|
+ |clr nameOrRGB|
encoding size == 2 ifTrue:[
- clr := Color perform:(encoding at:2).
- red := clr scaledRed.
- green := clr scaledGreen.
- blue := clr scaledBlue
+ nameOrRGB := encoding at:2.
+ nameOrRGB isSymbol ifTrue:[
+ clr := Color perform:nameOrRGB
+ ] ifFalse:[
+ clr := Color rgbValue:nameOrRGB.
+ ].
+ red := clr scaledRed.
+ green := clr scaledGreen.
+ blue := clr scaledBlue
] ifFalse:[
- red := ((encoding at:2) / 100.0 * MaxValue) rounded.
- green := ((encoding at:3) / 100.0 * MaxValue) rounded.
- blue := ((encoding at:4) / 100.0 * MaxValue) rounded.
+ red := ((encoding at:2) / 100.0 * MaxValue) rounded asInteger.
+ green := ((encoding at:3) / 100.0 * MaxValue) rounded asInteger.
+ blue := ((encoding at:4) / 100.0 * MaxValue) rounded asInteger.
].
"
- Color new fromLiteralArrayEncoding:#(#Color 50 25 25)
+ Color new fromLiteralArrayEncoding:#(#Color 50 25 25)
+ Color new fromLiteralArrayEncoding:#(#Color 16rFF00FF)
+ Color new fromLiteralArrayEncoding:#(#Color blue)
"
!
@@ -4500,14 +4513,14 @@
"encode myself as an array, from which a copy of the receiver
can be reconstructed with #decodeAsLiteralArray.
The encoding is:
- (#Color redPart greenPart bluePart)
+ (#Color redPart greenPart bluePart)
"
^ Array
- with:self class name
- with:(red * 100.0 / MaxValue)
- with:(green * 100.0 / MaxValue)
- with:(blue * 100.0 / MaxValue)
+ with:self class name
+ with:((red * 100.0 / MaxValue) roundTo:0.25)
+ with:((green * 100.0 / MaxValue) roundTo:0.25)
+ with:((blue * 100.0 / MaxValue) roundTo:0.25)
"
Color new fromLiteralArrayEncoding:#(#Color 50 25 25)
@@ -5587,11 +5600,11 @@
!Color class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/Color.st,v 1.230 2014-04-11 14:07:56 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/Color.st,v 1.234 2014-07-24 12:01:04 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/Color.st,v 1.230 2014-04-11 14:07:56 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/Color.st,v 1.234 2014-07-24 12:01:04 cg Exp $'
! !
--- a/DeviceWorkstation.st Wed Jun 25 11:13:58 2014 +0100
+++ b/DeviceWorkstation.st Mon Sep 08 16:53:24 2014 +0100
@@ -1773,6 +1773,10 @@
^ blackColor
+ "
+ Display blackColor
+ "
+
"Created: 13.1.1997 / 22:37:05 / cg"
"Modified: 13.1.1997 / 22:43:19 / cg"
!
@@ -2475,6 +2479,30 @@
"
Display supportsWindowBorder:1
"
+!
+
+supportsXFTFonts
+ "return true, if this device supports xft font rendering.
+ Xft support is being cleaned up, as it is currently a big hack,
+ of which too many others need to know about currently."
+
+ ^ false
+
+ "
+ Display supportsXFTFonts
+ "
+!
+
+supportsXftFonts
+ "return true, if this device supports xft font rendering.
+ Xft support is being cleaned up, as it is currently a big hack,
+ of which too many others need to know about currently."
+
+ ^ false
+
+ "
+ Display supportsXftFonts
+ "
! !
!DeviceWorkstation methodsFor:'accessing-display geometry'!
@@ -3493,9 +3521,9 @@
colorScaledRed:red scaledGreen:green scaledBlue:blue
visualType == #TrueColor ifTrue:[
- ^ (((red bitShift:-8) bitShift:redShift)
- bitOr:((green bitShift:-8) bitShift:greenShift))
- bitOr:((blue bitShift:-8) bitShift:blueShift)
+ ^ (((red asInteger bitShift:-8) bitShift:redShift)
+ bitOr:((green asInteger bitShift:-8) bitShift:greenShift))
+ bitOr:((blue asInteger bitShift:-8) bitShift:blueShift)
].
self subclassResponsibility:'only supported for trueColor displays'
@@ -4641,6 +4669,13 @@
!DeviceWorkstation methodsFor:'event handling'!
+addToKnownScreens
+ AllScreens isNil ifTrue:[
+ AllScreens := IdentitySet new:1
+ ].
+ AllScreens add:self.
+!
+
checkForEndOfDispatch
"return true, if there are still any views of interest -
if not, stop dispatch.
@@ -4960,10 +4995,7 @@
(dispatchProcess notNil and:[dispatchProcess isDead not]) ifTrue:[^ self].
dispatching := true.
- AllScreens isNil ifTrue:[
- AllScreens := IdentitySet new:1
- ].
- AllScreens add:self.
+ self addToKnownScreens.
p := [ self setupDispatchLoop ] newProcess.
@@ -4971,9 +5003,9 @@
"/ give the process a nice name (for the processMonitor)
"/
(nm := self displayName) notNil ifTrue:[
- nm := 'event dispatcher (' , nm , ')'.
+ nm := 'event dispatcher (' , nm , ')'.
] ifFalse:[
- nm := 'event dispatcher'.
+ nm := 'event dispatcher'.
].
p name:nm.
p priority:(Processor userInterruptPriority).
@@ -6105,6 +6137,12 @@
"Modified: 24.4.1996 / 19:38:46 / cg"
!
+nativeWidgets:aBoolean
+ "enable/disable native widgets on a display"
+
+ "/ ignored here
+!
+
reinitialize
"historic leftover (old subclasses call super reinitialize)"
!
@@ -6858,16 +6896,16 @@
!
prependModifierToKey:untranslatedKey
- |xlatedKey s modifier|
+ |xlatedKey s modifier k|
(ctrlDown and:[ metaDown ]) ifTrue:[
- "/ right-ALT: already xlated (I hope)
- ^ untranslatedKey
+ "/ right-ALT: already xlated (I hope)
+ ^ untranslatedKey
].
xlatedKey := untranslatedKey.
xlatedKey isCharacter ifFalse:[
- xlatedKey := xlatedKey asSymbol
+ xlatedKey := xlatedKey asSymbol
].
modifier := self modifierKeyTranslationFor:untranslatedKey.
@@ -6880,37 +6918,45 @@
"/ only prepend, if this is not a modifier (otherwise, we get CmdCmd or CtrlCtrl)
"/
modifier isNil ifTrue:[
- s := xlatedKey asString.
-
- "/ NO, do not prepend the Shift modifier.
- "/ although logical, this makes many keyPress methods incompatible.
- "/ sigh.
+ s := xlatedKey asString.
+
+ "/ NO, do not prepend the Shift modifier.
+ "/ although logical, this makes many keyPress methods incompatible.
+ "/ sigh.
"/ xlatedKey isSymbol ifTrue:[
"/ shiftDown ifTrue:[
"/ xlatedKey := 'Shift' , s
"/ ].
"/ ].
- ctrlDown ifTrue:[
- xlatedKey := 'Ctrl' , s
- ].
- metaDown ifTrue:[ "/ sigh - new hp's have both CMD and META keys.
- xlatedKey := 'Cmd' , s
- ].
- altDown ifTrue:[
- xlatedKey := 'Alt' , s
- ].
- xlatedKey isCharacter ifFalse:[
- "/ no - breaks a lot of code which is not prepared for that
- "/ and checks shiftDown instead...
- "/ shiftDown ifTrue:[
- "/ xlatedKey := 'Shift' , s
- "/].
-
- "/ sigh: twoByteSymbols are not (yet) allowed
- xlatedKey isWideString ifFalse:[
- xlatedKey := xlatedKey asSymbol
- ].
- ].
+ ctrlDown ifTrue:[
+ xlatedKey := 'Ctrl' , s
+ ].
+ metaDown ifTrue:[ "/ sigh - new hp's have both CMD and META keys.
+ xlatedKey := 'Cmd' , s
+ ].
+ altDown ifTrue:[
+ xlatedKey := 'Alt' , s
+ ].
+ xlatedKey isCharacter ifFalse:[
+ "/ prepend Shift modifier
+ "/ if done unconditionally, this breaks a lot of code.
+ "/ which is not prepared for that and checks shiftDown instead.
+ "/ Therefore, this must be changed at the places where shiftDown is checked for!!
+ "/ In the meanwhile, only do it iff there is a translation.
+ Display shiftDown ifTrue:[
+ (k := ('Shift' , s) asSymbolIfInterned) notNil ifTrue:[
+ (self keyboardMap hasBindingFor:k) ifTrue:[
+ xlatedKey := k.
+ "/ Transcript show:k ; show:' -> '; showCR:(self keyboardMap valueFor:k).
+ ]
+ ].
+ ].
+
+ "/ sigh: twoByteSymbols are not (yet) allowed
+ xlatedKey isWideString ifFalse:[
+ xlatedKey := xlatedKey asSymbol
+ ].
+ ].
].
^ xlatedKey
@@ -7220,6 +7266,20 @@
^ self
! !
+!DeviceWorkstation methodsFor:'native window stuff'!
+
+changeButtonState:state in:drawableId
+ self subclassResponsibility
+!
+
+changeLabel:state in:drawableId
+ self subclassResponsibility
+!
+
+enableScrollBar:enableBoolean in:drawableId
+ self subclassResponsibility
+! !
+
!DeviceWorkstation methodsFor:'pointer stuff'!
anyButtonMotionMask
@@ -7409,6 +7469,14 @@
"Created: / 24-08-2010 / 17:23:51 / sr"
!
+supportsNativeWidgetType:aWidgetTypeSymbol
+ ^ false
+
+ "
+ Screen current supportsNativeWidgetType:#Button
+ "
+!
+
supportsNativeWidgets
^ false
@@ -7982,7 +8050,7 @@
!
setCursor:aCursorId in:aWindowId
- "set a windows cursor"
+ "set a window's cursor"
"/ mhmh - could be ignored
^ self subclassResponsibility
@@ -7990,10 +8058,10 @@
setCursors:aCursor
"change the cursor of all views on the receiver device
- to aCursorId, without affecting the views idea of what
- the cursor is (so that it can be restored from the views
+ to aCursorId, without affecting the view's idea of what
+ the cursor is (so that it can be restored from the view's
cursor instance variable later).
- Use of this is not recommended - its better to change
+ Use of this is not recommended - it's better to change
the cursor of a windowGroup alone."
|id|
@@ -8002,14 +8070,14 @@
id := (aCursor onDevice:self) id.
id notNil ifTrue:[
- knownViews validElementsDo:[:aView |
- |vid|
-
- (vid := aView id) notNil ifTrue:[
- self setCursor:id in:vid
- ]
- ].
- self flush
+ knownViews validElementsDo:[:aView |
+ |vid|
+
+ (vid := aView id) notNil ifTrue:[
+ self setCursor:id in:vid
+ ]
+ ].
+ self flush
]
"
@@ -8345,11 +8413,11 @@
!DeviceWorkstation class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.618 2014-06-15 12:04:11 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.622 2014-08-03 12:33:00 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.618 2014-06-15 12:04:11 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.622 2014-08-03 12:33:00 cg Exp $'
! !
--- a/DisplaySurface.st Wed Jun 25 11:13:58 2014 +0100
+++ b/DisplaySurface.st Mon Sep 08 16:53:24 2014 +0100
@@ -546,7 +546,7 @@
withVisibleCursor:aCursor do:aBlock
"evaluate aBlock, showing a aCursor.
Return the value of aBlock.
- Ensure, that the cursor is visible by the user for a minimal amount of time."
+ Ensure, that the cursor is visible for the user for a minimal amount of time."
|ret|
@@ -556,12 +556,12 @@
self
withCursor:aCursor do:[
- |time|
-
- time := Time millisecondsToRun:[ ret := aBlock value].
- time := UserPreferences current waitCursorVisibleTime - time.
- time > 0 ifTrue:[
- Delay waitForMilliseconds:time.
+ |timeToExecute remainingShowTime|
+
+ timeToExecute := Time millisecondsToRun:[ ret := aBlock value].
+ remainingShowTime := UserPreferences current waitCursorVisibleTime - timeToExecute.
+ remainingShowTime > 0 ifTrue:[
+ Delay waitForMilliseconds:remainingShowTime.
].
].
^ ret.
@@ -2534,7 +2534,7 @@
!DisplaySurface class methodsFor:'documentation'!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/DisplaySurface.st,v 1.162.2.1 2014-05-08 08:27:50 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/DisplaySurface.st,v 1.163 2014-08-01 07:21:59 cg Exp $'
! !
--- a/Font.st Wed Jun 25 11:13:58 2014 +0100
+++ b/Font.st Mon Sep 08 16:53:24 2014 +0100
@@ -256,16 +256,18 @@
encoding:encodingSym
device:nil.
- "look if this font is already known on the default device (the most common case)"
-
- Display notNil ifTrue:[
- Display deviceFonts do:[:aFont |
- (newFont sameDeviceFontAs:aFont) ifTrue:[
- "/ self assert:(aFont encoding = newFont encoding).
- ^ aFont
- ]
- ]
- ].
+"/ "look if this font is already known on the default device (the most common case)"
+"/ don't do this!!
+"/ is incompatible with Xft fonts. If reenabled, check printing in document viewer with XFT fonts enabled.
+"/
+"/ Display notNil ifTrue:[
+"/ Display deviceFonts do:[:aFont |
+"/ (newFont sameDeviceFontAs:aFont) ifTrue:[
+"/ "/ self assert:(aFont encoding = newFont encoding).
+"/ ^ aFont
+"/ ]
+"/ ]
+"/ ].
^ newFont
@@ -1337,11 +1339,11 @@
!Font class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/Font.st,v 1.137 2014-05-08 08:05:00 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/Font.st,v 1.138 2014-07-09 01:38:27 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/Font.st,v 1.137 2014-05-08 08:05:00 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/Font.st,v 1.138 2014-07-09 01:38:27 cg Exp $'
! !
--- a/FontDescription.st Wed Jun 25 11:13:58 2014 +0100
+++ b/FontDescription.st Mon Sep 08 16:53:24 2014 +0100
@@ -915,25 +915,15 @@
"two fonts are considered equal, if the font-name components are;
independent of the device, the font is on"
- (aFont species == self species) ifTrue:[
- (size == aFont size) ifTrue:[
- (family = aFont family) ifTrue:[
- (face = aFont face) ifTrue:[
- (style = aFont style) ifTrue:[
- (encoding == aFont encoding) ifTrue:[
- (sizeUnit == aFont sizeUnit) ifTrue:[
- (pixelSize == aFont pixelSizeOrNil) ifTrue:[
- ^ true
- ]
- ]
- ]
- ]
- ]
- ]
- ]
- ].
-
- ^ false
+ (aFont species == self species) ifFalse:[^ false].
+ (size == aFont size) ifFalse:[^ false].
+ (family = aFont family) ifFalse:[^ false].
+ (face = aFont face) ifFalse:[^ false].
+ (style = aFont style) ifFalse:[^ false].
+ (encoding == aFont encoding) ifFalse:[^ false].
+ (sizeUnit == aFont sizeUnit) ifFalse:[^ false].
+ (pixelSize == aFont pixelSizeOrNil) ifFalse:[^ false].
+ ^ true
"Modified: / 20-05-2014 / 11:18:31 / gg"
!
@@ -951,6 +941,8 @@
!
sameDeviceFontAs:aFont
+ aFont species == self species ifFalse:[^ false].
+
(family = aFont family) ifFalse:[ ^ false ].
(face = aFont face) ifFalse:[ ^ false ].
((style = aFont style)
@@ -1716,11 +1708,11 @@
!FontDescription class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/FontDescription.st,v 1.95 2014-05-20 09:18:50 sr Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/FontDescription.st,v 1.96 2014-07-09 02:52:30 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/FontDescription.st,v 1.95 2014-05-20 09:18:50 sr Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/FontDescription.st,v 1.96 2014-07-09 02:52:30 cg Exp $'
! !
--- a/Form.st Wed Jun 25 11:13:58 2014 +0100
+++ b/Form.st Mon Sep 08 16:53:24 2014 +0100
@@ -367,7 +367,7 @@
In old st80, you could use `Form grey' for drawing
- here we return the grey color."
- ^ Color grey
+ ^ Color gray
"Modified: 2.5.1996 / 11:43:17 / cg"
!
@@ -1222,6 +1222,7 @@
^MIMEDocument contentType: MIMEDocument contentTypeGif content: aStream
! !
+
!Form methodsFor:'converting'!
asForm
@@ -2011,7 +2012,7 @@
!Form class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/Form.st,v 1.150.2.2 2014-05-23 15:42:24 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/Form.st,v 1.152 2014-07-08 21:15:46 cg Exp $'
! !
--- a/GraphicsContext.st Wed Jun 25 11:13:58 2014 +0100
+++ b/GraphicsContext.st Mon Sep 08 16:53:24 2014 +0100
@@ -1060,6 +1060,9 @@
!
whiteColor
+ "return the white color on this device.
+ This is the same as 'Color white on:self device', but much faster."
+
^ device whiteColor
! !
@@ -2144,7 +2147,7 @@
style:nil
!
-drawEdgesForX:x y:y width:w height:h level:l
+drawEdgesForX:x y:y width:w height:h level:lvl
shadow:shadowColor light:lightColor
halfShadow:halfShadowColor halfLight:halfLightColor
style:edgeStyle
@@ -2159,7 +2162,7 @@
yi "{ Class: SmallInteger }"
run paint|
- count := l.
+ count := lvl.
(count < 0) ifTrue:[
topLeftFg := shadowColor.
botRightFg := lightColor.
@@ -2206,11 +2209,11 @@
self displayDeviceLineFromX:x y:y toX:r y:y.
self displayDeviceLineFromX:x y:y toX:x y:b
"
- (l > 1) ifTrue:[
+ (lvl > 1) ifTrue:[
edgeStyle == #softWin95 ifTrue:[
- self paint:(Color veryLightGrey).
+ self paint:(Color veryLightGray).
] ifFalse:[
- (l > 2 and:[edgeStyle == #soft]) ifTrue:[
+ (lvl > 2 and:[edgeStyle == #soft]) ifTrue:[
self paint:(device blackColor).
] ifFalse:[
self paint:halfLightColor.
@@ -2249,7 +2252,7 @@
yi := yi + 1
].
((edgeStyle == #soft or:[edgeStyle == #softWin95])
- and:[l > 1]) ifTrue:[
+ and:[lvl > 1]) ifTrue:[
self paint:(device blackColor) "shadowColor".
self displayDeviceLineFromX:x y:b toX:r y:b.
self displayDeviceLineFromX:r y:y toX:r y:b
@@ -2542,11 +2545,11 @@
!GraphicsContext class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/GraphicsContext.st,v 1.136.2.1 2014-05-08 08:27:50 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/GraphicsContext.st,v 1.137 2014-07-08 21:21:04 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/GraphicsContext.st,v 1.136.2.1 2014-05-08 08:27:50 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/GraphicsContext.st,v 1.137 2014-07-08 21:21:04 cg Exp $'
! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/GuiServerWorkstation.st Mon Sep 08 16:53:24 2014 +0100
@@ -0,0 +1,1166 @@
+"
+COPYRIGHT (c) 2014 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+"{ Package: 'stx:libview' }"
+
+DeviceWorkstation subclass:#GuiServerWorkstation
+ instanceVariableNames:'guiServerPid out in connectionTimeout
+ connectionTimeoutForWindowCreation hasConnectionBroken
+ dispatchingExpose buttonsPressed displayName listOfFonts fontMap
+ viewMap nextId useExtraCanvas answerSemaphore accessLock
+ useNativeWidgets'
+ classVariableNames:'DefaultConnectionTimeout
+ DefaultConnectionTimeoutForWindowCreation KeyPressMask
+ KeyReleaseMask ButtonPressMask ButtonReleaseMask ButtonMotionMask
+ PointerMotionMask ExposureMask FocusChangeMask EnterWindowMask
+ LeaveWindowMask KeymapStateMask VisibilityChangeMask
+ StructureNotifyMask ResizeRedirectMask PropertyChangeMask
+ ColormapChangeMask SubstructureNotifyMask
+ SubstructureRedirectMask'
+ poolDictionaries:''
+ category:'Interface-Graphics'
+!
+
+!GuiServerWorkstation class methodsFor:'documentation'!
+
+copyright
+"
+COPYRIGHT (c) 2014 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+documentation
+"
+ This is an experimental UI interface, not yet ready for general use.
+
+ This class provides the interface to the GUIServer.
+ It redefines all required methods from DeviceWorkstation.
+
+ The GUIServer is a little Java program, which provides a socket interface,
+ allowing for GUI operations to be sent and events to be received.
+ Thus providing a platform independent, portable and nice looking GUI interface alternative.
+
+ [author:]
+ Claus Gittinger
+"
+!
+
+example
+"
+ Smalltalk at:#D2 put:(self new initializeFor:nil).
+ Smalltalk at:#D2 put:(self new initializeFor:'localhost:47020')
+
+ D2 startDispatch.
+
+ (View onDevice:D2) open.
+ (Button onDevice:D2) label:'Hello'; open.
+
+ |v b1 b2|
+ v := View onDevice:D2.
+ v extent:200@200.
+ b1 := Button label:'Press Me' in:v. b1 extent:100@50.
+ b2 := Button label:'Me Too' in:v. b2 extent:100@50.
+ b2 top:60.
+ b1 action:[ Transcript showCR:'b1 pressed'. b1 extent:150@40].
+ b2 action:[ Transcript showCR:'b2 pressed'].
+ v open.
+ v inspect.
+
+ (SystemBrowser onDevice:D2) open
+"
+!
+
+example1
+"
+ |v b1 b2|
+
+ Smalltalk at:#D2 put:(self new initializeFor:nil).
+
+ D2 startDispatch.
+
+ v := View onDevice:D2.
+ v extent:200@200.
+ b1 := Button label:'Press Me' in:v. b1 extent:100@50.
+ b2 := Button label:'Me Too' in:v. b2 extent:100@50.
+ b2 top:60.
+ b1 action:[ Transcript showCR:'b1 pressed'. b1 extent:150@40].
+ b2 action:[ Transcript showCR:'b2 pressed'].
+ v open.
+"
+!
+
+example1b
+"
+ |v b1 b2|
+
+ Smalltalk at:#D2 put:(self new initializeFor:nil).
+
+ D2 startDispatch.
+
+ v := View onDevice:D2.
+ v extent:200@200.
+
+ v open.
+ Delay waitForSeconds:2.
+ v displayString:'hello' x:10 y:20.
+"
+!
+
+example2
+"
+ |v v1 v2 v3|
+
+ Smalltalk at:#D2 put:(self new initializeFor:nil).
+
+ D2 startDispatch.
+
+ v := View onDevice:D2.
+ v extent:200@220.
+ v1 := View in:v.
+ v1 origin:5@5 corner:95@95.
+ v1 viewBackground:Color red.
+
+ v2 := View in:v.
+ v2 origin:100@5 corner:195@95.
+ v2 viewBackground:Color green.
+
+ v3 := View in:v.
+ v3 origin:5@100 corner:95@195.
+ v3 viewBackground:Color blue.
+ v open
+"
+!
+
+example3
+"
+ |v v1 |
+
+ Smalltalk at:#D2 put:(self new initializeFor:nil).
+
+ D2 startDispatch.
+
+ v := View onDevice:D2.
+ v extent:200@220.
+
+ v1 := ScrollBar in:v.
+ v1 origin:5@5 corner:25@1.0.
+ v1 viewBackground:Color red.
+
+ v open
+"
+!
+
+example3b
+"
+ |v v1 v2|
+
+ Smalltalk at:#D2 put:(self new initializeFor:nil).
+
+ D2 startDispatch.
+
+ v := View onDevice:D2.
+ v extent:200@220.
+
+ v1 := ScrollBar in:v.
+ v1 origin:5@5 corner:25@1.0.
+
+ v2 := HorizontalScrollBar in:v.
+ v2 origin:25@5 corner:1.0@25.
+
+ v open
+"
+!
+
+example4
+"
+ |v v1 r1 r2 if c1 grp chk tm|
+
+ Smalltalk at:#D2 put:(self new initializeFor:nil).
+
+ D2 startDispatch.
+
+ v := View onDevice:D2.
+ v extent:200@220.
+
+ v1 := Label label:'label' in:v.
+ v1 origin:5@5 corner:125@25.
+
+ grp := RadioButtonGroup new.
+ r1 := RadioButton label:'radio 1' in:v.
+ r1 origin:5@25 corner:1.0@50.
+ grp add:r1 value:1.
+
+ r2 := RadioButton label:'radio 2' in:v.
+ r2 origin:5@50 corner:1.0@75.
+ grp add:r2 value:2.
+ grp onChangeEvaluate:[ Transcript showCR:'changed'].
+
+ r2 := RadioButton label:'radio 2' in:v.
+ r2 origin:5@50 corner:1.0@75.
+ grp add:r2 value:2.
+ grp onChangeEvaluate:[ Transcript showCR:'changed'].
+
+ chk := false asValue.
+ c1 := CheckBox label:'check' in:v.
+ c1 origin:5@75 corner:1.0@100.
+ c1 model:chk.
+ chk onChangeEvaluate:[ Transcript showCR:'changed'].
+
+ tm := 'hello' asValue.
+ if := EditField in:v.
+ if viewBackground:(Color yellow lightened).
+ if origin:5@100 corner:1.0@125.
+ if model:tm.
+ ' if passwordCharacter:$* '.
+ tm onChangeEvaluate:[ Transcript showCR:'changed'].
+
+ v open
+"
+!
+
+example5
+"
+ |v v1 r1 r2 v3 c1 grp chk|
+
+ Smalltalk at:#D2 put:(self new initializeFor:nil).
+
+ D2 startDispatch.
+
+ v := View onDevice:D2.
+ v extent:200@220.
+
+ v1 := TextView in:v.
+ v1 viewBackground:Color red.
+ v1 origin:5@5 corner:1.0@1.0.
+ v1 contents:'line1
+line2
+line3'.
+ v1 textChanged.
+ v open
+"
+!
+
+example5b
+"
+ |v v1 v2 v3|
+
+ Smalltalk at:#D2 put:(self new initializeFor:nil).
+
+ D2 startDispatch.
+
+ v := View onDevice:D2.
+ v extent:200@220.
+ v viewBackground:Color yellow.
+
+ v1 := View in:v.
+ v1 extent:180@180.
+ v1 viewBackground:Color green.
+
+ v2 := SelectionInListView in:v1.
+ v2 viewBackground:Color red.
+ v2 origin:5@5 corner:100@100.
+ v2 list:#('line1' 'line2' 'line3').
+ v open.
+
+ Delay waitForSeconds:2.
+ D2 send:'set-visible ',v2 id,' true'.
+ D2 send:'set-bounds ',v2 id,' 10 10 50 50'.
+"
+! !
+
+!GuiServerWorkstation class methodsFor:'class initialization'!
+
+initialize
+ KeyPressMask := 16r01.
+ KeyReleaseMask := 16r02.
+ ButtonPressMask := 16r04.
+ ButtonReleaseMask := 16r08.
+ ButtonMotionMask := 16r10.
+ PointerMotionMask := 16r20.
+ ExposureMask := 16r40.
+ FocusChangeMask := 16r80.
+ EnterWindowMask := 16r100.
+ LeaveWindowMask := 16r200.
+ KeymapStateMask := 16r400.
+ VisibilityChangeMask := 16r800.
+ StructureNotifyMask := 16r1000.
+ ResizeRedirectMask := 16r2000.
+ PropertyChangeMask := 16r4000.
+ ColormapChangeMask := 16r8000.
+ SubstructureNotifyMask := 16r10000.
+ SubstructureRedirectMask := 16r20000.
+! !
+
+!GuiServerWorkstation class methodsFor:'defaults'!
+
+defaultGUIServerPath
+ ^ Smalltalk projectDirectory constructString:'../support/guiServer/guiserver.jar'
+"/ ^ '/Users/cg/Downloads/languages/lisp/newLisp/newlisp-10.6.0/guiserver/guiserver.jar'.
+"/ ^ self projectDirectory constructString:'guiserver.jar'
+!
+
+defaultGUIServerPort
+ ^ 47011
+! !
+
+!GuiServerWorkstation methodsFor:'bitmap/window creation'!
+
+createBitmapFromArray:data width:w height:h
+ "create a monochrome, depth1 bitmap from a given (byte-)array.
+ The rows are aligned to a multiple of 8"
+
+ "/ for now, just return a dummy id...
+ ^ 4711
+
+ "/ todo: save as png and use that path in the future...
+"/ self halt.
+!
+
+createWindowFor:aView type:typeSymbol origin:org extent:ext
+ minExtent:minE maxExtent:maxE borderWidth:bw subViewOf:sv
+ style:styleSymbol inputOnly:inp
+ label:label owner:owner
+ icon:icn iconMask:icnM iconView:icnV
+
+ |nr id nativeWindowType x y w h containerId|
+
+ nr := nextId.
+ nextId := nextId + 1.
+
+ useNativeWidgets ifTrue:[
+ nativeWindowType := aView nativeWindowType.
+ ].
+
+ x := org x.
+ y := org y.
+ w := ext x.
+ h := ext y.
+
+ id := '%1_%2' bindWith:aView class nameWithoutPrefix with:nr.
+
+ sv isNil ifTrue:[
+ self gs_frame:id x:org x y:org y width:w height:h label:'x' visible:false.
+ "/ self send:('canvas ','canvas_',id).
+ useExtraCanvas ifTrue:[
+ self send:('canvas ','canvas_',id).
+ self send:('add-to ',id,' canvas_',id).
+ self send:('set-visible ','canvas_',id,' true').
+ self send:('set-null-layout ','canvas_',id).
+ ] ifFalse:[
+ self send:('set-null-layout ',id).
+ ].
+ ] ifFalse:[
+ containerId := sv id.
+ useExtraCanvas ifTrue:[
+ sv superView isNil ifTrue:[
+ containerId := 'canvas_',containerId
+ ].
+ ].
+ nativeWindowType notNil ifTrue:[
+ nativeWindowType == #Button ifTrue:[
+ self send:('button ',id,' button-action ',(Base64Coder encode:aView label),' ',x printString,' ',y printString)
+ "/ (gs:set-flow-layout 'ButtonDemo "center" 2 15)
+ "/ (gs:add-to 'ButtonDemo 'ColorPanel 'aButton)
+ ] ifFalse:[ nativeWindowType == #VerticalScrollBar ifTrue:[
+ "/ action orientation minPos maxPos pos pageIncrement
+ self send:('scrollbar ',id,' scrollbar-action vertical 0 100 0 10')
+ ] ifFalse:[ nativeWindowType == #HorizontalScrollBar ifTrue:[
+ "/ action orientation minPos maxPos pos pageIncrement
+ self send:('scrollbar ',id,' scrollbar-action horizontal 0 100 0 10')
+ ] ifFalse:[ nativeWindowType == #Label ifTrue:[
+ "/ "left", "center", "right", "leading", "trailing", "bottom" and "top"
+ self send:('label ',id,' ',(Base64Coder encode:aView label),' center ',w printString,' ',h printString).
+ ] ifFalse:[ nativeWindowType == #RadioButton ifTrue:[
+ self send:('radio-button ',id,' radio-button-action ',(Base64Coder encode:aView label),' ',(aView isOn printString)).
+ ] ifFalse:[ nativeWindowType == #CheckBox ifTrue:[
+ self send:('check-box ',id,' check-box-action ',(Base64Coder encode:aView label),' ',(aView isOn printString)).
+ ] ifFalse:[ nativeWindowType == #EditField ifTrue:[
+ aView passwordCharacter notNil ifTrue:[
+ self send:('text-field ',id,' text-field-action ',(aView maxChars ? 9999) printString,' ',(Base64Coder encode:aView passwordCharacter asString)).
+ ] ifFalse:[
+ self send:('text-field ',id,' text-field-action ',(aView maxChars ? 9999) printString).
+ ].
+ self changeText:(aView contents asString) in:id.
+ ] ifFalse:[ nativeWindowType == #TextView ifTrue:[
+ self send:('text-area ',id,' text-area-action ',w printString,' ',h printString).
+ self changeText:(aView contents) in:id.
+ ] ifFalse:[ nativeWindowType == #SelectionInListView ifTrue:[
+ self send:('list-box ',id,' list-box-action ',((aView list collect:[:l | (Base64Coder encode:l?'')]) asStringCollection asStringWith:' ')).
+ "/ self changeList:aView list in:id.
+ ] ifFalse:[
+self halt.
+ self send:('canvas ',id)
+ ]]]]]]]]].
+ ] ifFalse:[
+ self send:('canvas ',id)
+ ].
+ self send:('add-to ',containerId,' ',id).
+ self send:('set-visible ',id,' true').
+ self send:('set-null-layout ',id).
+ self send:('set-bounds ',id,' %1 %2 %3 %4' bindWith:x with:y with:w with:h).
+ ].
+ viewMap at:id put:aView.
+ ^ id
+!
+
+destroyGC:gcId
+!
+
+destroyPixmap:pixmapId
+!
+
+destroyView:aView withId:id
+ |container|
+
+ container := aView superView.
+
+ viewMap removeKey:id ifAbsent:[].
+ container isNil ifTrue:[
+ self send:('dispose ',id)
+ ] ifFalse:[
+ (useExtraCanvas and:[container superView isNil]) ifTrue:[
+ self send:('remove-from canvas_',container id,' ',id)
+ ] ifFalse:[
+ self send:('remove-from ',container id,' ',id)
+ ].
+ ].
+!
+
+supportsNativeWidgetType:aWidgetTypeSymbol
+ useNativeWidgets ifFalse:[^ false].
+
+ aWidgetTypeSymbol == #Button ifTrue:[^ true].
+ aWidgetTypeSymbol == #Scrollbar ifTrue:[^ true].
+ aWidgetTypeSymbol == #Label ifTrue:[^ true].
+ aWidgetTypeSymbol == #Toggle ifTrue:[^ true].
+ aWidgetTypeSymbol == #ScrolledView ifTrue:[^ true].
+ aWidgetTypeSymbol == #CheckBox ifTrue:[^ true].
+ aWidgetTypeSymbol == #RadioButton ifTrue:[^ true].
+ aWidgetTypeSymbol == #ComboBox ifTrue:[^ true].
+ aWidgetTypeSymbol == #Slider ifTrue:[^ true].
+ aWidgetTypeSymbol == #ProgressBar ifTrue:[^ true].
+ aWidgetTypeSymbol == #ListBox ifTrue:[^ true].
+ aWidgetTypeSymbol == #EditField ifTrue:[^ true].
+ aWidgetTypeSymbol == #TextView ifTrue:[^ true].
+ aWidgetTypeSymbol == #Menu ifTrue:[^ true].
+ aWidgetTypeSymbol == #MenuBar ifTrue:[^ true].
+ aWidgetTypeSymbol == #Table ifTrue:[^ true].
+
+ ^ false
+! !
+
+!GuiServerWorkstation methodsFor:'cursor stuff'!
+
+builtInCursorShapes
+ "return a collection of standard cursor names.
+ Those are built into the XServer and need not be created as
+ user cursors.
+ (actually, there are more than those below ...)"
+
+ "/ if you add something here, also add to #shapeNumberFromCursor ...
+
+ ^ #(
+ #upLeftArrow "/ default
+ #upRightHand "/ hand
+ #text "/ text
+ #wait "/ wait
+ #crossHair "/ crosshair
+ #origin "/ nw-resize
+ #topLeft "/ nw-resize
+ #corner "/ se-resize
+ #bottomRight "/ se-resize
+ #topRight "/ ne-resize
+ #bottomLeft "/ sw-resize
+ )
+!
+
+createCursorShape:aShapeSymbol
+ |cursors i|
+
+ cursors := #(
+ (#upLeftArrow #default )
+ (#upRightHand #hand )
+ (#text #text )
+ (#wait #wait )
+ (#crossHair #crosshair )
+ (#origin #nw-resize )
+ (#topLeft #nw-resize )
+ (#corner #se-resize )
+ (#bottomRight #se-resize )
+ (#topRight #ne-resize )
+ (#bottomLeft #sw-resize )
+ ).
+ i := cursors findFirst:[:entry | entry first == aShapeSymbol].
+ i == 0 ifTrue:[^ nil].
+ ^ (cursors at:i) second
+!
+
+destroyCursor:aCursorId
+!
+
+setCursor:aCursorId in:aWindowId
+ "/ ;; @syntax (gs:set-cursor <sym-id> <str-shape>)
+ "/ ;; @param <sym-id> The name of the frame, dialog or window.
+ "/ ;; @param <str-shape> The string describing the cursor shape.
+ "/ ;;
+ "/ ;; The cursor shape can be one of the following:
+ "/ ;; <pre>
+ "/ ;; "default"
+ "/ ;; "crosshair"
+ "/ ;; "text"
+ "/ ;; "wait"
+ "/ ;; "sw-resize"
+ "/ ;; "se-resize"
+ "/ ;; "nw-resize"
+ "/ ;; "ne-resize"
+ "/ ;; "n-resize"
+ "/ ;; "s-resize"
+ "/ ;; "w-resize"
+ "/ ;; "e-resize"
+ "/ ;; "hand"
+ "/ ;; "move"
+
+ self gs_set_cursor:aWindowId cursor:aCursorId
+! !
+
+!GuiServerWorkstation methodsFor:'event handling'!
+
+addToKnownScreens
+!
+
+base64StringFromLineStream:s
+ |str|
+
+ str := s upToAny:')( '.
+ (str first = $") ifTrue:[
+ str := str withoutQuotes.
+ ].
+ ^ (Base64Coder decodeAsString:str)
+!
+
+defaultEventMask
+ ^ ExposureMask | StructureNotifyMask |
+ KeyPressMask | KeyReleaseMask |
+ PointerMotionMask |
+ EnterWindowMask | LeaveWindowMask |
+ ButtonPressMask | ButtonMotionMask | ButtonReleaseMask |
+ PropertyChangeMask
+!
+
+dispatchEventFor:aViewIdOrNil withMask:eventMask
+ "central event handling method:
+ get next event and send appropriate message to the sensor or view.
+ If the argument aViewIdOrNil is nil, events for any view are processed,
+ otherwise only events for the view with given id are processed.
+ If the argument aMask is nonNil, only events for this eventMask are
+ handled.
+ WARNING: this may block to wait for an event - you better check for a
+ pending event before calling this."
+
+ |line|
+
+ EndOfStreamNotification handle:[:ex |
+ ] do:[
+ line := in nextLine.
+ ].
+ line isNil ifTrue:[
+ hasConnectionBroken := true.
+ self brokenConnection.
+ ^ self.
+ ].
+ self handleInput:line.
+!
+
+eventMaskFor:anEventSymbol
+ "return the eventMask bit-constant corresponding to an event symbol"
+
+ anEventSymbol == #keyPress ifTrue:[^ KeyPressMask].
+ anEventSymbol == #keyRelease ifTrue:[^ KeyReleaseMask].
+ anEventSymbol == #buttonPress ifTrue:[^ ButtonPressMask].
+ anEventSymbol == #buttonRelease ifTrue:[^ ButtonReleaseMask].
+ anEventSymbol == #buttonMotion ifTrue:[^ ButtonMotionMask].
+ anEventSymbol == #pointerMotion ifTrue:[^ PointerMotionMask].
+ anEventSymbol == #expose ifTrue:[^ ExposureMask].
+ anEventSymbol == #focusChange ifTrue:[^ FocusChangeMask].
+ anEventSymbol == #enter ifTrue:[^ EnterWindowMask].
+ anEventSymbol == #leave ifTrue:[^ LeaveWindowMask].
+ anEventSymbol == #keymapState ifTrue:[^ KeymapStateMask].
+ anEventSymbol == #visibilityChange ifTrue:[^ VisibilityChangeMask].
+ anEventSymbol == #structureNotify ifTrue:[^ StructureNotifyMask].
+ anEventSymbol == #resizeRedirect ifTrue:[^ ResizeRedirectMask].
+ anEventSymbol == #propertyChange ifTrue:[^ PropertyChangeMask].
+ anEventSymbol == #colormapChange ifTrue:[^ ColormapChangeMask].
+ anEventSymbol == #substructureNotify ifTrue:[^ SubstructureNotifyMask].
+ anEventSymbol == #substructureRedirect ifTrue:[^ SubstructureRedirectMask].
+ ^ 0
+!
+
+eventPending
+ ^ in notNil
+ and:[ in isOpen
+ and:[ in canReadWithoutBlocking ]]
+
+ "
+ self new initializeFor:nil
+ "
+!
+
+handleInput:line
+ "handle an incoming event from the guiServer"
+
+ |s cmd var view text|
+
+ "/ gui server sends lisp-like lines:
+ "/ (action id)
+ "/ ...
+Transcript showCR:'<< ',line.
+
+ s := line readStream.
+ s next == $( ifFalse:[^ false ].
+
+ s skipSeparators.
+ cmd := s upToAny:'")( '.
+ s skipSeparators.
+
+ cmd = 'button-action' ifTrue:[
+ view := self viewFromLineStream:s.
+Transcript showCR:view.
+Transcript showCR:view isNativeWidget.
+ self buttonPress:1 x:1 y:1 view:view.
+ self buttonRelease:1 x:1 y:1 view:view.
+ ^ true.
+ ].
+ cmd = 'radio-button-action' ifTrue:[
+ view := self viewFromLineStream:s.
+Transcript showCR:view.
+Transcript showCR:view isNativeWidget.
+ self buttonPress:1 x:1 y:1 view:view.
+ self buttonRelease:1 x:1 y:1 view:view.
+ ^ true.
+ ].
+ cmd = 'check-box-action' ifTrue:[
+ view := self viewFromLineStream:s.
+Transcript showCR:view.
+Transcript showCR:view isNativeWidget.
+ self buttonPress:1 x:1 y:1 view:view.
+ self buttonRelease:1 x:1 y:1 view:view.
+ ^ true.
+ ].
+ cmd = 'scrollbar-action' ifTrue:[
+ view := self viewFromLineStream:s.
+Transcript showCR:view.
+Transcript showCR:view isNativeWidget.
+ ^ true.
+ ].
+ cmd = 'text-field-action' ifTrue:[
+ view := self viewFromLineStream:s.
+ text := self base64StringFromLineStream:s.
+Transcript showCR:view.
+Transcript showCR:view isNativeWidget.
+Transcript showCR:text.
+ ^ true.
+ ].
+
+ cmd = 'set' ifTrue:[
+ var := s upToAny:')( '.
+ s skipSeparators.
+ var first == $' ifTrue:[ var := var copyFrom:2 ].
+
+ var = 'gs:screen' ifTrue:[
+ s peek == $' ifTrue:[ s next ].
+ s peek ~~ $( ifTrue:[ self halt].
+ s next.
+ width := (Number readFrom:s) asInteger.
+ s skipSeparators.
+ height := (Number readFrom:s) asInteger.
+ s skipSeparators.
+ resolutionHor := resolutionVer := (Number readFrom:s) asInteger "is dpi" / 25.4.
+ widthMM := width / resolutionHor.
+ heightMM := height / resolutionVer.
+ "/ self halt.
+ ^ true.
+ ].
+ ].
+
+ self halt.
+ ^ false.
+
+ "
+ self new initializeFor:nil
+ "
+!
+
+setEventMask:mask in:viewID
+!
+
+viewFromLineStream:s
+ |id|
+
+ id := s upToAny:')( '.
+ (id first = $") ifTrue:[
+ id := id withoutQuotes.
+ ].
+ ^ viewMap at:id ifAbsent:nil.
+! !
+
+!GuiServerWorkstation methodsFor:'font stuff'!
+
+ascentOf:id
+ ^ 16
+!
+
+descentOf:id
+ ^ 8
+!
+
+getFontWithFamily:familyString face:faceString style:styleString size:sizeArg sizeUnit:sizeUnit encoding:encodingSym
+ |nm id|
+
+ nm := familyString,'-',faceString,'-',styleString,'-',sizeArg printString.
+ id := (fontMap size // 2) + 1.
+ fontMap at:nm put:id.
+ fontMap at:id put:nm.
+ ^ id
+!
+
+maxAscentOf:id
+ ^ 16
+!
+
+maxDescentOf:id
+ ^ 8
+!
+
+maxWidthOfFont:id
+ ^ 10
+!
+
+minWidthOfFont:id
+ ^ 10
+!
+
+subclassResponsibility
+ MiniDebugger enter.
+ AbortSignal raise
+!
+
+widthOf:aString from:index1 to:index2 inFont:aFontId
+ ^ (index2-index1+1) * 10
+! !
+
+!GuiServerWorkstation methodsFor:'gs interaction'!
+
+gs_frame:id x:x y:y width:w height:h label:label visible:visible
+ label isNil ifTrue:[
+ self send:('frame %1 %2 %3 %4'
+ bindWith:id with:x with:y with:w with:h)
+ ] ifFalse:[
+ self send:('frame %1 %2 %3 %4 %5 %6'
+ bindWith:id with:x with:y with:w with:h
+ with:(Base64Coder encode:label) with:visible)
+ ]
+!
+
+gs_set_background:id color:colorId
+ self gs_set_color:id color:colorId
+!
+
+gs_set_background:id r:redFraction g:greenFraction b:blueFraction alpha:alphaFraction
+ self gs_set_color:id r:redFraction g:greenFraction b:blueFraction alpha:alphaFraction
+!
+
+gs_set_color:id color:colorId
+ self gs_set_color:id
+ r:(((colorId rightShift:16) bitAnd:16rFF) / 255.0)
+ g:(((colorId rightShift:8) bitAnd:16rFF) / 255.0)
+ b:((colorId bitAnd:16rFF) / 255.0)
+ alpha:1
+!
+
+gs_set_color:id r:redFraction g:greenFraction b:blueFraction alpha:alphaFraction
+ self send:('set-color %1 %2 %3 %4 %5'
+ bindWith:id
+ with:redFraction
+ with:greenFraction
+ with:blueFraction
+ with:alphaFraction)
+!
+
+gs_set_cursor:id cursor:cursorId
+ self send:('set-cursor ',id,' ',cursorId)
+!
+
+gs_set_foreground:id r:redFraction g:greenFraction b:blueFraction alpha:alphaFraction
+ self send:('set-foreground %1 %2 %3 %4 %5'
+ bindWith:id
+ with:redFraction
+ with:greenFraction
+ with:blueFraction
+ with:alphaFraction)
+!
+
+gs_set_resizable:id resizable:aBoolean
+ self send:'set-resizable %1 %2' with:id with:aBoolean
+!
+
+gs_set_trace:aBoolean
+ self send:'set-trace System %1' with:aBoolean
+!
+
+gs_set_utf8:aBoolean
+ self send:'set-utf8 System %1' with:aBoolean
+!
+
+gs_set_visible:id visible:visible
+ self send:('set-visible ',id,' ',visible printString)
+!
+
+send:cmdString
+ out isNil ifTrue:[^ self].
+ out nextPutLine:cmdString
+!
+
+send:cmd with:arg
+ self send:(cmd bindWith:arg)
+!
+
+send:cmd with:arg1 with:arg2
+ self send:(cmd bindWith:arg1 with:arg2)
+! !
+
+!GuiServerWorkstation methodsFor:'initialization & release'!
+
+closeConnection
+ |c p|
+
+ (c := in) notNil ifTrue:[
+ in := nil.
+ c close.
+ ].
+ (c := out) notNil ifTrue:[
+ out := nil.
+ c close.
+ ].
+ (p := guiServerPid) notNil ifTrue:[
+ guiServerPid := nil.
+ OperatingSystem terminateProcess:p
+ ].
+!
+
+guiServerTerminated
+ "connection to GUIServer broken"
+
+ |c|
+
+ Transcript showCR:'guiServer terminated'.
+
+ (c := in) notNil ifTrue:[
+ in := nil.
+ c close.
+ ].
+ (c := out) notNil ifTrue:[
+ out := nil.
+ c close.
+ ].
+ self brokenConnection
+!
+
+initializeFor:aHostName
+ "initialize the receiver for a connection to a GUIServer;
+ the argument, aHostName may be nil (for a new server on the local machine)
+ or the name:port of an already running server"
+
+ in notNil ifTrue:[
+ "/ already connected - you bad guy try to trick me manually ?
+ ^ self
+ ].
+
+ self openConnectionTo:aHostName.
+
+ "/ useNativeWidgets := false.
+ useNativeWidgets := true.
+ useExtraCanvas := false.
+ "/ useExtraCanvas := true.
+
+ connectionTimeout := connectionTimeout ? DefaultConnectionTimeout.
+ connectionTimeoutForWindowCreation := connectionTimeoutForWindowCreation ? DefaultConnectionTimeoutForWindowCreation.
+ hasConnectionBroken := false.
+
+ dispatching := false.
+ dispatchingExpose := false.
+ isSlow := false.
+ shiftDown := false.
+ ctrlDown := false.
+ metaDown := false.
+ altDown := false.
+ motionEventCompression := true.
+ buttonsPressed := 0.
+
+ visualType := #TrueColor.
+ depth := 24.
+ redShift := 16. greenShift := 8. blueShift := 0.
+ listOfFonts := nil.
+ nextId := 1.
+
+ fontMap := Dictionary new.
+ viewMap := Dictionary new.
+
+ self initializeDeviceResourceTables.
+ self initializeScreenProperties.
+
+ self initializeDefaultValues.
+ self initializeSpecialFlags.
+ self initializeKeyboardMap.
+ self initializeDeviceSignals.
+
+ self initializeViewStyle.
+!
+
+initializeScreenProperties
+ "setup screen specific properties."
+
+ super initializeScreenProperties.
+
+ out nextPutLine:'get-screen System'.
+ self handleInput:(in nextLine).
+
+ width := 1280.
+ height := 1024.
+!
+
+initializeSpecialFlags
+ ^ self
+!
+
+nativeWidgets:aBoolean
+ "enable/disable native widgets on a display"
+
+ useNativeWidgets := aBoolean
+!
+
+openConnectionTo:aHostNameOrNil
+ "open a connection to aHostNameOrNil;
+ if nil, a new GUIServer is started; otherwise, try to connect to that host."
+
+ |host port hostAndPort startGUIServer acceptSocket connectionFromGS connectionToGS|
+
+ startGUIServer := false.
+
+ aHostNameOrNil isNil ifTrue:[
+ host := 'localhost'.
+ port := self guiServerPort.
+ startGUIServer := true.
+ ] ifFalse:[
+ hostAndPort := aHostNameOrNil splitBy:$:.
+ host := hostAndPort first.
+ port := (hostAndPort at:2 ifAbsent:[self guiServerPort]) asNumber.
+ ].
+
+ displayName := (host , ':' , port printString).
+
+ startGUIServer ifTrue:[
+ self startGUIServerWithPort:port
+ ].
+
+ acceptSocket := Socket newTCPserverAtPort:(port+1).
+ acceptSocket listenFor:1.
+
+ "/ give GUI server a chance to come up
+ [connectionFromGS isNil] whileTrue:[
+ connectionFromGS := Socket newTCPclientToHost:host port:port.
+ connectionFromGS isNil ifTrue:[
+ Delay waitForSeconds:0.1
+ ].
+ ].
+
+ acceptSocket readWaitWithTimeoutMs:500.
+ connectionToGS := acceptSocket accept.
+ acceptSocket close.
+
+ out := connectionFromGS.
+ in := connectionToGS.
+
+ "/ self startReaderProcess.
+
+ self gs_set_trace:true.
+ self gs_set_utf8:true.
+
+ "
+ Smalltalk at:#D2 put:(self new initializeFor:nil).
+ Smalltalk at:#D2 put:(self new initializeFor:'localhost:47020')
+
+ WorkspaceApplication openOnDevice:D2
+
+ D2 startDispatch.
+ SystemBrowser openOnDevice:d
+ "
+!
+
+startGUIServerWithPort:portNr
+ "start the java GUIServer"
+
+ |cmd args javaHome guiServerPath|
+
+ guiServerPath := self guiServerPath.
+
+ OperatingSystem isMSWINDOWSlike ifTrue:[
+ cmd := 'cmd/c'
+ ] ifFalse:[
+ javaHome := OperatingSystem getEnvironment:'JAVA_HOME'.
+ cmd := javaHome isNil
+ ifTrue:'/usr/bin/java'
+ ifFalse:[ javaHome asFilename constructString:'bin/java' ].
+ ].
+ args := { 'java' . '-jar' . guiServerPath . portNr asString }.
+
+ Processor
+ monitor:[
+ guiServerPid := OperatingSystem
+ exec:cmd
+ withArguments:args
+ fork:true
+ ]
+ action:[:status |
+ status stillAlive ifFalse:[
+ OperatingSystem closePid:guiServerPid.
+ guiServerPid := nil.
+ self guiServerTerminated.
+ ].
+ ].
+
+ guiServerPid isNil ifTrue:[
+ self error:'failed to launch guiserver.jar'
+ ].
+
+ "
+ self new initializeFor:nil
+ "
+! !
+
+!GuiServerWorkstation methodsFor:'misc'!
+
+halt
+ Screen currentScreenQuerySignal answer:Display do:[
+ super halt.
+ ].
+!
+
+mapWindow:viewId
+ self gs_set_visible:viewId visible:true
+!
+
+setWindowBackground:colorId in:viewId
+ self gs_set_background:viewId color:colorId.
+!
+
+setWindowName:label in:viewId
+!
+
+unmapWindow:viewId
+ self gs_set_visible:viewId visible:false
+! !
+
+!GuiServerWorkstation methodsFor:'native window stuff'!
+
+changeButtonState:stateBoolean in:id
+ out nextPutLine:('set-selected ',id,' ',stateBoolean printString).
+!
+
+changeLabel:label in:id
+ out nextPutLine:('set-text ',id,' ',(Base64Coder encode:label)).
+!
+
+changeList:list in:id
+ out nextPutLine:('clear-list ',id).
+ list do:[:each |
+ out nextPutLine:('add-list-item ',id,' ',(Base64Coder encode:each asString)).
+ ].
+!
+
+changeText:text in:id
+ out nextPutLine:('set-text ',id,' ',(Base64Coder encode:text asString)).
+! !
+
+!GuiServerWorkstation methodsFor:'queries'!
+
+displayFileDescriptor
+ "return the file descriptor associated with the display
+ if any. If there is no underlying filedescriptor, return nil.
+ (used for event select/polling)"
+
+ ^ in fileDescriptor
+!
+
+displayName
+ ^ displayName
+!
+
+guiServerPath
+ ^ self class defaultGUIServerPath
+!
+
+guiServerPort
+ ^ self class defaultGUIServerPort
+!
+
+isOpen
+ "answer true, if device can be used"
+
+ ^ hasConnectionBroken not
+ and:[guiServerPid notNil
+ and:[in notNil
+ and:[out notNil
+ and:[in isOpen
+ and:[out isOpen]]]]].
+!
+
+mayOpenDebugger
+ ^ false
+!
+
+supportsNativeWidgets
+ ^ useNativeWidgets
+! !
+
+!GuiServerWorkstation methodsFor:'window stuff'!
+
+moveResizeWindow:aWindowId x:x y:y width:w height:h
+ self send:('set-bounds %1 %2 %3 %4 %5' bindWith:aWindowId with:x with:y with:w with:h)
+!
+
+moveWindow:aWindowId x:x y:y
+ self send:('set-location %1 %2 %3 %4 %5' bindWith:aWindowId with:x with:y)
+!
+
+resizeWindow:aWindowId width:w height:h
+ self send:('set-current-size %1 %2 %3' bindWith:aWindowId with:w with:h)
+! !
+
+!GuiServerWorkstation class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/GuiServerWorkstation.st,v 1.1 2014-08-03 12:44:13 cg Exp $'
+!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libview/GuiServerWorkstation.st,v 1.1 2014-08-03 12:44:13 cg Exp $'
+! !
+
+
+GuiServerWorkstation initialize!
--- a/Image.st Wed Jun 25 11:13:58 2014 +0100
+++ b/Image.st Mon Sep 08 16:53:24 2014 +0100
@@ -1538,24 +1538,22 @@
the ImageNotFoundQuerySignal is raised, which may be handled to
proceed with some replacement image. If unhandled, nil is returned."
- |image name fn nm inStream suffix readerClass
- mustDecompress inPipe readersErrorMsg|
+ |image fn nm inStream suffix readerClass
+ mustDecompress readersErrorMsg|
"before trying each reader, check if the file is readable"
- name := aFileName asFilename.
- name isAbsolute ifTrue:[
- fn := name asFilename.
- ] ifFalse:[
- inStream := Smalltalk systemFileStreamFor:name.
+ fn := aFileName asFilename.
+ fn isAbsolute ifFalse:[
+ inStream := Smalltalk systemFileStreamFor:fn.
inStream isNil ifTrue:[
- inStream := Smalltalk bitmapFileStreamFor:name.
+ inStream := Smalltalk bitmapFileStreamFor:fn.
inStream isNil ifTrue:[
"this signal is a query - if noone seems to care, return nil.
However, a handler may provide a replacement image."
^ ImageNotFoundQuerySignal
- raiseRequestWith:aFileName
- errorString:('IMAGE [warning]: ''' , name pathName, ''' does not exist or is not readable').
+ raiseRequestWith:fn
+ errorString:('IMAGE [warning]: ''' , fn pathName, ''' does not exist or is not readable').
].
].
fn := inStream pathName asFilename.
@@ -1566,10 +1564,12 @@
suffix := fn suffix.
"handle compressed-suffix"
- (#('Z' 'gz') includes:suffix) ifTrue:[
- fn := fn withoutSuffix.
- nm := fn name.
- suffix := fn suffix.
+ (#('gz') includes:suffix) ifTrue:[
+ |baseFn|
+
+ baseFn := fn withoutSuffix.
+ nm := baseFn name.
+ suffix := baseFn suffix.
mustDecompress := true.
].
suffix isEmpty ifTrue:[
@@ -1580,12 +1580,15 @@
readerClass := MIMETypes imageReaderForSuffix:suffix.
readerClass notNil ifTrue:[
mustDecompress == true ifTrue:[
- inPipe := PipeStream readingFrom:'gunzip <' , fn pathName.
- inPipe notNil ifTrue:[
+ |zipStream|
+ inStream := fn readStream.
+ zipStream := ZipStream readOpenOn:inStream suppressHeaderAndChecksum:true.
+ zipStream notNil ifTrue:[
[
- image := readerClass fromStream:inPipe.
+ image := readerClass fromStream:zipStream.
] ensure:[
- inPipe close
+ zipStream close.
+ inStream close.
].
]
] ifFalse:[
@@ -1609,8 +1612,8 @@
MIMETypes imageReaderClasses do:[:mimeReaderClass |
(mimeReaderClass notNil
and:[mimeReaderClass ~~ readerClass]) ifTrue:[
- (mimeReaderClass isValidImageFile:name) ifTrue:[
- image := mimeReaderClass fromFile:name.
+ (mimeReaderClass isValidImageFile:fn) ifTrue:[
+ image := mimeReaderClass fromFile:fn.
image notNil ifTrue:[
^ image
]
@@ -1624,17 +1627,17 @@
However, a handler may provide a replacement image."
^ BadImageFormatQuerySignal
- raiseRequestWith:aFileName
+ raiseRequestWith:fn
errorString:(readersErrorMsg ? ('IMAGE [warning]: unknown image file format: ''' , aFileName asFilename pathName , '''')).
"
- Image fromFile:'goodies/bitmaps/gifImages/claus.gif'
- Image fromFile:'goodies/bitmaps/gifImages/garfield.gif'
-
- Image fromFile:'goodies/bitmaps/winBitmaps/a11.ico'
- Image fromFile:'goodies/bitmaps/xpmBitmaps/countries/czech.xpm'
- Image fromFile:'goodies/bitmaps/xpmBitmaps/countries/czech.xpm.gz'
- Image fromFile:'clients/Demos/bitmaps/hello_world.icon'
+ Image fromFile:'bitmaps/gifImages/claus.gif' inPackage:'stx:goodies'
+ Image fromFile:'bitmaps/gifImages/garfield.gif' inPackage:'stx:goodies'
+
+ Image fromFile:'bitmaps/winBitmaps/a11.ico' inPackage:'stx:goodies'
+ Image fromFile:'bitmaps/xpmBitmaps/countries/czech.xpm' inPackage:'stx:goodies'
+ Image fromFile:'bitmaps/xpmBitmaps/countries/czech.xpm.gz' inPackage:'stx:goodies'
+ Image fromFile:'Demos/bitmaps/hello_world.icon' inPackage:'stx:clients'
"
"
@@ -14437,11 +14440,11 @@
!Image class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/Image.st,v 1.457 2014-06-14 09:11:24 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/Image.st,v 1.458 2014-07-03 13:37:00 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/Image.st,v 1.457 2014-06-14 09:11:24 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/Image.st,v 1.458 2014-07-03 13:37:00 stefan Exp $'
! !
--- a/KeyboardMap.st Wed Jun 25 11:13:58 2014 +0100
+++ b/KeyboardMap.st Mon Sep 08 16:53:24 2014 +0100
@@ -116,14 +116,23 @@
"Modified: 23.4.1996 / 21:55:04 / cg"
!
+hasBindingFor:aKey
+ "retrieve a logical key"
+
+ |whichMap|
+
+ whichMap := (current notNil ifTrue:[current] ifFalse:[self]).
+ ^ whichMap includesKey:aKey
+!
+
valueFor:aKey
"retrieve a logical key"
- |where value|
+ |whichMap value|
- where := (current notNil ifTrue:[current] ifFalse:[self]).
+ whichMap := (current notNil ifTrue:[current] ifFalse:[self]).
- value := where at:aKey ifAbsent:aKey.
+ value := whichMap at:aKey ifAbsent:aKey.
(value isMemberOf:KeyboardMap) ifTrue:[
current := value.
^ nil.
@@ -137,5 +146,6 @@
!KeyboardMap class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/KeyboardMap.st,v 1.13 2009-06-01 08:43:53 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/KeyboardMap.st,v 1.14 2014-07-29 19:26:30 cg Exp $'
! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/NOAUTOLOAD Mon Sep 08 16:53:24 2014 +0100
@@ -0,0 +1,1 @@
+loaded from binary class lib - skip in search for autoloaded classes
--- a/ResourcePack.st Wed Jun 25 11:13:58 2014 +0100
+++ b/ResourcePack.st Mon Sep 08 16:53:24 2014 +0100
@@ -1462,7 +1462,7 @@
"/ what a kludge - Dolphin and Squeak mean: printOn: a stream;
"/ ST/X (and some old ST80's) mean: draw-yourself on a GC.
- (aGCOrStream isStream or:[aGCOrStream == Transcript]) ifTrue:[
+ (aGCOrStream isStream) ifTrue:[
aGCOrStream nextPutAll:'ResourcePack for: '.
packsClassName printOn:aGCOrStream.
^ self.
@@ -1474,11 +1474,11 @@
!ResourcePack class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/ResourcePack.st,v 1.156 2014-02-06 14:36:19 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/ResourcePack.st,v 1.157 2014-07-10 12:24:00 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/ResourcePack.st,v 1.156 2014-02-06 14:36:19 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/ResourcePack.st,v 1.157 2014-07-10 12:24:00 cg Exp $'
! !
--- a/SimpleView.st Wed Jun 25 11:13:58 2014 +0100
+++ b/SimpleView.st Mon Sep 08 16:53:24 2014 +0100
@@ -808,22 +808,19 @@
extent:extent
"create a new view with given extent"
- ^ self origin:nil extent:extent borderWidth:nil
- font:nil label:nil in:nil
+ ^ self origin:nil extent:extent borderWidth:nil font:nil label:nil in:nil
!
extent:extent in:aView
"create a new view as a subview of aView with given extent"
- ^ self origin:nil extent:extent borderWidth:nil
- font:nil label:nil in:aView
+ ^ self origin:nil extent:extent borderWidth:nil font:nil label:nil in:aView
!
extent:extent label:label
"create a new view with given extent and label"
- ^ self origin:nil extent:extent borderWidth:nil
- font:nil label:label in:nil
+ ^ self origin:nil extent:extent borderWidth:nil font:nil label:label in:nil
!
in:aView
@@ -834,15 +831,19 @@
If its later realized and no superview has ever been set,
it will come up as a topview."
- |newView|
+ |newView device|
newView := self basicNew.
aView notNil ifTrue:[
- newView initializeForDevice:(aView graphicsDevice).
-"/ newView container:aView.
+ device := aView graphicsDevice.
] ifFalse:[
- newView initializeForDevice:Screen current
- ].
+ device := Screen current.
+ ].
+ newView device:device.
+ (device supportsNativeWidgetType:newView nativeWindowType) ifTrue:[
+ newView beNativeWidget
+ ].
+ newView initialize.
aView notNil ifTrue:[aView addSubView:newView].
^ newView
@@ -852,15 +853,13 @@
label:label
"create a new view with given label"
- ^ self origin:nil extent:nil borderWidth:nil
- font:nil label:label in:nil
+ ^ self origin:nil extent:nil borderWidth:nil font:nil label:label in:nil
!
label:label in:aView
"create a new view as subview of aView with given label"
- ^ self origin:nil extent:nil borderWidth:nil
- font:nil label:label in:aView
+ ^ self origin:nil extent:nil borderWidth:nil font:nil label:label in:aView
!
model:aModel
@@ -904,21 +903,13 @@
origin:origin corner:corner
"create a new view with given origin and extent"
- ^ self origin:origin corner:corner borderWidth:nil
- font:nil label:nil in:nil
+ ^ self origin:origin corner:corner borderWidth:nil font:nil label:nil in:nil
!
origin:anOrigin corner:aCorner borderWidth:bw font:aFont label:aLabel in:aView
|newView|
- aView notNil ifTrue:[
- newView := self basicNew.
- newView device:(aView graphicsDevice).
- newView initialize.
- aView addSubView:newView.
- ] ifFalse:[
- newView := self new. "/ onDevice:Screen current
- ].
+ newView := self in:aView.
bw notNil ifTrue:[newView borderWidth:bw].
anOrigin notNil ifTrue:[newView origin:anOrigin].
aCorner notNil ifTrue:[newView corner:aCorner].
@@ -932,42 +923,31 @@
origin:origin corner:corner borderWidth:bw in:aView
"create a new view as a subview of aView with given origin and extent"
- ^ self origin:origin corner:corner borderWidth:bw
- font:nil label:nil in:aView
+ ^ self origin:origin corner:corner borderWidth:bw font:nil label:nil in:aView
!
origin:origin corner:corner in:aView
"create a new view as a subview of aView with given origin and extent"
- ^ self origin:origin corner:corner borderWidth:nil
- font:nil label:nil in:aView
+ ^ self origin:origin corner:corner borderWidth:nil font:nil label:nil in:aView
!
origin:origin extent:extent
"create a new view with given origin and extent"
- ^ self origin:origin extent:extent borderWidth:nil
- font:nil label:nil in:nil
+ ^ self origin:origin extent:extent borderWidth:nil font:nil label:nil in:nil
!
origin:origin extent:extent borderWidth:bw
"create a new view with given origin, extent and borderWidth"
- ^ self origin:origin extent:extent borderWidth:bw
- font:nil label:nil in:nil
+ ^ self origin:origin extent:extent borderWidth:bw font:nil label:nil in:nil
!
origin:anOrigin extent:anExtent borderWidth:bw font:aFont label:aLabel in:aView
|newView|
- aView notNil ifTrue:[
- newView := self basicNew.
- newView device:(aView graphicsDevice).
- newView initialize.
- aView addSubView:newView.
- ] ifFalse:[
- newView := self new. "/ onDevice:Screen current
- ].
+ newView := self in:aView.
bw notNil ifTrue:[newView borderWidth:bw].
anExtent notNil ifTrue:[newView extent:anExtent].
anOrigin notNil ifTrue:[newView origin:anOrigin].
@@ -982,32 +962,27 @@
"create a new view as a subview of aView with given origin, extent
and borderWidth"
- ^ self origin:origin extent:extent borderWidth:bw
- font:nil label:nil in:aView
+ ^ self origin:origin extent:extent borderWidth:bw font:nil label:nil in:aView
!
origin:origin extent:extent font:aFont label:label
- ^ self origin:origin extent:extent borderWidth:nil
- font:nil label:label in:nil
+ ^ self origin:origin extent:extent borderWidth:nil font:nil label:label in:nil
!
origin:origin extent:extent font:aFont label:label in:aView
- ^ self origin:origin extent:extent borderWidth:nil
- font:aFont label:label in:aView
+ ^ self origin:origin extent:extent borderWidth:nil font:aFont label:label in:aView
!
origin:origin extent:extent in:aView
"create a new view as a subview of aView with given origin and extent"
- ^ self origin:origin extent:extent borderWidth:nil
- font:nil label:nil in:aView
+ ^ self origin:origin extent:extent borderWidth:nil font:nil label:nil in:aView
!
origin:origin extent:extent label:label
"create a new view with given origin, extent and label"
- ^ self origin:origin extent:extent borderWidth:nil
- font:nil label:label in:nil
+ ^ self origin:origin extent:extent borderWidth:nil font:nil label:label in:nil
!
origin:anOrigin extent:anExtent
@@ -1028,8 +1003,7 @@
origin:origin in:aView
"create a new view as a subview of aView with given origin"
- ^ self origin:origin extent:nil borderWidth:nil
- font:nil label:nil in:aView
+ ^ self origin:origin extent:nil borderWidth:nil font:nil label:nil in:aView
! !
!SimpleView class methodsFor:'Signal constants'!
@@ -1341,8 +1315,8 @@
anyway."
<resource: #style (#viewSpacing #font #borderWidth #borderColor
- #viewBackground #shadowColor #lightColor
- #focusColor #focusBorderWidth)>
+ #viewBackground #shadowColor #lightColor
+ #focusColor #focusBorderWidth)>
|bgGrey currentScreen|
@@ -1351,66 +1325,66 @@
and keep the values in fast class variables
"
StyleSheet isNil ifTrue:[
- self setDefaultStyle.
- self readStyleSheet.
+ self setDefaultStyle.
+ self readStyleSheet.
].
currentScreen := Screen current ? Screen default.
Grey := StyleSheet viewGrey.
Grey isNil ifTrue:[
- Grey := Color grey
+ Grey := Color gray
].
Grey := Grey onDevice:currentScreen.
StyleSheet fileReadFailed ifTrue:[
- bgGrey := Color white
+ bgGrey := Color white
] ifFalse:[
- currentScreen hasGrayscales ifTrue:[
- bgGrey := Grey
- ] ifFalse:[
- bgGrey := Color white.
- ]
+ currentScreen hasGrayscales ifTrue:[
+ bgGrey := Grey
+ ] ifFalse:[
+ bgGrey := Color white.
+ ]
].
bgGrey := bgGrey onDevice:currentScreen.
ViewSpacing := StyleSheet at:#viewSpacing.
ViewSpacing isNil ifTrue:[
- ViewSpacing := currentScreen defaultStyleValueFor:#viewSpacing.
+ ViewSpacing := currentScreen defaultStyleValueFor:#viewSpacing.
].
DefaultBorderColor := StyleSheet colorAt:#borderColor.
DefaultBorderColor isNil ifTrue:[
- DefaultBorderColor := currentScreen defaultStyleValueFor:#borderColor
+ DefaultBorderColor := currentScreen defaultStyleValueFor:#borderColor
].
StyleSheet fileReadFailed ifTrue:[
- DefaultBorderWidth := 1.
- DefaultFocusColor := DefaultShadowColor := Color black.
- DefaultViewBackgroundColor := DefaultLightColor := Color white.
- DefaultFocusBorderWidth := 1.
+ DefaultBorderWidth := 1.
+ DefaultFocusColor := DefaultShadowColor := Color black.
+ DefaultViewBackgroundColor := DefaultLightColor := Color white.
+ DefaultFocusBorderWidth := 1.
] ifFalse:[
- DefaultBorderWidth := StyleSheet at:#borderWidth default:0.
- DefaultViewBackgroundColor := StyleSheet colorAt:#viewBackground default:bgGrey.
- DefaultShadowColor := StyleSheet colorAt:#shadowColor.
- DefaultLightColor := StyleSheet colorAt:#lightColor.
- DefaultFocusColor := StyleSheet colorAt:#focusColor default:Color red.
- DefaultFocusBorderWidth := StyleSheet at:'focusBorderWidth' default:2.
+ DefaultBorderWidth := StyleSheet at:#borderWidth default:0.
+ DefaultViewBackgroundColor := StyleSheet colorAt:#viewBackground default:bgGrey.
+ DefaultShadowColor := StyleSheet colorAt:#shadowColor.
+ DefaultLightColor := StyleSheet colorAt:#lightColor.
+ DefaultFocusColor := StyleSheet colorAt:#focusColor default:Color red.
+ DefaultFocusBorderWidth := StyleSheet at:'focusBorderWidth' default:2.
].
self == SimpleView ifTrue:[
- DefaultFont := StyleSheet at:#font.
- DefaultFont isNil ifTrue:[
- DefaultFont := Font family:'courier' face:'medium' style:'roman' size:12.
- ].
- DefaultFont := DefaultFont onDevice:currentScreen.
+ DefaultFont := StyleSheet at:#font.
+ DefaultFont isNil ifTrue:[
+ DefaultFont := Font family:'courier' face:'medium' style:'roman' size:12.
+ ].
+ DefaultFont := DefaultFont onDevice:currentScreen.
] ifFalse:[
- DefaultFont := nil
+ DefaultFont := nil
].
DefaultViewBackgroundColor isNil ifTrue:[
- 'SimpleView [warning]: bad viewBackground in style - using white' errorPrintCR.
- DefaultViewBackgroundColor := Color white
+ 'SimpleView [warning]: bad viewBackground in style - using white' errorPrintCR.
+ DefaultViewBackgroundColor := Color white
].
"Modified: / 29-04-1997 / 11:16:52 / dq"
@@ -1555,8 +1529,8 @@
"/ what a kludge - Dolphin and Squeak mean: printOn:;
"/ ST/X (and some old ST80's) mean: draw-yourself on.
- (aGCOrStream isStream or:[aGCOrStream == Transcript]) ifTrue:[
- ^ super displayOn:aGCOrStream
+ (aGCOrStream isStream) ifTrue:[
+ ^ super displayOn:aGCOrStream
].
self redraw
@@ -2002,7 +1976,7 @@
aNumber := aNumberOrNil.
aNumber notNil ifTrue:[
self assert:(aNumber >= 0).
- aNumber := aNumber max: 0
+ aNumber := aNumber max: 0
].
"/ backward compatibility
@@ -3557,15 +3531,15 @@
!SimpleView methodsFor:'accessing-display attributes'!
beMDIChildView
- flagBits := flagBits bitOr:FlagIsMDIChild
+ flagBits := (flagBits ? 0) bitOr:FlagIsMDIChild
!
beNativeWidget
- flagBits := flagBits bitOr:FlagNativeWidget
+ flagBits := (flagBits ? 0) bitOr:FlagNativeWidget
!
beNonNativeWidget
- flagBits := flagBits bitClear:FlagNativeWidget
+ flagBits := (flagBits ? 0) bitClear:FlagNativeWidget
!
isMDIChildView
@@ -3581,11 +3555,11 @@
!
markAsUnmappedModalBox
- flagBits := flagBits bitOr:FlagIsUnmappedModalBox
+ flagBits := (flagBits ? 0) bitOr:FlagIsUnmappedModalBox
!
unmarkAsUnmappedModalBox
- flagBits := flagBits bitClear:FlagIsUnmappedModalBox
+ flagBits := (flagBits ? 0) bitClear:FlagIsUnmappedModalBox
! !
!SimpleView methodsFor:'accessing-hierarchy'!
@@ -6016,7 +5990,7 @@
"
redraw inside area
"
- self
+ self
clippingBounds:(Rectangle left:nx top:ny width:nw height:nh);
redrawX:nx y:ny width:nw height:nh.
].
@@ -7319,7 +7293,7 @@
|ext myClass controllerClass|
- flagBits := 0.
+ flagBits := flagBits ? 0.
super initialize.
@@ -7350,15 +7324,15 @@
"/ self originChangedFlag:false extentChangedFlag:false cornerChangedFlag:false.
name isNil ifTrue:[
- name := self class name.
+ name := self class name.
].
bitGravity := #NorthWest. "/ nil.
viewGravity := nil.
controllerClass := self defaultControllerClass.
controllerClass notNil ifTrue:[
- controller := controllerClass new.
- controller view:self.
+ controller := controllerClass new.
+ controller view:self.
].
self initializeMiddleButtonMenu.
@@ -7798,6 +7772,16 @@
^ aMenu startUpFor:self
! !
+!SimpleView methodsFor:'native widget support'!
+
+nativeWindowType
+ "return a symbol describing my native window type - here, nil is returned
+ (may be used internally by the device as a native window creation hint,
+ iff native windows are enabled AND the device supports it)"
+
+ ^ nil
+! !
+
!SimpleView methodsFor:'private'!
componentsContainingX:x y:y do:aBlock
@@ -8916,13 +8900,6 @@
!SimpleView methodsFor:'queries-internal'!
-nativeWindowType
- "return a symbol describing my native window type - here, nil is returned
- (may be used internally by the device as a native window creation hint)"
-
- ^ nil
-!
-
specClass
"fallback - heuristics to get a specClass for some viewClass.
Based upon my className, look for a corresponding Spec-class.
@@ -9876,14 +9853,17 @@
The given rectangle is in device coordinate space."
shown ifFalse:[
- "/ no need to add damage - will get a full-redraw anyway,
- "/ when I will be shown again.
- ^ self
- ].
-
+ "/ no need to add damage - will get a full-redraw anyway,
+ "/ when I will be shown again.
+ ^ self
+ ].
+ (aRectangle width <= 0 or:[aRectangle height <= 0]) ifTrue:[
+ "/ no need to add damages with extent <= 0
+ ^ self
+ ].
self sensor addDamage:aRectangle view:self.
doRepairNow ifTrue:[
- self repairDamage
+ self repairDamage
]
"Modified: / 10.11.1998 / 01:55:03 / cg"
@@ -11233,11 +11213,11 @@
!SimpleView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.756 2014-06-18 16:55:21 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.760 2014-08-03 09:32:31 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.756 2014-06-18 16:55:21 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.760 2014-08-03 09:32:31 cg Exp $'
!
version_SVN
--- a/StandardSystemView.st Wed Jun 25 11:13:58 2014 +0100
+++ b/StandardSystemView.st Mon Sep 08 16:53:24 2014 +0100
@@ -1420,6 +1420,10 @@
topDirectory := OperatingSystem getHomeDirectory asFilename.
] ifFalse:[
topDirectory := stxPackageDirectory directory.
+ "/ a hack to make it look nicer on mac... (shows Packages otherwise)
+ topDirectory baseName = 'Packages' ifTrue:[
+ topDirectory := topDirectory directory
+ ].
].
lbl := windowLabelFormat
bindWith:labelString
@@ -1709,11 +1713,11 @@
!StandardSystemView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/StandardSystemView.st,v 1.221 2014-06-11 13:59:15 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/StandardSystemView.st,v 1.222 2014-06-29 14:17:45 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/StandardSystemView.st,v 1.221 2014-06-11 13:59:15 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/StandardSystemView.st,v 1.222 2014-06-29 14:17:45 cg Exp $'
! !
--- a/WinWorkstation.st Wed Jun 25 11:13:58 2014 +0100
+++ b/WinWorkstation.st Mon Sep 08 16:53:24 2014 +0100
@@ -7755,14 +7755,17 @@
|info fullHeight usableHeight delta|
true "(self numberOfMonitors) > 1" ifTrue:[
- "/ ******* MULTI SCREEN ******
- info := self monitorInfoFor:(self monitorHandleForPoint:aPoint).
- info notNil ifTrue:[
- fullHeight := self getSystemMetrics:#SM_CYVIRTUALSCREEN.
- usableHeight := self getSystemMetrics:#SM_CYFULLSCREEN. "/ without any start-menu bar
- delta := fullHeight - usableHeight.
- ^ info workHeight - delta
- ].
+ "/ ******* MULTI SCREEN ******
+ info := self monitorInfoFor:(self monitorHandleForPoint:aPoint).
+ info notNil ifTrue:[
+ ^ info workHeight
+
+ "/ only works with single screen..
+"/ fullHeight := self getSystemMetrics:#SM_CYVIRTUALSCREEN.
+"/ usableHeight := self getSystemMetrics:#SM_CYFULLSCREEN. "/ without any start-menu bar
+"/ delta := fullHeight - usableHeight.
+"/ ^ info workHeight - delta
+ ].
].
^ self usableHeight
@@ -8669,16 +8672,16 @@
lI->mouseX = lI->mouseY = -9999;
if (isTopWindow) {
-/****** MULTI SCREEN *********
+/****** MULTI SCREEN CATZKERN *********
if (rec.left < 0) {
rec.left = 0;
rec.right = w;
}
-****** MULTI SCREEN *********/
if (rec.top < 0) {
rec.top = 0;
rec.bottom = h;
}
+****** MULTI SCREEN CATZKERN *********/
lI->flag |= LI_TOPWIN;
} else {
@@ -19349,11 +19352,11 @@
!WinWorkstation class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/WinWorkstation.st,v 1.484 2014-06-05 09:56:00 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/WinWorkstation.st,v 1.485 2014-08-28 15:14:38 ca Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/WinWorkstation.st,v 1.484 2014-06-05 09:56:00 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/WinWorkstation.st,v 1.485 2014-08-28 15:14:38 ca Exp $'
! !
--- a/WindowGroup.st Wed Jun 25 11:13:58 2014 +0100
+++ b/WindowGroup.st Mon Sep 08 16:53:24 2014 +0100
@@ -1141,6 +1141,7 @@
LastActiveGroup := nil.
[
startupAction value.
+ self showWaitCursorWhenBusyForMillis:400.
self eventLoopWhile:[true] onLeave:[]
] ensure:[
|dev w app|
@@ -2006,9 +2007,20 @@
|oldFocusView|
+ "/ the problem was that the #focusToView: asked for canTab
+ "/ what should not be done during restore (might anser false).
+
oldFocusView := self focusView.
- self focusToView:nil.
- self focusToView:oldFocusView
+ oldFocusView isNil ifTrue:[^ self].
+
+ self focusView:nil.
+
+ self focusView == oldFocusView ifTrue:[^ self].
+ (oldFocusView shown and:[oldFocusView enabled]) ifTrue:[
+ self focusView:oldFocusView.
+ ].
+"/ self focusToView:nil.
+"/ self focusToView:oldFocusView
!
focusNext
@@ -2837,11 +2849,11 @@
!WindowGroup class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/WindowGroup.st,v 1.331 2014-06-24 10:35:30 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/WindowGroup.st,v 1.333 2014-08-26 09:48:39 ca Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/WindowGroup.st,v 1.331 2014-06-24 10:35:30 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/WindowGroup.st,v 1.333 2014-08-26 09:48:39 ca Exp $'
! !
--- a/XWorkstation.st Wed Jun 25 11:13:58 2014 +0100
+++ b/XWorkstation.st Mon Sep 08 16:53:24 2014 +0100
@@ -1236,6 +1236,16 @@
"
!
+hasRenderExtension
+ "return true, if this workstation supports the X render extension."
+
+ ^ self hasExtension:'RENDER'
+
+ "
+ Display hasRenderExtension
+ "
+!
+
hasShm
"return true, if this workstation supports the shared pixmap extension.
Both the server must support it, and the feature must have been
@@ -1605,6 +1615,16 @@
^ true
!
+supportsXFTFonts
+ "return true, if this device supports xft (truetype) fonts."
+
+ ^ self hasRenderExtension
+
+ "
+ Display supportsXFTFonts
+ "
+!
+
usableHeightAt:aPoint
"returns the usable height of the display (in pixels) at a given point
Normally, the same as height, but may be smaller, in
@@ -6389,7 +6409,7 @@
"send a keyPress/Release or buttonPress/Release event to some (possibly alien) view.
TypeSymbol must be one of: #keyPress, #keyRelease, #buttonPress , #buttonRelease.
For buttonEvents, the keySymCodeOrButtonNr must be the buttons number (1, 2 ...);
- for key events, it can be either a symbol (as listen in X's keySyms)
+ for key events, it can be either a symbol (as listed in X's keySyms)
or a numeric keysym code. If state is nil, the modifier bits (shift & control)
are computed from the keyboardMap - if non-nil, these are passed as modifierbits.
The non-nil case is the lowlevel entry, where state must include any shift/ctrl information
@@ -6401,110 +6421,178 @@
int state;
if (__isSmallInteger(stateMask)) {
- state = __intVal(stateMask);
+ state = __intVal(stateMask);
} else {
- state = 0;
+ state = 0;
}
if (ISCONNECTED
&& __isSmallInteger(xPos) && __isSmallInteger(yPos)
&& (__isSmallInteger(keySymCodeOrButtonNr) || __isStringLike(keySymCodeOrButtonNr))
&& (__isExternalAddress(targetId) || __isInteger(targetId))) {
- Display *dpy = myDpy;
-
- XEvent ev;
- Window target;
- Status result;
- KeySym keySym, *syms;
- int screen = __intVal(__INST(screen));
- char s[2];
- int nSyms;
-
- if ((typeSymbol == @symbol(keyPress))
- || (typeSymbol == @symbol(keyRelease))) {
- if (__isStringLike(keySymCodeOrButtonNr)) {
- keySym = XStringToKeysym(__stringVal(keySymCodeOrButtonNr));
- } else {
- if (__isCharacter(keySymCodeOrButtonNr)) {
- s[0] = __intVal(__characterVal(keySymCodeOrButtonNr));
- s[1] = '\0';
- keySym = XStringToKeysym(s);
- } else {
- keySym = (KeySym) __intVal(keySymCodeOrButtonNr);
- }
- }
- ev.xkey.keycode = XKeysymToKeycode(dpy, keySym);
-
- if (stateMask == nil) {
- /*
- * get the modifier from the keySym
- */
- nSyms = 0;
- syms = XGetKeyboardMapping(dpy, ev.xkey.keycode, 1, &nSyms);
- if (syms) {
- int i;
-
- for (i=0; i<nSyms; i++) {
- if (syms[i] == keySym) {
+ Display *dpy = myDpy;
+
+ XEvent ev;
+ Window target;
+ Status result;
+ KeySym keySym, *syms;
+ int screen = __intVal(__INST(screen));
+ char s[2];
+ int nSyms;
+
+ if ((typeSymbol == @symbol(keyPress))
+ || (typeSymbol == @symbol(keyRelease))) {
+ if (__isStringLike(keySymCodeOrButtonNr)) {
+ keySym = XStringToKeysym(__stringVal(keySymCodeOrButtonNr));
+ } else {
+ if (__isCharacter(keySymCodeOrButtonNr)) {
+ s[0] = __intVal(__characterVal(keySymCodeOrButtonNr));
+ s[1] = '\0';
+ keySym = XStringToKeysym(s);
+ } else {
+ keySym = (KeySym) __intVal(keySymCodeOrButtonNr);
+ }
+ }
+ ev.xkey.keycode = XKeysymToKeycode(dpy, keySym);
+
+ if (stateMask == nil) {
+ /*
+ * get the modifier from the keySym
+ */
+ nSyms = 0;
+ syms = XGetKeyboardMapping(dpy, ev.xkey.keycode, 1, &nSyms);
+ if (syms) {
+ int i;
+
+ for (i=0; i<nSyms; i++) {
+ if (syms[i] == keySym) {
#ifdef MODIFIERDEBUG
- console_printf("modifier-index is %d\n", i);
-#endif
- if (i) state = (1 << (i-1));
- break;
- }
- }
- XFree(syms);
- }
- }
- } else {
- if ((typeSymbol == @symbol(buttonPress))
- || (typeSymbol == @symbol(buttonRelease))) {
- if (__isSmallInteger(keySymCodeOrButtonNr)) {
- ev.xbutton.button = __intVal(keySymCodeOrButtonNr);
- } else {
- ev.xbutton.button = 1;
- }
- } else {
- DPRINTF(("invalid sendEvent typeSymbol\n"));
- RETURN (false);
- }
- }
-
- if (typeSymbol == @symbol(keyPress))
- ev.xany.type = KeyPress;
- else if (typeSymbol == @symbol(keyRelease))
- ev.xany.type = KeyRelease;
- else if (typeSymbol == @symbol(buttonPress))
- ev.xany.type = ButtonPress;
- else if (typeSymbol == @symbol(buttonRelease))
- ev.xany.type = ButtonRelease;
-
- if (__isExternalAddress(targetId)) {
- target = __WindowVal(targetId);
- } else {
- target = (Window) __longIntVal(targetId);
- }
- ev.xkey.window = target;
- ev.xkey.same_screen = 1;
- ev.xkey.subwindow = 0;
- ev.xkey.root = RootWindow(dpy, screen);
- ev.xkey.x = __intVal(xPos);
- ev.xkey.y = __intVal(yPos);
- ev.xkey.state = state;
- ev.xkey.time = CurrentTime;
-
- ENTER_XLIB();
- result = XSendEvent(dpy, target, False, 0 , &ev);
- LEAVE_XLIB();
- if ((result == BadValue) || (result == BadWindow)) {
- DPRINTF(("bad status\n"));
- RETURN ( false )
- }
- RETURN (true)
+ console_printf("modifier-index is %d\n", i);
+#endif
+ if (i) state = (1 << (i-1));
+ break;
+ }
+ }
+ XFree(syms);
+ }
+ }
+ } else {
+ if ((typeSymbol == @symbol(buttonPress))
+ || (typeSymbol == @symbol(buttonRelease))) {
+ if (__isSmallInteger(keySymCodeOrButtonNr)) {
+ ev.xbutton.button = __intVal(keySymCodeOrButtonNr);
+ } else {
+ ev.xbutton.button = 1;
+ }
+ } else {
+ DPRINTF(("invalid sendEvent typeSymbol\n"));
+ RETURN (false);
+ }
+ }
+
+ if (typeSymbol == @symbol(keyPress))
+ ev.xany.type = KeyPress;
+ else if (typeSymbol == @symbol(keyRelease))
+ ev.xany.type = KeyRelease;
+ else if (typeSymbol == @symbol(buttonPress))
+ ev.xany.type = ButtonPress;
+ else if (typeSymbol == @symbol(buttonRelease))
+ ev.xany.type = ButtonRelease;
+
+ if (__isExternalAddress(targetId)) {
+ target = __WindowVal(targetId);
+ } else {
+ target = (Window) __longIntVal(targetId);
+ }
+ ev.xkey.window = target;
+ ev.xkey.same_screen = 1;
+ ev.xkey.subwindow = 0;
+ ev.xkey.root = RootWindow(dpy, screen);
+ ev.xkey.x = __intVal(xPos);
+ ev.xkey.y = __intVal(yPos);
+ ev.xkey.state = state;
+ ev.xkey.time = CurrentTime;
+
+ ENTER_XLIB();
+ result = XSendEvent(dpy, target, False, 0 , &ev);
+ LEAVE_XLIB();
+ if ((result == BadValue) || (result == BadWindow)) {
+ DPRINTF(("bad status\n"));
+ RETURN ( false )
+ }
+ RETURN (true)
}
%}.
self primitiveFailedOrClosedConnection.
^ false
+
+ "<<END
+ |v|
+
+ v := EditTextView extent:200@100.
+ v contents:'Hello world'.
+ v openAndWait.
+ v selectFromCharacterPosition:1 to:5.
+
+ "/ CTRL-c
+ v device
+ sendKeyOrButtonEvent:#keyPress
+ x:10 y:10
+ keyOrButton:#'Control'
+ state:(v device ctrlModifierMask)
+ toViewId: v id.
+
+ v device
+ sendKeyOrButtonEvent:#keyPress
+ x:10 y:10
+ keyOrButton:'c'
+ state:(v device ctrlModifierMask)
+ toViewId: v id.
+
+ v device
+ sendKeyOrButtonEvent:#keyRelease
+ x:10 y:10
+ keyOrButton:'c'
+ state:(v device ctrlModifierMask)
+ toViewId: v id.
+
+ v device
+ sendKeyOrButtonEvent:#keyRelease
+ x:10 y:10
+ keyOrButton:#'Control'
+ state:0
+ toViewId: v id.
+
+ "/ CTRL-v
+
+ v device
+ sendKeyOrButtonEvent:#keyPress
+ x:10 y:10
+ keyOrButton:#'Control'
+ state:(v device ctrlModifierMask)
+ toViewId: v id.
+
+ v device
+ sendKeyOrButtonEvent:#keyPress
+ x:10 y:10
+ keyOrButton:'v'
+ state:(v device ctrlModifierMask)
+ toViewId: v id.
+
+ v device
+ sendKeyOrButtonEvent:#keyRelease
+ x:10 y:10
+ keyOrButton:'v'
+ state:(v device ctrlModifierMask)
+ toViewId: v id.
+
+ v device
+ sendKeyOrButtonEvent:#keyRelease
+ x:10 y:10
+ keyOrButton:#'Control'
+ state:0
+ toViewId: v id.
+END"
! !
!XWorkstation methodsFor:'font stuff'!
@@ -7460,23 +7548,23 @@
|names|
listOfXFonts isNil ifTrue:[
- names := self getAvailableFontsMatching:'*'.
- names isNil ifTrue:[
- "no names returned ..."
- ^ nil
- ].
- listOfXFonts := names collect:[:aName | self fontDescriptionFromXFontName:aName].
- listOfXFonts := FontDescription genericFonts, listOfXFonts.
+ names := self getAvailableFontsMatching:'*'.
+ names isNil ifTrue:[
+ "no names returned ..."
+ ^ nil
+ ].
+ listOfXFonts := names collect:[:aName | self fontDescriptionFromXFontName:aName].
+ listOfXFonts := FontDescription genericFonts, listOfXFonts.
].
(XftFontDescription notNil
- and:[ XftFontDescription isLoaded
- and:[ true "self queryXftLibrary" ]]
+ and:[ XftFontDescription isLoaded
+ and:[ self supportsXFTFonts ]]
) ifTrue:[
- UserPreferences current useXftFontsOnly ifTrue:[
- ^ (XftFontDescription listOfAvailableFonts)
- ].
- ^ listOfXFonts , (XftFontDescription listOfAvailableFonts).
+ UserPreferences current useXftFontsOnly ifTrue:[
+ ^ (XftFontDescription listOfAvailableFonts)
+ ].
+ ^ listOfXFonts , (XftFontDescription listOfAvailableFonts).
].
^ listOfXFonts
@@ -13299,11 +13387,11 @@
!XWorkstation class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.593 2014-06-23 23:26:15 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.596 2014-07-22 10:49:13 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.593 2014-06-23 23:26:15 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.596 2014-07-22 10:49:13 cg Exp $'
!
version_HG
--- a/XftFontDescription.st Wed Jun 25 11:13:58 2014 +0100
+++ b/XftFontDescription.st Mon Sep 08 16:53:24 2014 +0100
@@ -551,6 +551,12 @@
clipY := clipR top.
clipW := clipR width.
clipH := clipR height.
+ "/ YES YES YES: this MUST be transformed!!
+ "/ (see htmlView) fix the notebook, please.
+ transformation notNil ifTrue:[
+ clipX := (transformation applyToX:clipX) ceiling.
+ clipY := (transformation applyToY:clipY) ceiling.
+ ].
].
transformation := aGC transformation.
@@ -775,94 +781,97 @@
(device == aGraphicsDevice) ifTrue:[^ self].
(aGraphicsDevice isNil and:[device notNil]) ifTrue:[
- ^ self
+ ^ self
+ ].
+ aGraphicsDevice supportsXFTFonts ifFalse:[
+ ^ super onDevice:aGraphicsDevice
].
(closestFont notNil and:[closestFont graphicsDevice == aGraphicsDevice]) ifTrue:[
- ^ closestFont onDevice: aGraphicsDevice.
+ ^ closestFont onDevice: aGraphicsDevice.
].
RecentlyUsedFonts isNil ifTrue:[
- RecentlyUsedFonts := OrderedCollection new:10.
+ RecentlyUsedFonts := OrderedCollection new:10.
].
RecentlyUsedFonts keysAndValuesDo:[:index :aFont |
- ((aFont class == self class) and:[self sameDeviceFontAs:aFont]) ifTrue:[
- "/ Transcript showCR:'hit'.
- RecentlyUsedFonts removeIndex:index.
- RecentlyUsedFonts addFirst:aFont.
- ^ aFont
- ]
+ ((aFont class == self class) and:[(self sameDeviceFontAs:aFont) and:[aFont getFontId notNil]]) ifTrue:[
+ "/ Transcript showCR:'hit'.
+ RecentlyUsedFonts removeIndex:index.
+ RecentlyUsedFonts addFirst:aFont.
+ ^ aFont
+ ]
].
RecentlyUsedFonts size > 20 ifTrue:[
- RecentlyUsedFonts removeLast.
+ RecentlyUsedFonts removeLast.
].
aGraphicsDevice deviceFonts do:[:aFont |
- ((aFont class == self class) and:[self sameDeviceFontAs:aFont]) ifTrue:[
- RecentlyUsedFonts addFirst:aFont.
- ^ aFont
- ].
+ ((aFont class == self class) and:[self sameDeviceFontAs:aFont]) ifTrue:[
+ RecentlyUsedFonts addFirst:aFont.
+ ^ aFont
+ ].
].
[
- myPatternId := self xftPatternCreate.
- self xftPatternAdd: myPatternId attribute: FC_FAMILY value: family.
- pixelSize notNil ifTrue:[
- self xftPatternAdd: myPatternId attribute: FC_PIXEL_SIZE value: pixelSize.
- ] ifFalse:[
- self xftPatternAdd: myPatternId attribute: FC_SIZE value: size.
- ].
- self xftPatternAdd: myPatternId attribute: FC_WEIGHT value: (StXFace2FCWeightMap at: (face ? 'regular')).
- self xftPatternAdd: myPatternId attribute: FC_SLANT value: (StXStyle2FCSlantMap at: (style ? 'roman') ifAbsent:[StXStyle2FCSlantMap at: (style ? 'roman') asLowercase]).
+ myPatternId := self xftPatternCreate.
+ self xftPatternAdd: myPatternId attribute: FC_FAMILY value: family.
+ pixelSize notNil ifTrue:[
+ self xftPatternAdd: myPatternId attribute: FC_PIXEL_SIZE value: pixelSize.
+ ] ifFalse:[
+ self xftPatternAdd: myPatternId attribute: FC_SIZE value: size.
+ ].
+ self xftPatternAdd: myPatternId attribute: FC_WEIGHT value: (StXFace2FCWeightMap at: (face ? 'regular')).
+ self xftPatternAdd: myPatternId attribute: FC_SLANT value: (StXStyle2FCSlantMap at: (style ? 'roman') ifAbsent:[StXStyle2FCSlantMap at: (style ? 'roman') asLowercase]).
- newFontId := self xftFontOpenPattern: aGraphicsDevice displayId pattern: myPatternId.
- newFontId notNil ifTrue:[
- "/ Good, this font exists!!
- fontId := newFontId.
- device := aGraphicsDevice.
- aGraphicsDevice registerFont:self.
- RecentlyUsedFonts addFirst:self.
- ^ self.
- ] ifFalse:[
- closestPatternId1 := self xftFontMatch: aGraphicsDevice displayId screen: aGraphicsDevice screen pattern: myPatternId.
- closestPatternId1 isNil ifTrue:[
- self error: 'No font matches'.
- ].
- "
- self xftPatternGet: closestPatternId attribute: 'family' index: 0.
- self xftPatternGet: closestPatternId attribute: 'size' index: 0.
- "
- closestPatternId2 := self xftPatternDuplicate: closestPatternId1.
- newFontId := self xftFontOpenPattern: aGraphicsDevice displayId pattern: closestPatternId1.
- "/ !!!!!!!! closestPatternId is no longer valid !!!!!!!!
- closestPatternId1 := nil.
- newFontId isNil ifTrue:[
- self error: 'Pattern matched, but font could not be opened (should not happen)'.
- ].
+ newFontId := self xftFontOpenPattern: aGraphicsDevice displayId pattern: myPatternId.
+ newFontId notNil ifTrue:[
+ "/ Good, this font exists!!
+ fontId := newFontId.
+ device := aGraphicsDevice.
+ aGraphicsDevice registerFont:self.
+ RecentlyUsedFonts addFirst:self.
+ ^ self.
+ ] ifFalse:[
+ closestPatternId1 := self xftFontMatch: aGraphicsDevice displayId screen: aGraphicsDevice screen pattern: myPatternId.
+ closestPatternId1 isNil ifTrue:[
+ self error: 'No font matches'.
+ ].
+ "
+ self xftPatternGet: closestPatternId attribute: 'family' index: 0.
+ self xftPatternGet: closestPatternId attribute: 'size' index: 0.
+ "
+ closestPatternId2 := self xftPatternDuplicate: closestPatternId1.
+ newFontId := self xftFontOpenPattern: aGraphicsDevice displayId pattern: closestPatternId1.
+ "/ !!!!!!!! closestPatternId is no longer valid !!!!!!!!
+ closestPatternId1 := nil.
+ newFontId isNil ifTrue:[
+ self error: 'Pattern matched, but font could not be opened (should not happen)'.
+ ].
- "/ Search for existing registered font. Note, that XftFont instances
- "/ are shared (and refcounted) so newFontId = aFont getFontId is enough
- "/ to check whether some other font instance represents the same font...
- aGraphicsDevice deviceFonts do:[:aFont |
- ((self class == aFont class) and:[newFontId = aFont getFontId]) ifTrue:[
- closestFont := aFont.
- ^ closestFont
- ].
- ].
+ "/ Search for existing registered font. Note, that XftFont instances
+ "/ are shared (and refcounted) so newFontId = aFont getFontId is enough
+ "/ to check whether some other font instance represents the same font...
+ aGraphicsDevice deviceFonts do:[:aFont |
+ ((self class == aFont class) and:[newFontId = aFont getFontId]) ifTrue:[
+ closestFont := aFont.
+ ^ closestFont
+ ].
+ ].
- closestFont := self shallowCopy
- setDevice: aGraphicsDevice patternId: closestPatternId2 fontId: newFontId;
- yourself.
- aGraphicsDevice registerFont: closestFont.
- RecentlyUsedFonts addFirst:closestFont.
- ^ closestFont
- ].
+ closestFont := self shallowCopy
+ setDevice: aGraphicsDevice patternId: closestPatternId2 fontId: newFontId;
+ yourself.
+ aGraphicsDevice registerFont: closestFont.
+ RecentlyUsedFonts addFirst:closestFont.
+ ^ closestFont
+ ].
] ensure:[
- myPatternId notNil ifTrue:[self xftPatternDestroy: myPatternId].
- closestPatternId1 notNil ifTrue:[self xftPatternDestroy: closestPatternId1].
- closestPatternId2 notNil ifTrue:[self xftPatternDestroy: closestPatternId2].
+ myPatternId notNil ifTrue:[self xftPatternDestroy: myPatternId].
+ closestPatternId1 notNil ifTrue:[self xftPatternDestroy: closestPatternId1].
+ closestPatternId2 notNil ifTrue:[self xftPatternDestroy: closestPatternId2].
].
"
@@ -1632,6 +1641,11 @@
^ info
!
+getFontResolution
+ device isNil ifTrue:[ ^ 72 @ 72 ].
+ ^ device resolution
+!
+
height
"return the height - the number of pixels above plus below the baseLine."
@@ -2065,11 +2079,11 @@
!XftFontDescription class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/XftFontDescription.st,v 1.51.2.1 2014-05-08 08:27:51 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/XftFontDescription.st,v 1.60 2014-07-09 02:56:41 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/XftFontDescription.st,v 1.51.2.1 2014-05-08 08:27:51 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/XftFontDescription.st,v 1.60 2014-07-09 02:56:41 cg Exp $'
!
version_HG
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/styles/macosx.style Mon Sep 08 16:53:24 2014 +0100
@@ -0,0 +1,236 @@
+; View defaultStyle:#mswindowsVista
+;
+; $Header: /cvs/stx/stx/libview/styles/macosx.style,v 1.3 2014-07-10 23:28:38 cg Exp $
+
+#include 'Adwaita.style'
+
+name #macosx
+
+ToolbarIconLibrary ?(Smalltalk at:#MacOSXToolbarIconLibrary) ? (Smalltalk at:#XPToolbarIconLibrary) ? GenericToolbarIconLibrary
+
+;
+; unfinished
+;
+
+;
+; notice: the values below
+; are not used when running under native Windows
+; (uses system-settings values then)
+;
+selectionBlue Color rgbValue:16r2F7FFF
+
+viewGrey (Color rgbValue:16rEDEDED)
+viewLightGrey Color white
+lightColor Color white
+halfShadowColor (Color grey:80)
+halfLightColor =viewGrey
+shadowColor (Color grey:60)
+
+comment 'OSX lookalike (unfinished)'
+previewFileName 'viewStyleSample_macosx.png'
+
+#if (Language == #german) or:[Language == #de]
+comment 'an MacOSX angelehnter Stil (unvollständig)'
+#endif
+
+#if (Language == #french) or:[Language == #fr]
+comment 'Un style qui résemble MacOSX (incomplet)'
+#endif
+
+selection.hilightFrameColor nil
+selection.hilightBackgroundColorNoFocus (Color grey:75)
+selection.hilightForegroundColorNoFocus (Color black)
+
+slider.NTallyMarks nil
+scroller.NTallyMarks nil
+scroller.tallyLevel nil
+scroller.tallyInset nil
+scroller.tallyDistance nil
+
+
+menu.enteredLevel 0
+
+;; enable this, when old menuView cares for it also
+;; menu.itemMargin 1
+menu.selectionFollowsMouse true
+menu.enteredBackgroundColor =menu.hilightBackgroundColor
+menu.enteredForegroundColor =menu.hilightForegroundColor
+menu.iconIndicationOn.bitmapFile 'CheckOn_xp.xpm'
+menu.iconIndicationOff.bitmapFile 'CheckOff_xp.xpm'
+menu.iconRadioOn.bitmap (Windows8ToolbarIconLibrary radioOn12x12Icon)
+menu.iconRadioOff.bitmap (Windows8ToolbarIconLibrary radioOff12x12Icon)
+menu.iconDisabledIndicationOn.bitmapFile 'CheckOn_disabled_xp.xpm'
+menu.iconDisabledIndicationOff.bitmapFile 'CheckOff_disabled_xp.xpm'
+menu.iconDisabledRadioOn.bitmap (Windows8ToolbarIconLibrary radioOnDisabled12x12Icon)
+menu.iconDisabledRadioOff.bitmap (Windows8ToolbarIconLibrary radioOffDisabled12x12Icon)
+
+button.edgeStyle nil
+button.borderWidth 1
+button.activeLevel 0
+button.passiveLevel 0
+
+button.frameColor (Color redByte:16rAC greenByte:16rAC blueByte:16rAC)
+button.enteredFrameColor (Color red:50 green:70 blue:92)
+button.activeFrameColor (Color red:34 green:62 blue:90)
+button.enteredBackgroundColor ((GradientBackground vertical:(Color rgbValue:16rEBF3FB) to:(Color rgbValue:16rDCEBFB)) usedLength:24)
+button.activeBackgroundColor ((GradientBackground vertical:(Color rgbValue:16rDAEBFB) to:(Color rgbValue:16rC3E0FB)) usedLength:24)
+button.activeForegroundColor (Color black)
+
+arrowButton.borderWidth 0
+checkToggle.borderWidth 0
+radioButton.borderWidth 0
+comboView.button.borderWidth 0
+
+comboView.downForm [Windows8ToolbarIconLibrary scrollDownOffIcon]
+comboView.disabledDownForm [Windows8ToolbarIconLibrary scrollDownOffIcon]
+comboView.enteredDownForm [Windows8ToolbarIconLibrary scrollDownOffEntered2Icon]
+comboView.activeDownForm [Windows8ToolbarIconLibrary scrollDownActiveIcon]
+; comboView.downFormFile 'ComboDn_xp.xpm'.
+; comboView.disabledDownFormFile 'ComboDn_disabled_xp.xpm'.
+; comboView.activeDownFormFile 'ComboDn_active_xp.xpm'.
+; comboView.enteredDownFormFile 'ComboDn_entered_xp.xpm'.
+comboView.button.activeLevel 0
+comboView.button.passiveLevel 0
+comboView.button.activeBackgroundColor =viewGrey
+; comboView.button.activeBackgroundColor (Color white)
+; comboView.button.backgroundColor (Color white)
+; comboView.level 0
+
+; selection.highlightEnterItem true "/ underline-highlight item under cursor
+
+scrollBar.position #right
+scrollBar.buttonPositions #bottom
+
+;scroller.viewBackground (Color redByte:16rF0 greenByte:16rF0 blueByte:16rF0)
+;scroller.thumbColor (Color redByte:16rCD greenByte:16rCD blueByte:16rCD)
+;scroller.thumbLightColor =scroller.thumbColor
+;scroller.thumbShadowColor =scroller.thumbColor
+;scroller.thumbEnteredColor (Color redByte:16rA6 greenByte:16rA6 blueByte:16rA6)
+;scroller.thumbActiveColor (Color redByte:16r60 greenByte:16r60 blueByte:16r60)
+;scroller.thumbLevel 0
+;scroller.thumbInset 1
+;scroller.thumbFrameColor nil
+;scroller.thumbEdgeStyle nil
+;scroller.NTallyMarks nil
+;scroller.tallyLevel nil
+;scroller.tallyInset nil
+;scroller.tallyDistance nil
+;scroller.snapBackDistance 100
+;scroller.minThumbSize 16
+
+;scroller.vista3DStyle false
+;
+;miniScroller.size 3 "/ in millimeters
+;
+;
+;arrowButton.upForm [Windows8ToolbarIconLibrary scrollUpOffIcon]
+;arrowButton.enteredUpForm [Windows8ToolbarIconLibrary scrollUpOffEntered2Icon]
+;arrowButton.activeUpForm [Windows8ToolbarIconLibrary scrollUpActiveIcon]
+;arrowButton.disabledUpForm [Windows8ToolbarIconLibrary scrollUpOffIcon]
+;
+;arrowButton.downForm [Windows8ToolbarIconLibrary scrollDownOffIcon]
+;arrowButton.enteredDownForm [Windows8ToolbarIconLibrary scrollDownOffEntered2Icon]
+;arrowButton.activeDownForm [Windows8ToolbarIconLibrary scrollDownActiveIcon]
+;arrowButton.disabledDownForm [Windows8ToolbarIconLibrary scrollDownOffIcon]
+;
+;arrowButton.leftForm [Windows8ToolbarIconLibrary scrollLeftOffIcon]
+;arrowButton.enteredLeftForm [Windows8ToolbarIconLibrary scrollLeftOffEntered2Icon]
+;arrowButton.activeLeftForm [Windows8ToolbarIconLibrary scrollLeftActiveIcon]
+;arrowButton.disabledLeftForm [Windows8ToolbarIconLibrary scrollLeftOffIcon]
+;
+;arrowButton.rightForm [Windows8ToolbarIconLibrary scrollRightOffIcon]
+;arrowButton.enteredRightForm [Windows8ToolbarIconLibrary scrollRightOffEntered2Icon]
+;arrowButton.activeRightForm [Windows8ToolbarIconLibrary scrollRightActiveIcon]
+;arrowButton.disabledRightForm [Windows8ToolbarIconLibrary scrollRightOffIcon]
+;
+;
+;arrowButton.leftFormFile 'ScrollLt.xp.xpm'
+;arrowButton.enteredLeftFormFile 'ScrollLt_entered.xp.xpm'
+;arrowButton.activeLeftFormFile 'ScrollLt_active.xp.xpm'
+;arrowButton.disabledLeftFormFile 'ScrollLt_disabled.xp.xpm'
+;
+;arrowButton.rightFormFile 'ScrollRt.xp.xpm'
+;arrowButton.enteredRightFormFile 'ScrollRt_entered.xp.xpm'
+;arrowButton.activeRightFormFile 'ScrollRt_active.xp.xpm'
+;arrowButton.disabledRightFormFile 'ScrollRt_disabled.xp.xpm'
+;
+;arrowButton.passiveLevel 0
+;arrowButton.activeLevel 0
+;arrowButton.backgroundColor =scroller.viewBackground
+;arrowButton.activeBackgroundColor =scroller.viewBackground
+;
+;noteBook.backgroundColor =lightenedViewGrey
+;noteBook.activeBackgroundColor =viewBackground
+;noteBook.foregroundColor Color black
+;noteBook.lightColor =darkenedViewGrey
+;noteBook.shadowColor =darkenedViewGrey
+;noteBook.passiveBackgroundColor =lightenedViewGrey
+;
+;checkToggle.bitmapFile 'CheckOn10_xp.xpm'
+;radioButton.passiveImage [Windows8ToolbarIconLibrary radioOff12x12Icon]
+;radioButton.activeImage [Windows8ToolbarIconLibrary radioOn12x12Icon]
+;radioButton.enteredPassiveImage [Windows8ToolbarIconLibrary radioOffEntered12x12Icon]
+;radioButton.enteredActiveImage [Windows8ToolbarIconLibrary radioOnEntered12x12Icon]
+;radioButton.disabledPassiveImage [Windows8ToolbarIconLibrary radioOffDisabled12x12Icon]
+;radioButton.disabledActiveImage [Windows8ToolbarIconLibrary radioOnDisabled12x12Icon]
+;checkToggle.disabledActiveImage [Windows8ToolbarIconLibrary checkToggleOnDisabledIcon]
+;checkToggle.disabledPassiveImage [Windows8ToolbarIconLibrary checkToggleOffDisabledIcon]
+;checkToggle.activeImage [Windows8ToolbarIconLibrary checkToggleOnIcon]
+;checkToggle.passiveImage [Windows8ToolbarIconLibrary checkToggleOffIcon]
+;checkToggle.enteredPassiveImage [Windows8ToolbarIconLibrary checkToggleOffEnteredIcon]
+;checkToggle.enteredActiveImage [Windows8ToolbarIconLibrary checkToggleOnEnteredIcon]
+;checkToggle.activeLevel 0
+;checkToggle.passiveLevel 0
+;checkToggle.disabledBackgroundColor =viewGrey
+;checkToggle.backgroundColor =viewGrey
+;checkToggle.activeBackgroundColor =viewGrey
+;
+;menu.iconIndicationOn [Windows8ToolbarIconLibrary checkToggleOnIcon]
+;menu.iconIndicationOff [Windows8ToolbarIconLibrary checkToggleOffIcon]
+;menu.iconDisabledIndicationOn [Windows8ToolbarIconLibrary checkToggleOffDisabledIcon]
+;menu.iconDisabledIndicationOff [Windows8ToolbarIconLibrary checkToggleOffIcon]
+;
+;noteBook.activeTabMarkerColor (Color red:100 green:78 blue:23)
+;
+;popup.borderColor (Color grey:50)
+;popup.borderWidth 1
+;
+;editField.level 0
+;editField.borderWidth 1
+;editField.borderColor (Color redByte:175 greenByte:190 blueByte:240)
+;
+;comboView.level 0
+;comboView.borderWidth 1
+;comboView.borderColor (Color redByte:175 greenByte:190 blueByte:240)
+;
+;; label.foregroundColor (Color redByte:0 greenByte:70 blueByte:213)
+;; button.foregroundColor (Color black)
+;; radioButton.foregroundColor (Color black)
+;; checkBox.labelForegroundColor (Color black)
+;
+;; noteBook.foregroundColor (Color redByte:0 greenByte:70 blueByte:213)
+;framedBox.foregroundColor (Color redByte:0 greenByte:70 blueByte:213)
+;
+variablePanel.handleLevel 0
+variablePanel.handleStyle #iris
+
+;
+;infoBox.iconFile 'bitmaps/Information_XP.xpm'
+;warningBox.iconFile 'bitmaps/Warning_XP.xpm'
+;requestBox.iconFile 'bitmaps/Request_XP.xpm'
+;errorBox.iconFile 'bitmaps/Error_XP.xpm'
+;
+;selection.backgroundColor (Color white)
+;
+;;selection.hilightForegroundColor (Color black)
+;;selection.hilightBackgroundColor (Color rgbValue:16rDFF0F8)
+;;selection.hilightFrameColor (Color rgbValue:16r96D9F9)
+;
+;;;;menu.hilightForegroundColor (Color black)
+;;;;menu.hilightBackgroundColor (Color rgbValue:16rDAEBF3)
+;;;;menu.hilightFrameColor (Color rgbValue:16rA8D8EB)
+;
+;editField.selectionBackgroundColor =selectionBlue
+;editField.selectionForegroundColor (Color white)
+
+;scrolledView.level 0