# HG changeset patch # User Claus Gittinger # Date 860693766 -7200 # Node ID b75c64bb5849d63f6f5dd79979ce69978b8cc930 # Parent d93e15f64146442b62f8a26a63cd1bdcb3bfb1fa care for encoding & registry diff -r d93e15f64146 -r b75c64bb5849 XWorkstat.st --- a/XWorkstat.st Thu Apr 10 17:49:56 1997 +0200 +++ b/XWorkstat.st Thu Apr 10 19:36:06 1997 +0200 @@ -5645,14 +5645,15 @@ ! getFontWithFamily:familyString face:faceString - style:styleArgString size:sizeArg encoding:encodingSym + style:styleArgString size:sizeArg 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 as family and the other parameters as nil. For example, the cursor font can be aquired that way." - |styleString theName theId xlatedStyle id spacing| + |styleString theName theId xlatedStyle + id spacing encodingMatch registryMatch idx| styleString := styleArgString. @@ -5695,6 +5696,18 @@ xlatedStyle := xlatedStyle first asString ]. + encodingMatch := encoding. + registryMatch := '*'. + encoding isNil ifTrue:[ + encodingMatch := '*'. + ] ifFalse:[ + idx := encoding indexOf:$-. + idx ~~ 0 ifTrue:[ + encodingMatch := encoding copyTo:idx - 1. + registryMatch := encoding copyFrom:idx + 1 + ]. + ]. + id := self getFontWithFoundry:'*' family:familyString asLowercase @@ -5703,11 +5716,11 @@ spacing:spacing pixelSize:nil size:sizeArg - registry:encodingSym - encoding:'*'. + registry:encodingMatch + encoding:registryMatch. id isNil ifTrue:[ - (encodingSym notNil and:[encodingSym ~= '*']) ifTrue:[ + (encodingMatch notNil and:[encodingMatch ~= '*']) ifTrue:[ "/ too stupid: encodings come in both cases "/ and X does not ignore case "/ @@ -5719,8 +5732,8 @@ spacing:spacing pixelSize:nil size:sizeArg - registry:encodingSym asUppercase - encoding:'*'. + registry:encodingMatch asUppercase + encoding:registryMatch. id isNil ifTrue:[ id := self getFontWithFoundry:'*' @@ -5730,20 +5743,20 @@ spacing:spacing pixelSize:nil size:sizeArg - registry:encodingSym asLowercase - encoding:'*'. + registry:encodingMatch asLowercase + encoding:registryMatch. ] ] ]. ^ id "Modified: 4.7.1996 / 11:38:47 / stefan" - "Modified: 28.2.1997 / 18:26:12 / cg" + "Modified: 10.4.1997 / 19:20:06 / cg" ! getFontWithFoundry:foundry family:family weight:weight - slant:slant spacing:spc pixelSize:pSize size:size - registry:registry encoding:encoding + slant:slant spacing:spc pixelSize:pSize size:size + registry:registry encoding:encoding "get the specified font, if not available, return nil. This is the new font creation method - all others will be changed to @@ -5758,7 +5771,7 @@ pixelSize: 16,18 ... usually left empty size: size in point (1/72th of an inch) registry: iso8859, sgi ... '*' - encoding: vendor specific encoding (usually '*') + encoding: registry specific encoding (usually '*') " |theName sizeMatch @@ -5767,70 +5780,70 @@ "this works only on 'Release >= 3' - X-servers" "name is: - -foundry-family -weight -slant- - sony helvetica bold r - adobe courier medium i - msic fixed o - ... ... + -foundry-family -weight -slant- + sony helvetica bold r + adobe courier medium i + msic fixed o + ... ... " size isNil ifTrue:[ - sizeMatch := '*' + sizeMatch := '*' ] ifFalse:[ - sizeMatch := size printString , '0' + sizeMatch := size printString , '0' ]. foundry isNil ifTrue:[ - foundryMatch := '*' + foundryMatch := '*' ] ifFalse:[ - foundryMatch := foundry + foundryMatch := foundry ]. family isNil ifTrue:[ - familyMatch := '*' + familyMatch := '*' ] ifFalse:[ - familyMatch := family + familyMatch := family ]. weight isNil ifTrue:[ - weightMatch := '*' + weightMatch := '*' ] ifFalse:[ - weightMatch := weight + weightMatch := weight ]. slant isNil ifTrue:[ - slantMatch := '*' + slantMatch := '*' ] ifFalse:[ - slantMatch := slant + slantMatch := slant ]. spc isNil ifTrue:[ - spcMatch := '*' + spcMatch := '*' ] ifFalse:[ - spcMatch := spc + spcMatch := spc ]. pSize isNil ifTrue:[ - pSizeMatch := '*' + pSizeMatch := '*' ] ifFalse:[ - pSizeMatch := pSize printString + pSizeMatch := pSize printString ]. registry isNil ifTrue:[ - registryMatch := '*' + registryMatch := '*' ] ifFalse:[ - registryMatch := registry + registryMatch := registry ]. encoding isNil ifTrue:[ - encodingMatch := '*' + encodingMatch := '*' ] ifFalse:[ - encodingMatch := encoding + encodingMatch := encoding ]. theName := ('-' , foundryMatch, - '-' , familyMatch, - '-' , weightMatch , - '-' , slantMatch , - '-' , spcMatch , - '-*' , - '-' , pSizeMatch , - '-' , sizeMatch , - '-*-*-*-*' , - '-' , registryMatch , - '-' , encodingMatch). + '-' , familyMatch, + '-' , weightMatch , + '-' , slantMatch , + '-' , spcMatch , + '-*' , + '-' , pSizeMatch , + '-' , sizeMatch , + '-*-*-*-*' , + '-' , registryMatch , + '-' , encodingMatch). "/ Transcript showCR:theName; endEntry. @@ -5839,17 +5852,17 @@ " Display getFontWithFoundry:'*' - family:'courier' - weight:'medium' - slant:'r' - spacing:nil - pixelSize:nil - size:13 - registry:'iso8859' - encoding:'*' + family:'courier' + weight:'medium' + slant:'r' + spacing:nil + pixelSize:nil + size:13 + registry:'iso8859' + encoding:'*' " - "Modified: 24.2.1996 / 22:33:29 / cg" + "Modified: 10.4.1997 / 19:15:44 / cg" ! listOfAvailableFonts @@ -9216,6 +9229,6 @@ !XWorkstation class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libview/Attic/XWorkstat.st,v 1.235 1997-04-10 12:28:32 cg Exp $' + ^ '$Header: /cvs/stx/stx/libview/Attic/XWorkstat.st,v 1.236 1997-04-10 17:36:06 cg Exp $' ! ! XWorkstation initialize! diff -r d93e15f64146 -r b75c64bb5849 XWorkstation.st --- a/XWorkstation.st Thu Apr 10 17:49:56 1997 +0200 +++ b/XWorkstation.st Thu Apr 10 19:36:06 1997 +0200 @@ -5645,14 +5645,15 @@ ! getFontWithFamily:familyString face:faceString - style:styleArgString size:sizeArg encoding:encodingSym + style:styleArgString size:sizeArg 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 as family and the other parameters as nil. For example, the cursor font can be aquired that way." - |styleString theName theId xlatedStyle id spacing| + |styleString theName theId xlatedStyle + id spacing encodingMatch registryMatch idx| styleString := styleArgString. @@ -5695,6 +5696,18 @@ xlatedStyle := xlatedStyle first asString ]. + encodingMatch := encoding. + registryMatch := '*'. + encoding isNil ifTrue:[ + encodingMatch := '*'. + ] ifFalse:[ + idx := encoding indexOf:$-. + idx ~~ 0 ifTrue:[ + encodingMatch := encoding copyTo:idx - 1. + registryMatch := encoding copyFrom:idx + 1 + ]. + ]. + id := self getFontWithFoundry:'*' family:familyString asLowercase @@ -5703,11 +5716,11 @@ spacing:spacing pixelSize:nil size:sizeArg - registry:encodingSym - encoding:'*'. + registry:encodingMatch + encoding:registryMatch. id isNil ifTrue:[ - (encodingSym notNil and:[encodingSym ~= '*']) ifTrue:[ + (encodingMatch notNil and:[encodingMatch ~= '*']) ifTrue:[ "/ too stupid: encodings come in both cases "/ and X does not ignore case "/ @@ -5719,8 +5732,8 @@ spacing:spacing pixelSize:nil size:sizeArg - registry:encodingSym asUppercase - encoding:'*'. + registry:encodingMatch asUppercase + encoding:registryMatch. id isNil ifTrue:[ id := self getFontWithFoundry:'*' @@ -5730,20 +5743,20 @@ spacing:spacing pixelSize:nil size:sizeArg - registry:encodingSym asLowercase - encoding:'*'. + registry:encodingMatch asLowercase + encoding:registryMatch. ] ] ]. ^ id "Modified: 4.7.1996 / 11:38:47 / stefan" - "Modified: 28.2.1997 / 18:26:12 / cg" + "Modified: 10.4.1997 / 19:20:06 / cg" ! getFontWithFoundry:foundry family:family weight:weight - slant:slant spacing:spc pixelSize:pSize size:size - registry:registry encoding:encoding + slant:slant spacing:spc pixelSize:pSize size:size + registry:registry encoding:encoding "get the specified font, if not available, return nil. This is the new font creation method - all others will be changed to @@ -5758,7 +5771,7 @@ pixelSize: 16,18 ... usually left empty size: size in point (1/72th of an inch) registry: iso8859, sgi ... '*' - encoding: vendor specific encoding (usually '*') + encoding: registry specific encoding (usually '*') " |theName sizeMatch @@ -5767,70 +5780,70 @@ "this works only on 'Release >= 3' - X-servers" "name is: - -foundry-family -weight -slant- - sony helvetica bold r - adobe courier medium i - msic fixed o - ... ... + -foundry-family -weight -slant- + sony helvetica bold r + adobe courier medium i + msic fixed o + ... ... " size isNil ifTrue:[ - sizeMatch := '*' + sizeMatch := '*' ] ifFalse:[ - sizeMatch := size printString , '0' + sizeMatch := size printString , '0' ]. foundry isNil ifTrue:[ - foundryMatch := '*' + foundryMatch := '*' ] ifFalse:[ - foundryMatch := foundry + foundryMatch := foundry ]. family isNil ifTrue:[ - familyMatch := '*' + familyMatch := '*' ] ifFalse:[ - familyMatch := family + familyMatch := family ]. weight isNil ifTrue:[ - weightMatch := '*' + weightMatch := '*' ] ifFalse:[ - weightMatch := weight + weightMatch := weight ]. slant isNil ifTrue:[ - slantMatch := '*' + slantMatch := '*' ] ifFalse:[ - slantMatch := slant + slantMatch := slant ]. spc isNil ifTrue:[ - spcMatch := '*' + spcMatch := '*' ] ifFalse:[ - spcMatch := spc + spcMatch := spc ]. pSize isNil ifTrue:[ - pSizeMatch := '*' + pSizeMatch := '*' ] ifFalse:[ - pSizeMatch := pSize printString + pSizeMatch := pSize printString ]. registry isNil ifTrue:[ - registryMatch := '*' + registryMatch := '*' ] ifFalse:[ - registryMatch := registry + registryMatch := registry ]. encoding isNil ifTrue:[ - encodingMatch := '*' + encodingMatch := '*' ] ifFalse:[ - encodingMatch := encoding + encodingMatch := encoding ]. theName := ('-' , foundryMatch, - '-' , familyMatch, - '-' , weightMatch , - '-' , slantMatch , - '-' , spcMatch , - '-*' , - '-' , pSizeMatch , - '-' , sizeMatch , - '-*-*-*-*' , - '-' , registryMatch , - '-' , encodingMatch). + '-' , familyMatch, + '-' , weightMatch , + '-' , slantMatch , + '-' , spcMatch , + '-*' , + '-' , pSizeMatch , + '-' , sizeMatch , + '-*-*-*-*' , + '-' , registryMatch , + '-' , encodingMatch). "/ Transcript showCR:theName; endEntry. @@ -5839,17 +5852,17 @@ " Display getFontWithFoundry:'*' - family:'courier' - weight:'medium' - slant:'r' - spacing:nil - pixelSize:nil - size:13 - registry:'iso8859' - encoding:'*' + family:'courier' + weight:'medium' + slant:'r' + spacing:nil + pixelSize:nil + size:13 + registry:'iso8859' + encoding:'*' " - "Modified: 24.2.1996 / 22:33:29 / cg" + "Modified: 10.4.1997 / 19:15:44 / cg" ! listOfAvailableFonts @@ -9216,6 +9229,6 @@ !XWorkstation class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.235 1997-04-10 12:28:32 cg Exp $' + ^ '$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.236 1997-04-10 17:36:06 cg Exp $' ! ! XWorkstation initialize!