--- a/XWorkstation.st Thu Feb 19 10:09:27 2009 +0100
+++ b/XWorkstation.st Thu Feb 19 10:17:32 2009 +0100
@@ -9,7 +9,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libview' }"
DeviceWorkstation subclass:#XWorkstation
@@ -6496,13 +6495,7 @@
!
getFontWithFamily:familyString face:faceString
- style:styleArgString size:sizeArgOrNil sizeUnit:sizeUnit encoding:encoding
- ^ self getFontWithFamily:familyString face:faceString
- style:styleArgString size:sizeArgOrNil pixelSize:nil encoding:encoding
-!
-
-getFontWithFamily:familyString face:faceString
- style:styleArgString size:sizeArgOrNil pixelSize:pixelSizeArgOrNil encoding:encoding
+ style:styleArgString size:sizeArgOrNil sizeUnit:sizeUnit encoding:encoding
"try to get the specified font, if not available, try next smaller
font. Access to X-fonts by name is possible, by passing the X font name
@@ -6512,30 +6505,34 @@
|styleString theName theId xlatedStyle
id spacing encodingMatch idx roundedSize|
+ sizeUnit ~= #pt ifTrue:[
+ self error:'Request for non-point sized fonts - not yet implemented in XWorkstation' mayProceed:true.
+ ].
+
styleString := styleArgString.
sizeArgOrNil notNil ifTrue:[
- roundedSize := sizeArgOrNil rounded asInteger.
+ roundedSize := sizeArgOrNil rounded asInteger.
].
"special: if face is nil, allow access to X-fonts"
faceString isNil ifTrue:[
- roundedSize notNil ifTrue:[
- theName := familyString , '-' , roundedSize printString
- ] ifFalse:[
- theName := familyString
- ].
- theName isNil ifTrue:[
- "
- mhmh - fall back to the default font
- "
- theName := 'fixed'
- ].
- theId := self createFontFor:theName.
- theId isNil ifTrue:[
- theId := self getDefaultFont
- ].
- ^ theId
+ roundedSize notNil ifTrue:[
+ theName := familyString , '-' , roundedSize printString
+ ] ifFalse:[
+ theName := familyString
+ ].
+ theName isNil ifTrue:[
+ "
+ mhmh - fall back to the default font
+ "
+ theName := 'fixed'
+ ].
+ theId := self createFontFor:theName.
+ theId isNil ifTrue:[
+ theId := self getDefaultFont
+ ].
+ ^ theId
].
"/ spacing other than 'normal' is contained as last component
@@ -6543,67 +6540,67 @@
(styleString notNil
and:[(styleString endsWith:'-narrow')
- or:[styleString endsWith:'-semicondensed']]) ifTrue:[
- |i|
- i := styleString lastIndexOf:$-.
- spacing := styleString copyFrom:(i+1).
- styleString := styleString copyTo:(i-1).
+ or:[styleString endsWith:'-semicondensed']]) ifTrue:[
+ |i|
+ i := styleString lastIndexOf:$-.
+ spacing := styleString copyFrom:(i+1).
+ styleString := styleString copyTo:(i-1).
] ifFalse:[
- spacing := 'normal'.
+ spacing := 'normal'.
].
xlatedStyle := styleString.
xlatedStyle notNil ifTrue:[
- xlatedStyle := xlatedStyle first asString
+ xlatedStyle := xlatedStyle first asString
].
encoding isNil ifTrue:[
- encodingMatch := '*-*'.
+ encodingMatch := '*-*'.
] ifFalse:[
- idx := encoding indexOf:$-.
- idx ~~ 0 ifTrue:[
- encodingMatch := encoding
- ] ifFalse:[
- encodingMatch := encoding , '-*'.
- ].
+ idx := encoding indexOf:$-.
+ idx ~~ 0 ifTrue:[
+ encodingMatch := encoding
+ ] ifFalse:[
+ encodingMatch := encoding , '-*'.
+ ].
].
id := self
- getFontWithFoundry:'*'
- family:familyString asLowercase
- weight:faceString
- slant:xlatedStyle
- spacing:spacing
- pixelSize:nil
- size:roundedSize
- encoding:encodingMatch.
+ getFontWithFoundry:'*'
+ family:familyString asLowercase
+ weight:faceString
+ slant:xlatedStyle
+ spacing:spacing
+ pixelSize:nil
+ size:roundedSize
+ encoding:encodingMatch.
id isNil ifTrue:[
- (encodingMatch notNil and:[encodingMatch ~= '*']) ifTrue:[
- "/ too stupid: registries come in both cases
- "/ and X does not ignore case
- "/
- id := self
- getFontWithFoundry:'*'
- family:familyString asLowercase
- weight:faceString
- slant:xlatedStyle
- spacing:spacing
- pixelSize:nil
- size:roundedSize
- encoding:encodingMatch asUppercase.
- id isNil ifTrue:[
- id := self
- getFontWithFoundry:'*'
- family:familyString asLowercase
- weight:faceString
- slant:xlatedStyle
- spacing:spacing
- pixelSize:nil
- size:roundedSize
- encoding:encodingMatch asLowercase.
- ]
- ]
+ (encodingMatch notNil and:[encodingMatch ~= '*']) ifTrue:[
+ "/ too stupid: registries come in both cases
+ "/ and X does not ignore case
+ "/
+ id := self
+ getFontWithFoundry:'*'
+ family:familyString asLowercase
+ weight:faceString
+ slant:xlatedStyle
+ spacing:spacing
+ pixelSize:nil
+ size:roundedSize
+ encoding:encodingMatch asUppercase.
+ id isNil ifTrue:[
+ id := self
+ getFontWithFoundry:'*'
+ family:familyString asLowercase
+ weight:faceString
+ slant:xlatedStyle
+ spacing:spacing
+ pixelSize:nil
+ size:roundedSize
+ encoding:encodingMatch asLowercase.
+ ]
+ ]
].
^ id
@@ -11042,6 +11039,25 @@
"
!
+primSetIconName:aString in:aWindowId
+ "define a windows iconname"
+
+ <context: #return>
+%{
+
+ if (ISCONNECTED
+ && __isNonNilObject(aString)
+ && (__qIsString(aString) || __qIsSymbol(aString))
+ && __isExternalAddress(aWindowId)) {
+ ENTER_XLIB();
+ XSetIconName(myDpy, __WindowVal(aWindowId), (char *) __stringVal(aString));
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
primSetWindowName:aString in:aWindowId
"define a windows name"
@@ -11276,25 +11292,6 @@
self primSetIconName:stringUsed in:aWindowId
!
-primSetIconName:aString in:aWindowId
- "define a windows iconname"
-
- <context: #return>
-%{
-
- if (ISCONNECTED
- && __isNonNilObject(aString)
- && (__qIsString(aString) || __qIsSymbol(aString))
- && __isExternalAddress(aWindowId)) {
- ENTER_XLIB();
- XSetIconName(myDpy, __WindowVal(aWindowId), (char *) __stringVal(aString));
- LEAVE_XLIB();
- RETURN ( self );
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
setSaveUnder:yesOrNo in:aWindowId
"turn on/off save-under for a window"
@@ -12008,7 +12005,7 @@
!XWorkstation class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.503 2009-02-19 09:09:27 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.504 2009-02-19 09:17:32 stefan Exp $'
! !
XWorkstation initialize!