--- a/SimpleView.st Fri Dec 12 19:32:42 2014 +0100
+++ b/SimpleView.st Thu Jan 29 10:54:04 2015 +0100
@@ -1,10 +1,10 @@
"
- COPYRIGHT (c) 1989 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
+COPYRIGHT (c) 1989 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.
@@ -810,22 +810,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
@@ -836,7 +833,7 @@
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:[
@@ -845,6 +842,10 @@
] ifFalse:[
newView initializeForDevice:Screen current
].
+ (newView device supportsNativeWidgetType:newView nativeWindowType) ifTrue:[
+ newView beNativeWidget.
+ device := Screen current
+ ].
aView notNil ifTrue:[aView addSubView:newView].
^ newView
@@ -854,15 +855,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
@@ -906,21 +905,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].
@@ -934,42 +925,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].
@@ -984,32 +964,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
@@ -1030,8 +1005,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'!
@@ -1301,29 +1275,35 @@
self changed:#style.
SimpleView updateStyleCache.
SimpleView allSubclassesDo:[:aClass |
- "JV@2010-12-02: Removed to avoid lost of preferred fonts on image restart"
- "/ cg: no, this is required!!!!!!
- "/ otherwise, we get ugly courier fonts on windows
- "/ updateStyleCache MUST clear any previously
- "/ cached font values, otherwise you cannot load a style's font.
- "/ if you want to keep your fonts, do it elsewhere (keep some userFontPrefs and restore from there)
-
- "/ JV: Font preferences ARE already saved in user's setting.rc/setting.stx, but they
- "/ are not reloaded on snapshot restart (which is correct, I think).
- "/ This just discard such fonts. I would say calling this upon snapshot restart
- "/ is a bad idea. Workaround it only for me is not a solution as all other
- "/ Linux users are ... off. Let's workaround it:
- (Smalltalk isInitialized not and:
- [OperatingSystem getOSType == #linux and:
- [UserPreferences current linuxFontWorkaround]])
- ifFalse:[
- aClass defaultFont:nil.
- ].
-
- (aClass class includesSelector:#updateStyleCache) ifTrue:[
- aClass updateStyleCache
- ].
- ]
+ "JV@2010-12-02: Removed to avoid lost of preferred fonts on image restart"
+ "/ cg: no, this is required!!!!!!
+ "/ otherwise, we get ugly courier fonts on windows
+ "/ updateStyleCache MUST clear any previously
+ "/ cached font values, otherwise you cannot load a style's font.
+ "/ if you want to keep your fonts, do it elsewhere (keep some userFontPrefs and restore from there)
+
+ "/ JV: Font preferences ARE already saved in user's setting.rc/setting.stx, but they
+ "/ are not reloaded on snapshot restart (which is correct, I think).
+ "/ This just discard such fonts. I would say calling this upon snapshot restart
+ "/ is a bad idea. Workaround it only for me is not a solution as all other
+ "/ Linux users are ... off. Let's workaround it:
+ (Smalltalk isInitialized not and:
+ [OperatingSystem getOSType == #linux and:
+ [UserPreferences current linuxFontWorkaround]])
+ ifFalse:[
+ aClass defaultFont:nil.
+ ].
+
+ (aClass class includesSelector:#updateStyleCache) ifTrue:[
+ aClass updateStyleCache
+ ].
+ ].
+
+ "/ use #at: to avoid introducing a depency to libview2
+ (Smalltalk at:#MIMETypeIconLibrary) notNil ifTrue:[
+ (Smalltalk at:#MIMETypeIconLibrary) flushIcons
+ ].
+
"
View updateAllStyleCaches
@@ -1343,76 +1323,79 @@
anyway."
<resource: #style (#viewSpacing #font #borderWidth #borderColor
- #viewBackground #shadowColor #lightColor
- #focusColor #focusBorderWidth)>
-
- |bgGrey currentScreen|
+ #viewBackground #shadowColor #lightColor
+ #focusColor #focusBorderWidth)>
+
+ |styleSheet bgGrey currentScreen|
+
+ styleSheet := StyleSheet.
"
when coming here the first time, we read the styleSheet
and keep the values in fast class variables
"
- StyleSheet isNil ifTrue:[
- self setDefaultStyle.
- self readStyleSheet.
+ styleSheet isNil ifTrue:[
+ self setDefaultStyle.
+ self readStyleSheet.
+ styleSheet := StyleSheet.
].
currentScreen := Screen current ? Screen default.
- Grey := StyleSheet viewGrey.
+ Grey := styleSheet viewGrey.
Grey isNil ifTrue:[
- Grey := Color grey
+ Grey := Color gray
].
Grey := Grey onDevice:currentScreen.
- StyleSheet fileReadFailed ifTrue:[
- bgGrey := Color white
+ styleSheet fileReadFailed ifTrue:[
+ 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 := styleSheet at:#viewSpacing.
ViewSpacing isNil ifTrue:[
- ViewSpacing := currentScreen defaultStyleValueFor:#viewSpacing.
- ].
-
- DefaultBorderColor := StyleSheet colorAt:#borderColor.
+ ViewSpacing := currentScreen defaultStyleValueFor:#viewSpacing.
+ ].
+
+ DefaultBorderColor := styleSheet colorAt:#borderColor.
DefaultBorderColor isNil ifTrue:[
- DefaultBorderColor := currentScreen defaultStyleValueFor:#borderColor
- ].
-
- StyleSheet fileReadFailed ifTrue:[
- DefaultBorderWidth := 1.
- DefaultFocusColor := DefaultShadowColor := Color black.
- DefaultViewBackgroundColor := DefaultLightColor := Color white.
- DefaultFocusBorderWidth := 1.
+ DefaultBorderColor := currentScreen defaultStyleValueFor:#borderColor
+ ].
+
+ styleSheet fileReadFailed ifTrue:[
+ 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"
@@ -1557,8 +1540,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
@@ -1852,12 +1835,7 @@
"set the viewBackground to something, a color, image or form,
in myself and recursively in all of my subviews"
- (condition value:self) ifTrue:[
- viewBackground ~~ something ifTrue:[
- self viewBackground:something.
- self invalidate
- ].
- ].
+ self viewBackground:something if:condition.
self allSubViewsBackground:something if:condition
!
@@ -1997,24 +1975,31 @@
"Modified: 23.10.2009 / 14:11:50 / cg"
!
-borderWidth:aNumber
+borderWidth:aNumberOrNil
"set my borderWidth"
+ |aNumber|
+
+ aNumber := aNumberOrNil.
+ aNumber notNil ifTrue:[
+ self assert:(aNumber >= 0).
+ aNumber := aNumber max: 0
+ ].
"/ backward compatibility
"/ superView will be renamed to container soon.
(superView notNil and:[superView isBorderedWrapper]) ifTrue:[
- ^ superView borderWidth:aNumber
+ ^ superView borderWidth:aNumber
].
(aNumber == 0 or:[aNumber isNil]) ifTrue:[
- border isNil ifTrue:[^ self].
- self border:nil.
+ border isNil ifTrue:[^ self].
+ self border:nil.
] ifFalse:[
- border notNil ifTrue:[
- self border:(border copy width:aNumber)
- ] ifFalse:[
- self border:(SimpleBorder new width:aNumber color:(self borderColor)).
- ]
+ border notNil ifTrue:[
+ self border:(border copy width:aNumber)
+ ] ifFalse:[
+ self border:(SimpleBorder new width:aNumber color:(self borderColor)).
+ ]
].
"/ (aNumber ~~ borderWidth) ifTrue:[
@@ -2202,6 +2187,18 @@
"Modified: 4.7.1997 / 20:09:22 / cg"
!
+viewBackground:something if:condition
+ "set the viewBackground to something, a color, image or form,
+ in myself and recursively in all of my subviews"
+
+ (condition value:self) ifTrue:[
+ viewBackground ~~ something ifTrue:[
+ self viewBackground:something.
+ self invalidate
+ ].
+ ].
+!
+
viewShape:aForm
"set the viewShape to aForm"
@@ -2840,9 +2837,7 @@
!
layout:aLayoutObject
- "set the layout object which controls my geometry.
- Currently, this is almost nowhere used but views will be
- incrementally changed to use this new geometry management."
+ "set the layout object which controls my geometry."
layout = aLayoutObject ifFalse:[
layout := aLayoutObject.
@@ -3552,15 +3547,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
@@ -3576,11 +3571,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'!
@@ -3768,17 +3763,17 @@
!
topView
- "return the topView - thats the one with no superview"
+ "return the topView - that's the one with no superview"
|v next n|
n := 1.
v := self.
[v notNil] whileTrue:[
- (next := v container) isNil ifTrue:[^ v].
- v := next.
- n := n + 1.
- n > 1000 ifTrue:[self error:'circular superView chain'].
+ (next := v container) isNil ifTrue:[^ v].
+ v := next.
+ n := n + 1.
+ n > 1000 ifTrue:[self error:'circular superView chain'].
].
^ nil
@@ -4316,7 +4311,7 @@
visible."
self beVisible.
- self graphicsDevice sync. "thats a round-trip; when returning, the view is definitely visible"
+ self graphicsDevice sync. "that's a round-trip; when returning, the view is definitely visible"
"/ realized := true.
"/ shown := true.
@@ -6064,7 +6059,7 @@
"notification from the windowGroup that I got the keyboardFocus."
delegate notNil ifTrue:[
- delegate perform:#hasKeyboardFocus: with:aBoolean ifNotUnderstood:nil
+ delegate perform:#hasKeyboardFocus: with:aBoolean ifNotUnderstood:nil
].
^ self
!
@@ -6211,34 +6206,34 @@
sensor := self sensor.
UserPreferences current allowMouseWheelZoom ifTrue:[
- zoomInOrOut := sensor ctrlDown.
- zoomInOrOut ifTrue:[
- self mouseWheelZoom:amount.
- ^ self.
- ].
+ zoomInOrOut := sensor ctrlDown or:[sensor metaDown].
+ zoomInOrOut ifTrue:[
+ self mouseWheelZoom:amount.
+ ^ self.
+ ].
].
pageScroll := sensor shiftDown.
pageScroll ifFalse:[
- amountToScroll := self verticalScrollStep.
- sensor shiftDown ifFalse:[
- amountToScroll := self scaleMouseWheelScrollAmount:amountToScroll.
- ]
+ amountToScroll := self verticalScrollStep.
+ sensor shiftDown ifFalse:[
+ amountToScroll := self scaleMouseWheelScrollAmount:amountToScroll.
+ ]
].
amount > 0 ifTrue:[
- pageScroll ifTrue:[
- self pageUp
- ] ifFalse:[
- self scrollUp:amountToScroll
- ]
+ pageScroll ifTrue:[
+ self pageUp
+ ] ifFalse:[
+ self scrollUp:amountToScroll
+ ]
] ifFalse:[
- pageScroll ifTrue:[
- self pageDown
- ] ifFalse:[
- self scrollDown:amountToScroll
- ]
+ pageScroll ifTrue:[
+ self pageDown
+ ] ifFalse:[
+ self scrollDown:amountToScroll
+ ]
].
"Modified: / 21.5.1999 / 19:58:42 / cg"
@@ -6297,6 +6292,14 @@
^ self
!
+requestAutoAccept
+ "request to accept: this is invoked when a dialog closes via accept or cancel.
+ This forces my value to be accepted into my model.
+ Any widget may suppress the ok/cancel, by returning false."
+
+ ^ true
+!
+
saveAndTerminate
"window manager wants me to save and go away;
- notice, that not all window managers are nice enough to
@@ -6884,35 +6887,37 @@
if false, it came via the window manager (i.e. pointer entering).
Only change my border, if this is an explicit focusChange."
- |delta clrId bd|
+ |delta clrId bd graphicsDevice|
explicit ifTrue:[
- (self drawableId notNil
- and:[superView notNil
- and:[styleSheet notNil]]) ifTrue:[
- (styleSheet at:#'focus.showBorder' default:true) ifTrue:[
- (self graphicsDevice supportsWindowBorder:(bd := DefaultFocusBorderWidth)) ifFalse:[
- (self graphicsDevice supportsWindowBorder:(bd := 1)) ifFalse:[
- bd := 0.
- ]
- ].
- delta := bd - self borderWidth.
- delta ~~ 0 ifTrue:[
- (left == 0 or:[top == 0]) ifTrue:[
- self graphicsDevice resizeWindow:self drawableId width:width-delta-delta height:height-delta-delta.
- ] ifFalse:[
- self graphicsDevice moveWindow:self drawableId x:left-delta y:top-delta.
- ].
- self graphicsDevice setWindowBorderWidth:bd in:self drawableId.
- ].
-
- clrId := (DefaultFocusColor onDevice:self graphicsDevice) colorId.
- clrId isNil ifTrue:[
- clrId := self graphicsDevice blackpixel
- ].
- self graphicsDevice setWindowBorderColor:clrId in:self drawableId.
- ]
- ]
+ (self drawableId notNil
+ and:[superView notNil
+ and:[styleSheet notNil]]) ifTrue:[
+ (styleSheet at:#'focus.showBorder' default:true) ifTrue:[
+ graphicsDevice := self graphicsDevice.
+
+ (graphicsDevice supportsWindowBorder:(bd := DefaultFocusBorderWidth)) ifFalse:[
+ (graphicsDevice supportsWindowBorder:(bd := 1)) ifFalse:[
+ bd := 0.
+ ]
+ ].
+ delta := bd - self borderWidth.
+ delta ~~ 0 ifTrue:[
+ (left == 0 or:[top == 0]) ifTrue:[
+ graphicsDevice resizeWindow:self drawableId width:width-delta-delta height:height-delta-delta.
+ ] ifFalse:[
+ graphicsDevice moveWindow:self drawableId x:left-delta y:top-delta.
+ ].
+ graphicsDevice setWindowBorderWidth:bd in:self drawableId.
+ ].
+
+ clrId := (DefaultFocusColor onDevice:graphicsDevice) colorId.
+ clrId isNil ifTrue:[
+ clrId := graphicsDevice blackpixel
+ ].
+ graphicsDevice setWindowBorderColor:clrId in:self drawableId.
+ ]
+ ]
] ifFalse:[
"/ superView notNil ifTrue:[
"/ superView showFocus:explicit
@@ -6928,25 +6933,27 @@
or via the window manager (i.e. pointer entering).
Only change my border, if this is an explicit focusChange."
- |delta bd|
+ |delta bd graphicsDevice|
explicit ifTrue:[
- (self drawableId notNil and:[superView notNil]) ifTrue:[
- (styleSheet at:#'focus.showBorder' default:true) ifTrue:[
- (self graphicsDevice supportsWindowBorder:(bd := self borderWidth)) ifFalse:[
- (self graphicsDevice supportsWindowBorder:(bd := 1)) ifFalse:[
- bd := 0.
- ]
- ].
- delta := DefaultFocusBorderWidth - bd.
- delta ~~ 0 ifTrue:[
- self graphicsDevice setWindowBorderWidth:bd in:self drawableId.
- self graphicsDevice moveWindow:self drawableId x:left y:top.
- self graphicsDevice resizeWindow:self drawableId width:width height:height.
- ].
- self setBorderColor.
- ]
- ]
+ (self drawableId notNil and:[superView notNil]) ifTrue:[
+ (styleSheet at:#'focus.showBorder' default:true) ifTrue:[
+ graphicsDevice := self graphicsDevice.
+
+ (graphicsDevice supportsWindowBorder:(bd := self borderWidth)) ifFalse:[
+ (graphicsDevice supportsWindowBorder:(bd := 1)) ifFalse:[
+ bd := 0.
+ ]
+ ].
+ delta := DefaultFocusBorderWidth - bd.
+ delta ~~ 0 ifTrue:[
+ graphicsDevice setWindowBorderWidth:bd in:self drawableId.
+ graphicsDevice moveWindow:self drawableId x:left y:top.
+ graphicsDevice resizeWindow:self drawableId width:width height:height.
+ ].
+ self setBorderColor.
+ ]
+ ]
]
"Modified: / 17.9.1998 / 15:08:02 / cg"
@@ -7306,7 +7313,7 @@
|ext myClass controllerClass|
- flagBits := 0.
+ flagBits := flagBits ? 0.
super initialize.
@@ -7337,15 +7344,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.
@@ -7565,33 +7572,33 @@
s := aString readStream.
[s atEnd] whileFalse:[
- c := s next.
- c == $& ifTrue:[
- n := s peek.
- (n notNil and:[n isLetter]) ifTrue:[
- c := s next.
- pos := xLatedString size + 1.
- ] ifFalse:[
- n == $& ifTrue:[
- s next.
- ]
- ]
- ].
- c notNil ifTrue:[
- xLatedString nextPut:c
- ]
+ c := s next.
+ c == $& ifTrue:[
+ n := s peek.
+ (n notNil and:[n isLetter]) ifTrue:[
+ c := s next.
+ pos := xLatedString size + 1.
+ ] ifFalse:[
+ n == $& ifTrue:[
+ s next.
+ ]
+ ]
+ ].
+ c notNil ifTrue:[
+ xLatedString nextPut:c
+ ]
].
xLatedString := xLatedString contents.
pos notNil ifTrue:[
- shortcutCharacter := xLatedString at:pos ifAbsent:nil.
-
- xLatedString isText ifFalse:[
- xLatedString := Text string:xLatedString
- ].
- xLatedString emphasisAt:pos add:#underline.
-
- shortcut := ('Cmd' , shortcutCharacter asLowercase) asSymbol.
+ shortcutCharacter := xLatedString at:pos ifAbsent:nil.
+
+ xLatedString isText ifFalse:[
+ xLatedString := xLatedString asText
+ ].
+ xLatedString emphasisAt:pos add:#underline.
+
+ shortcut := ('Cmd' , shortcutCharacter asLowercase) asSymbol.
].
^ Array with:shortcut with:xLatedString
@@ -7785,6 +7792,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
@@ -8903,13 +8920,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.
@@ -9732,6 +9742,16 @@
^ true
!
+drawFocusFrame
+ self hasFocus ifTrue:[
+ (styleSheet at:#focusHighlightStyle) == #win95 ifTrue:[
+ self windowGroup focusCameByTab ifTrue:[
+ self drawWin95FocusFrame
+ ]
+ ].
+ ]
+!
+
flash
"flash the view - fill it black, then white, finally
redraw completely.
@@ -9769,9 +9789,13 @@
].
Delay waitForSeconds:0.1.
self fill:self whiteColor.
+ messageOrNil notNil ifTrue:[
+ self withForeground:Color black do:[
+ self displayString:messageOrNil centeredAt:(self center).
+ ].
+ ].
Delay waitForSeconds:0.1.
self fill:viewBackground.
-"/ self clear.
self invalidate
"
@@ -9779,7 +9803,7 @@
v := View new openAndWait.
Delay waitForSeconds:2.
- v flash.
+ v flash:'Hello World'.
Delay waitForSeconds:2.
v destroy
"
@@ -9863,14 +9887,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"
@@ -10679,8 +10706,8 @@
isPopup := self isPopUpView.
aWindowGroup notNil ifTrue:[
- mainGroup := aWindowGroup mainGroup.
- mainView := mainGroup mainView.
+ mainGroup := aWindowGroup mainGroup.
+ mainView := mainGroup mainView.
].
"/ set the windowgroup BEFORE sending the aboutToOpen notification
@@ -10688,139 +10715,144 @@
"/ this allows for the handler to enqueue an event,
"/ or to add event hooks.
Processor activeProcessIsSystemProcess ifTrue:[
- "
- put myself into the modal group, let it handle events for
- me as well. This is only a half way solution, since the view
- is not modal at all ... however, the only situation
- where this happens is with modal boxes popped while in a
- modal browser. You will forgive me for that inconvenience.
- "
- windowGroup := aWindowGroup.
- aWindowGroup notNil ifTrue:[aWindowGroup addTopView:self].
+ "
+ put myself into the modal group, let it handle events for
+ me as well. This is only a half way solution, since the view
+ is not modal at all ... however, the only situation
+ where this happens is with modal boxes popped while in a
+ modal browser. You will forgive me for that inconvenience.
+ "
+ windowGroup := aWindowGroup.
+ aWindowGroup notNil ifTrue:[aWindowGroup addTopView:self].
] ifFalse:[
- previousGroup := WindowGroup activeGroup.
-
- "/ create a new window group put myself into it
- windowGroup := self windowGroupClass new
- addTopView:self;
- setPreviousGroup:previousGroup.
-
- superView notNil ifTrue:[
- "/
- "/ special: this is a modal subview,
- "/ prevent the view from reassigning its windowGroup when realized
- "/ (subviews normaly place themself into the superviews group)
- "/
- windowGroup isForModalSubview:true.
- ].
+ previousGroup := WindowGroup activeGroup.
+
+ "/ create a new window group put myself into it
+ windowGroup := self windowGroupClass new
+ addTopView:self;
+ setPreviousGroup:previousGroup.
+
+ superView notNil ifTrue:[
+ "/
+ "/ special: this is a modal subview,
+ "/ prevent the view from reassigning its windowGroup when realized
+ "/ (subviews normaly place themself into the superviews group)
+ "/
+ windowGroup isForModalSubview:true.
+ ].
].
makeTransient := true.
isPopup ifFalse:[
- "/ the following allows for knowledgable programmers to suppress dialog boxes,
- "/ or to patch common controls right before opening...
- (Dialog aboutToOpenBoxNotificationSignal raiseRequestWith:self) == #abort ifTrue:[
- ^ self
- ].
- "/ the following allows for hooks to add a bell sound or other whenever a dialog opens
- self graphicsDevice modalWindowListenersDo:[:listener | listener aboutToOpenWindow:self].
-
- "/ the following raises the corresponding mainview, so the dialog shows above
- "/ any currently covered view. However, be careful if being debugged, or if this dialog
- "/ is opened by an already open dialog.
- mainView notNil ifTrue:[
- (mainView windowGroup isInModalLoop
- or:[ mainView windowGroup isDebugged
- or:[ WindowGroup activeGroup isDebugged
- ]]) ifFalse:[
- self tracePoint:#cg message:'activate'.
- self debuggingCodeFor:#cg is:[ Transcript showCR:mainView; showCR:mainView windowGroup. ].
- mainView activate; setForegroundWindow.
- ] ifTrue:[
- makeTransient := false.
- ]
- ].
+ "/ the following allows for knowledgable programmers to suppress dialog boxes,
+ "/ or to patch common controls right before opening...
+ (Dialog aboutToOpenBoxNotificationSignal raiseRequestWith:self) == #abort ifTrue:[
+ ^ self
+ ].
+ "/ the following allows for hooks to add a bell sound or other whenever a dialog opens
+ self graphicsDevice modalWindowListenersDo:[:listener | listener aboutToOpenWindow:self].
+
+ "/ the following raises the corresponding mainview, so the dialog shows above
+ "/ any currently covered view. However, be careful if being debugged, or if this dialog
+ "/ is opened by an already open dialog.
+ mainView notNil ifTrue:[
+ (mainView windowGroup isInModalLoop
+ or:[ mainView windowGroup isDebugged
+ or:[ WindowGroup activeGroup isDebugged
+ ]]) ifFalse:[
+ self tracePoint:#cg message:'activate'.
+ self debuggingCodeFor:#cg is:[ Transcript showCR:mainView; showCR:mainView windowGroup. ].
+ mainView activate; setForegroundWindow.
+ ] ifTrue:[
+ makeTransient := false.
+ ]
+ ].
].
makeTransient ifTrue:[
- mainView notNil ifTrue:[
- "set the transient property.
- This is currently used for X, to tell the Window Manager
- That this view should be always on top of the mainView"
- self drawableId isNil ifTrue:[self create].
- self graphicsDevice setTransient:self drawableId for:mainView id.
- ]
+ mainView notNil ifTrue:[
+ "set the transient property.
+ This is currently used for X, to tell the Window Manager
+ That this view should be always on top of the mainView"
+ self drawableId isNil ifTrue:[self create].
+ self graphicsDevice setTransient:self drawableId for:mainView id.
+ ]
].
self raise.
Processor activeProcessIsSystemProcess ifTrue:[
- self realize
+ self realize
] ifFalse:[
- "
- show a stop-cursor in the suspended window groups
- "
- (mainGroup notNil and:[isPopup not]) ifTrue:[
- mainGroup showCursor:(Cursor stop).
- previousGroup ~~ mainGroup ifTrue:[
- previousGroup showCursor:(Cursor stop).
- ].
- cursorChanged := true.
- ].
-
- "
- go dispatch events in this new group
- (thus current windowgroup is blocked from interaction)
- "
- AbortOperationRequest handle:[:ex |
- AbortOperationRequest handle:[:ex2 |
- "/ an aborted hide (user confirmation ?)
- self breakPoint:#cg.
- ex exit.
- ] do:[
- self hide.
- realized ifTrue:[
- "/ self halt. "/ hide handled and closeRequest not wanted:
- ex exit.
- ].
- ].
- ] do:[
- [
- [
- windowGroup startupModal:[realized and:aBlock] forGroup:aWindowGroup
- ] ifCurtailed:[
- self hide.
- ]
- ] ensure:[
- aWindowGroup notNil ifTrue:[
- aWindowGroup graphicsDevice sync. "thats a round trip - make sure that all drawing has been processed"
- "/ ensure that eventListener runs here ...
- Delay waitForSeconds:0.05.
- aWindowGroup processExposeEvents.
-
- (self isPopUpView or:[ ReturnFocusWhenClosingModalBoxes ]) ifTrue:[
- "
- return the input focus to the previously active group's top.
- This helps with window managers which need an explicit click
- on the view for the focus.
- "
- tops := aWindowGroup topViews.
- (tops notEmptyOrNil) ifTrue:[
- tops first getKeyboardFocus
- ].
- ].
-
- "
- restore cursors in the changed groups
- "
- cursorChanged notNil ifTrue:[
- mainGroup restoreCursors.
- previousGroup ~~ mainGroup ifTrue:[
- previousGroup restoreCursors.
- ].
- ].
- ].
- ]
- ].
+ "
+ show a stop-cursor in the suspended window groups
+ "
+ (mainGroup notNil and:[isPopup not]) ifTrue:[
+ mainGroup showCursor:(Cursor stop).
+ previousGroup ~~ mainGroup ifTrue:[
+ previousGroup showCursor:(Cursor stop).
+ ].
+ cursorChanged := true.
+ ].
+
+ "
+ go dispatch events in this new group
+ (thus current windowgroup is blocked from interaction)
+ "
+ AbortOperationRequest handle:[:ex |
+ "/ the dialog/popup is aborted - hide it. Care for another abort during the hide.
+ AbortOperationRequest handle:[:ex2 |
+ "/ an aborted hide (possibly due to a cancelled user confirmation or similar)
+ self breakPoint:#cg.
+ ex exit.
+ ] do:[
+ self hide.
+ realized ifTrue:[
+ "/ self halt. "/ hide handled and closeRequest not wanted:
+ ex exit.
+ ].
+ ].
+ ] do:[
+ [
+ [
+ windowGroup startupModal:[realized and:aBlock] forGroup:aWindowGroup
+ ] ifCurtailed:[
+ self hide.
+ ]
+ ] ensure:[
+ aWindowGroup notNil ifTrue:[
+ aWindowGroup graphicsDevice sync. "thats a round trip - make sure that all drawing has been processed"
+ "/ ensure that eventListener runs here ...
+ Delay waitForSeconds:0.05.
+ aWindowGroup processExposeEvents.
+
+ (self isPopUpView or:[ ReturnFocusWhenClosingModalBoxes ]) ifTrue:[
+ "
+ return the input focus to the previously active group's top.
+ This helps with window managers which need an explicit click
+ on the view for the focus.
+ Only do this, if the previous group is still having the focus.
+ (i.e. no other view was opened in the meantime)
+ "
+ aWindowGroup graphicsDevice focusView isNil ifTrue:[
+ tops := aWindowGroup topViews.
+ (tops notEmptyOrNil) ifTrue:[
+ tops first getKeyboardFocus
+ ].
+ ].
+ ].
+
+ "
+ restore cursors in the changed groups
+ "
+ cursorChanged notNil ifTrue:[
+ mainGroup restoreCursors.
+ previousGroup ~~ mainGroup ifTrue:[
+ previousGroup restoreCursors.
+ ].
+ ].
+ ].
+ ]
+ ].
]
"Created: / 10-12-1995 / 14:06:14 / cg"
@@ -11032,6 +11064,15 @@
!SimpleView methodsFor:'testing'!
+hasOwnScrollbars
+ "a hack for codeView2, which behaves like a TextView, but has its own
+ scrollbars embedded - sigh (an extra load one).
+ This allows for the UIBuilder to avoid creating an extra set around such
+ a view (as is the case with TextSpec with scrollbars when using CodeView2)"
+
+ ^ false
+!
+
isApplicationSubView
^ false
!
@@ -11220,11 +11261,11 @@
!SimpleView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.751.2.1 2014-05-08 08:27:50 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.751.2.2 2015-01-29 09:54:04 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.751.2.1 2014-05-08 08:27:50 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.751.2.2 2015-01-29 09:54:04 stefan Exp $'
!
version_SVN
--- a/XftFontDescription.st Fri Dec 12 19:32:42 2014 +0100
+++ b/XftFontDescription.st Thu Jan 29 10:54:04 2015 +0100
@@ -1,4 +1,4 @@
-'From Smalltalk/X, Version:6.2.3.0 on 08-05-2014 at 10:08:24' !
+'From Smalltalk/X, Version:6.2.5.0 on 17-12-2014 at 18:03:00' !
"{ Package: 'stx:libview' }"
@@ -78,7 +78,8 @@
# define __HANDLE_VAL(type, externalAddress) \
((type)__externalAddressVal(externalAddress))
-#define __HANDLE_NEW(ptr, __cls) \
+
+# define __HANDLE_NEW(ptr, __cls) \
({ \
OBJ handle; \
handle = __MKEXTERNALADDRESS(ptr); \
@@ -530,6 +531,22 @@
"Created: / 02-01-2014 / 23:29:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+!XftFontDescription methodsFor:'converting'!
+
+asNonXftFont
+ |newFont|
+
+ newFont := FontDescription
+ family:family
+ face:face
+ style:style
+ size:(sizeUnit == #px ifTrue:[pixelSize] ifFalse:[size])
+ sizeUnit:sizeUnit
+ encoding:encoding.
+
+ ^ newFont
+! !
+
!XftFontDescription methodsFor:'displaying'!
displayString:aString from:index1 to:index2Arg x:xArg y:yArg in:aGC opaque:opaque
@@ -539,13 +556,15 @@
bg bgR bgG bgB bgA bgPixel drawX drawY displayId screen drawableId error stringLen|
"limit the string len, otherwise bad output is generated"
- stringLen := index2Arg - index1.
- stringLen > 4000 ifTrue:[
- index2 := index1 + 4000.
+ stringLen := index2Arg - index1 + 1.
+ stringLen > 8000 ifTrue:[
+ index2 := index1 + 8000 - 1.
] ifFalse:[
+ stringLen <= 0 ifTrue:[^ self].
index2 := index2Arg.
].
bytesPerCharacter := aString bitsPerCharacter // 8.
+ transformation := aGC transformation.
clipR := aGC deviceClippingBoundsOrNil.
clipR notNil ifTrue:[
@@ -555,9 +574,14 @@
clipH := clipR height.
clipW > 32767 ifTrue:['clipW > 32767 ' errorPrintCR. clipW errorPrintCR. self halt. clipW := 32767].
(clipX > 16384 or:[clipX < -16384]) ifTrue:['clipX < 16384 ' errorPrintCR. clipX errorPrintCR.].
+ "/ 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.
transformation isNil ifTrue:[
drawX := xArg.
drawY := yArg.
@@ -760,94 +784,101 @@
(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]).
+ Error handle:[:ex |
+ ^ self asNonXftFont onDevice:aGraphicsDevice
+ ] do:[
+ 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].
].
"
@@ -1617,6 +1648,11 @@
^ info
!
+getFontResolution
+ device isNil ifTrue:[ ^ 72 @ 72 ].
+ ^ device resolution
+!
+
height
"return the height - the number of pixels above plus below the baseLine."
@@ -1761,51 +1797,51 @@
list := OrderedCollection new.
readEntry :=
- [
- |key|
+ [
+ |key|
- [l startsWith:'Pattern has'] whileFalse:[
- l := pipeStream nextLine. Transcript showCR:l.
- ].
+ [l startsWith:'Pattern has'] whileFalse:[
+ l := pipeStream nextLine. Transcript showCR:l.
+ ].
- currentDescription := XftFontDescription new.
- [ l := pipeStream nextLine. l notEmptyOrNil ] whileTrue:[
- "/ Transcript showCR:l.
- lineStream := l readStream. lineStream skipSeparators.
- key := lineStream upToSeparator.
- (
- #('family:' 'style:' 'slant:' 'weight:' 'width:'
- 'pixelsize:' 'spacing:' 'foundry:' 'antialias:'
- 'file:' 'outline' 'scalable:' 'charset:' 'lang:'
- 'fontversion:' 'fontformat:' 'decorative:' 'index:'
- 'outline:' 'familylang:' 'stylelang:' 'fullname:'
- 'fullnamelang:' 'capability:' 'hash:' 'postscriptname:'
- ) includes:key
- ) ifTrue:[
- self perform:('fc_',(key allButLast)) asSymbol
- ] ifFalse:[
- Transcript show:'Xft ignored line: '; showCR:l.
- self breakPoint:#cg.
- ].
- ].
- list add:currentDescription
- ].
+ currentDescription := XftFontDescription new.
+ [ l := pipeStream nextLine. l notEmptyOrNil ] whileTrue:[
+ "/ Transcript showCR:l.
+ lineStream := l readStream. lineStream skipSeparators.
+ key := lineStream upToSeparator.
+ (
+ #('family:' 'style:' 'slant:' 'weight:' 'width:'
+ 'pixelsize:' 'spacing:' 'foundry:' 'antialias:'
+ 'file:' 'outline' 'scalable:' 'charset:' 'lang:'
+ 'fontversion:' 'fontformat:' 'decorative:' 'index:'
+ 'outline:' 'familylang:' 'stylelang:' 'fullname:'
+ 'fullnamelang:' 'capability:' 'hash:' 'postscriptname:'
+ ) includes:key
+ ) ifTrue:[
+ self perform:('fc_',(key allButLast)) asSymbol
+ ] ifFalse:[
+ Transcript show:'Xft ignored line: '; showCR:l.
+ self breakPoint:#cg.
+ ].
+ ].
+ list add:currentDescription
+ ].
fcListProg := #('/usr/bin/fc-list' '/usr/X11/bin/fc-list') detect:[:eachProg|
- eachProg asFilename isExecutableProgram
- ] ifNone:[
- 'fc-list program not found - no XFT fonts' infoPrintCR.
- ^ list.
- ].
+ eachProg asFilename isExecutableProgram
+ ] ifNone:[
+ 'XftFontDescription [warning]: fc-list program not found - no XFT fonts' errorPrintCR.
+ ^ list.
+ ].
pipeStream := PipeStream readingFrom:fcListProg, ' -v'.
[
- [pipeStream atEnd] whileFalse:[
- l := pipeStream nextLine.
- readEntry value.
- ]
+ [pipeStream atEnd] whileFalse:[
+ l := pipeStream nextLine.
+ readEntry value.
+ ]
] ensure:[
- pipeStream close
+ pipeStream close
].
^ list
@@ -2050,11 +2086,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.51.2.2 2015-01-29 09:54:04 stefan 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.51.2.2 2015-01-29 09:54:04 stefan Exp $'
! !