Account for 'narrow' and 'semicondensed' in X11-Fonts.
--- a/XWorkstat.st Wed Jul 03 11:32:25 1996 +0200
+++ b/XWorkstat.st Thu Jul 04 12:47:08 1996 +0200
@@ -4242,36 +4242,36 @@
aString isNil ifTrue:[^ false].
(aString startsWith:'-') ifFalse:[
- "
- take care for ill-named fonts (i.e. pre Rel4 fonts)
- "
- ('*-*-[0-9]*' match:aString) ifTrue:[
- end := aString indexOf:$- startingAt:1.
- family := aString copyFrom:1 to:(end - 1).
- start := end + 1.
- end := aString indexOf:$- startingAt:start.
- style := aString copyFrom:start to:(end - 1).
- start := end + 1.
- size := aString copyFrom:start.
- size := (Number readFromString:size onError:[^false]).
- aBlock value:family value:nil value:style value:size value:nil.
- ^ true.
- ].
- ('*-[0-9]*' match:aString) ifTrue:[
- "
- something like lucidasans-24
- "
- end := aString indexOf:$- startingAt:1.
-
- family := aString copyFrom:1 to:(end - 1).
- start := end + 1.
- size := aString copyFrom:start.
- size := (Number readFromString:size onError:[^false]).
- aBlock value:family value:nil value:nil value:size value:nil.
- ^ true.
- ].
- aBlock value:aString value:nil value:nil value:nil value:nil.
- ^ true.
+ "
+ take care for ill-named fonts (i.e. pre Rel4 fonts)
+ "
+ ('*-*-[0-9]*' match:aString) ifTrue:[
+ end := aString indexOf:$- startingAt:1.
+ family := aString copyFrom:1 to:(end - 1).
+ start := end + 1.
+ end := aString indexOf:$- startingAt:start.
+ style := aString copyFrom:start to:(end - 1).
+ start := end + 1.
+ size := aString copyFrom:start.
+ size := (Number readFromString:size onError:[^false]).
+ aBlock value:family value:nil value:style value:size value:nil.
+ ^ true.
+ ].
+ ('*-[0-9]*' match:aString) ifTrue:[
+ "
+ something like lucidasans-24
+ "
+ end := aString indexOf:$- startingAt:1.
+
+ family := aString copyFrom:1 to:(end - 1).
+ start := end + 1.
+ size := aString copyFrom:start.
+ size := (Number readFromString:size onError:[^false]).
+ aBlock value:family value:nil value:nil value:size value:nil.
+ ^ true.
+ ].
+ aBlock value:aString value:nil value:nil value:nil value:nil.
+ ^ true.
].
end := aString indexOf:$- startingAt:2.
@@ -4293,15 +4293,15 @@
(end == 0) ifTrue:[^ false].
style := aString copyFrom:start to:(end - 1).
(style = 'o') ifTrue:[
- style := 'oblique'
+ style := 'oblique'
] ifFalse:[
- (style = 'i') ifTrue:[
- style := 'italic'
- ] ifFalse:[
- (style = 'r') ifTrue:[
- style := 'roman'
- ]
- ]
+ (style = 'i') ifTrue:[
+ style := 'italic'
+ ] ifFalse:[
+ (style = 'r') ifTrue:[
+ style := 'roman'
+ ]
+ ]
].
start := end + 1.
@@ -4350,10 +4350,14 @@
(end == 0) ifTrue:[^ false].
coding := aString copyFrom:start to:(end - 1).
+ (moreStyle ~= 'normal' and:[moreStyle ~= '']) ifTrue:[
+ style := style, '-', moreStyle.
+ ].
+
aBlock value:family value:face value:style value:size value:coding.
^ true
- "Modified: 27.9.1995 / 10:46:52 / stefan"
+ "Modified: 4.7.1996 / 11:12:25 / stefan"
!
descentOf:aFontId
@@ -4630,83 +4634,99 @@
!
getFontWithFamily:familyString face:faceString
- style:styleString size:sizeArg encoding:encodingSym
+ style:styleArgString size:sizeArg encoding:encodingSym
"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
as family and the other parameters as nil. For example, the cursor font
can be aquired that way."
- |theName theId xlatedStyle id |
+ |styleString theName theId xlatedStyle id spacing|
+
+ styleString := styleArgString.
"special: if face is nil, allow access to X-fonts"
faceString isNil ifTrue:[
- sizeArg notNil ifTrue:[
- theName := familyString , '-' , sizeArg 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
+ sizeArg notNil ifTrue:[
+ theName := familyString , '-' , sizeArg 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
+ "/ in style
+
+ ((styleString endsWith:'-narrow')
+ or:[styleString endsWith:'-semicondensed']) ifTrue:[
+ |i|
+ i := styleString lastIndexOf:$-.
+ spacing := styleString copyFrom:(i+1).
+ styleString := styleString copyTo:(i-1).
+ ] ifFalse:[
+ spacing := 'normal'.
].
xlatedStyle := styleString.
xlatedStyle notNil ifTrue:[
- xlatedStyle := xlatedStyle first asString
+ xlatedStyle := xlatedStyle first asString
].
id := self
- getFontWithFoundry:'*'
- family:familyString asLowercase
- weight:faceString
- slant:xlatedStyle
- spacing:'normal'
- pixelSize:nil
- size:sizeArg
- registry:encodingSym
- encoding:'*'.
+ getFontWithFoundry:'*'
+ family:familyString asLowercase
+ weight:faceString
+ slant:xlatedStyle
+ spacing:spacing
+ pixelSize:nil
+ size:sizeArg
+ registry:encodingSym
+ encoding:'*'.
id isNil ifTrue:[
- (encodingSym notNil and:[encodingSym ~= '*']) ifTrue:[
- "/ too stupid: encodings come in both cases
- "/ and X does not ignore case
- "/
- id := self
- getFontWithFoundry:'*'
- family:familyString asLowercase
- weight:faceString
- slant:xlatedStyle
- spacing:'normal'
- pixelSize:nil
- size:sizeArg
- registry:encodingSym asUppercase
- encoding:'*'.
- id isNil ifTrue:[
- id := self
- getFontWithFoundry:'*'
- family:familyString asLowercase
- weight:faceString
- slant:xlatedStyle
- spacing:'normal'
- pixelSize:nil
- size:sizeArg
- registry:encodingSym asLowercase
- encoding:'*'.
- ]
- ]
+ (encodingSym notNil and:[encodingSym ~= '*']) ifTrue:[
+ "/ too stupid: encodings 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:sizeArg
+ registry:encodingSym asUppercase
+ encoding:'*'.
+ id isNil ifTrue:[
+ id := self
+ getFontWithFoundry:'*'
+ family:familyString asLowercase
+ weight:faceString
+ slant:xlatedStyle
+ spacing:spacing
+ pixelSize:nil
+ size:sizeArg
+ registry:encodingSym asLowercase
+ encoding:'*'.
+ ]
+ ]
].
^ id
"Modified: 24.2.1996 / 22:37:24 / cg"
+ "Modified: 4.7.1996 / 11:38:47 / stefan"
!
getFontWithFoundry:foundry family:family weight:weight
@@ -8095,6 +8115,6 @@
!XWorkstation class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/Attic/XWorkstat.st,v 1.149 1996-07-02 12:26:37 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/Attic/XWorkstat.st,v 1.150 1996-07-04 10:47:08 stefan Exp $'
! !
XWorkstation initialize!
--- a/XWorkstation.st Wed Jul 03 11:32:25 1996 +0200
+++ b/XWorkstation.st Thu Jul 04 12:47:08 1996 +0200
@@ -4242,36 +4242,36 @@
aString isNil ifTrue:[^ false].
(aString startsWith:'-') ifFalse:[
- "
- take care for ill-named fonts (i.e. pre Rel4 fonts)
- "
- ('*-*-[0-9]*' match:aString) ifTrue:[
- end := aString indexOf:$- startingAt:1.
- family := aString copyFrom:1 to:(end - 1).
- start := end + 1.
- end := aString indexOf:$- startingAt:start.
- style := aString copyFrom:start to:(end - 1).
- start := end + 1.
- size := aString copyFrom:start.
- size := (Number readFromString:size onError:[^false]).
- aBlock value:family value:nil value:style value:size value:nil.
- ^ true.
- ].
- ('*-[0-9]*' match:aString) ifTrue:[
- "
- something like lucidasans-24
- "
- end := aString indexOf:$- startingAt:1.
-
- family := aString copyFrom:1 to:(end - 1).
- start := end + 1.
- size := aString copyFrom:start.
- size := (Number readFromString:size onError:[^false]).
- aBlock value:family value:nil value:nil value:size value:nil.
- ^ true.
- ].
- aBlock value:aString value:nil value:nil value:nil value:nil.
- ^ true.
+ "
+ take care for ill-named fonts (i.e. pre Rel4 fonts)
+ "
+ ('*-*-[0-9]*' match:aString) ifTrue:[
+ end := aString indexOf:$- startingAt:1.
+ family := aString copyFrom:1 to:(end - 1).
+ start := end + 1.
+ end := aString indexOf:$- startingAt:start.
+ style := aString copyFrom:start to:(end - 1).
+ start := end + 1.
+ size := aString copyFrom:start.
+ size := (Number readFromString:size onError:[^false]).
+ aBlock value:family value:nil value:style value:size value:nil.
+ ^ true.
+ ].
+ ('*-[0-9]*' match:aString) ifTrue:[
+ "
+ something like lucidasans-24
+ "
+ end := aString indexOf:$- startingAt:1.
+
+ family := aString copyFrom:1 to:(end - 1).
+ start := end + 1.
+ size := aString copyFrom:start.
+ size := (Number readFromString:size onError:[^false]).
+ aBlock value:family value:nil value:nil value:size value:nil.
+ ^ true.
+ ].
+ aBlock value:aString value:nil value:nil value:nil value:nil.
+ ^ true.
].
end := aString indexOf:$- startingAt:2.
@@ -4293,15 +4293,15 @@
(end == 0) ifTrue:[^ false].
style := aString copyFrom:start to:(end - 1).
(style = 'o') ifTrue:[
- style := 'oblique'
+ style := 'oblique'
] ifFalse:[
- (style = 'i') ifTrue:[
- style := 'italic'
- ] ifFalse:[
- (style = 'r') ifTrue:[
- style := 'roman'
- ]
- ]
+ (style = 'i') ifTrue:[
+ style := 'italic'
+ ] ifFalse:[
+ (style = 'r') ifTrue:[
+ style := 'roman'
+ ]
+ ]
].
start := end + 1.
@@ -4350,10 +4350,14 @@
(end == 0) ifTrue:[^ false].
coding := aString copyFrom:start to:(end - 1).
+ (moreStyle ~= 'normal' and:[moreStyle ~= '']) ifTrue:[
+ style := style, '-', moreStyle.
+ ].
+
aBlock value:family value:face value:style value:size value:coding.
^ true
- "Modified: 27.9.1995 / 10:46:52 / stefan"
+ "Modified: 4.7.1996 / 11:12:25 / stefan"
!
descentOf:aFontId
@@ -4630,83 +4634,99 @@
!
getFontWithFamily:familyString face:faceString
- style:styleString size:sizeArg encoding:encodingSym
+ style:styleArgString size:sizeArg encoding:encodingSym
"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
as family and the other parameters as nil. For example, the cursor font
can be aquired that way."
- |theName theId xlatedStyle id |
+ |styleString theName theId xlatedStyle id spacing|
+
+ styleString := styleArgString.
"special: if face is nil, allow access to X-fonts"
faceString isNil ifTrue:[
- sizeArg notNil ifTrue:[
- theName := familyString , '-' , sizeArg 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
+ sizeArg notNil ifTrue:[
+ theName := familyString , '-' , sizeArg 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
+ "/ in style
+
+ ((styleString endsWith:'-narrow')
+ or:[styleString endsWith:'-semicondensed']) ifTrue:[
+ |i|
+ i := styleString lastIndexOf:$-.
+ spacing := styleString copyFrom:(i+1).
+ styleString := styleString copyTo:(i-1).
+ ] ifFalse:[
+ spacing := 'normal'.
].
xlatedStyle := styleString.
xlatedStyle notNil ifTrue:[
- xlatedStyle := xlatedStyle first asString
+ xlatedStyle := xlatedStyle first asString
].
id := self
- getFontWithFoundry:'*'
- family:familyString asLowercase
- weight:faceString
- slant:xlatedStyle
- spacing:'normal'
- pixelSize:nil
- size:sizeArg
- registry:encodingSym
- encoding:'*'.
+ getFontWithFoundry:'*'
+ family:familyString asLowercase
+ weight:faceString
+ slant:xlatedStyle
+ spacing:spacing
+ pixelSize:nil
+ size:sizeArg
+ registry:encodingSym
+ encoding:'*'.
id isNil ifTrue:[
- (encodingSym notNil and:[encodingSym ~= '*']) ifTrue:[
- "/ too stupid: encodings come in both cases
- "/ and X does not ignore case
- "/
- id := self
- getFontWithFoundry:'*'
- family:familyString asLowercase
- weight:faceString
- slant:xlatedStyle
- spacing:'normal'
- pixelSize:nil
- size:sizeArg
- registry:encodingSym asUppercase
- encoding:'*'.
- id isNil ifTrue:[
- id := self
- getFontWithFoundry:'*'
- family:familyString asLowercase
- weight:faceString
- slant:xlatedStyle
- spacing:'normal'
- pixelSize:nil
- size:sizeArg
- registry:encodingSym asLowercase
- encoding:'*'.
- ]
- ]
+ (encodingSym notNil and:[encodingSym ~= '*']) ifTrue:[
+ "/ too stupid: encodings 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:sizeArg
+ registry:encodingSym asUppercase
+ encoding:'*'.
+ id isNil ifTrue:[
+ id := self
+ getFontWithFoundry:'*'
+ family:familyString asLowercase
+ weight:faceString
+ slant:xlatedStyle
+ spacing:spacing
+ pixelSize:nil
+ size:sizeArg
+ registry:encodingSym asLowercase
+ encoding:'*'.
+ ]
+ ]
].
^ id
"Modified: 24.2.1996 / 22:37:24 / cg"
+ "Modified: 4.7.1996 / 11:38:47 / stefan"
!
getFontWithFoundry:foundry family:family weight:weight
@@ -8095,6 +8115,6 @@
!XWorkstation class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.149 1996-07-02 12:26:37 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.150 1996-07-04 10:47:08 stefan Exp $'
! !
XWorkstation initialize!