XftFontDescription.st
branchdelegated_gc
changeset 6472 5b21ff383a12
parent 6223 5e154dcb2acd
child 6524 1647b1f4874a
child 6754 e5fad431c0b8
--- a/XftFontDescription.st	Thu Feb 06 12:50:14 2014 +0100
+++ b/XftFontDescription.st	Thu May 08 10:27:51 2014 +0200
@@ -1,7 +1,9 @@
+'From Smalltalk/X, Version:6.2.3.0 on 08-05-2014 at 10:08:24'                   !
+
 "{ Package: 'stx:libview' }"
 
 FontDescription subclass:#XftFontDescription
-	instanceVariableNames:'device fontId drawId closestFont'
+	instanceVariableNames:'device fontId sharedDrawId closestFont minCode maxCode'
 	classVariableNames:'FC_FAMILY FC_STYLE FC_SLANT FC_WEIGHT FC_SIZE FC_ASPECT
 		FC_PIXEL_SIZE FC_SPACING FC_FOUNDRY FC_ANTIALIAS FC_HINTING
 		FC_HINT_STYLE FC_VERTICAL_LAYOUT FC_AUTOHINT FC_WIDTH FC_FILE
@@ -25,11 +27,18 @@
 		FC_RGBA_VBGR FC_RGBA_NONE FC_HINT_NONE FC_HINT_SLIGHT
 		FC_HINT_MEDIUM FC_HINT_FULL FC_LCD_NONE FC_LCD_DEFAULT
 		FC_LCD_LIGHT FC_LCD_LEGACY StXFace2FCWeightMap
-		StXStyle2FCSlantMap'
+		StXStyle2FCSlantMap CachedFontList RecentlyUsedFonts'
 	poolDictionaries:''
 	category:'Graphics-Support'
 !
 
+Object subclass:#FCFontListParser
+	instanceVariableNames:'pipeStream lineStream currentDescription'
+	classVariableNames:''
+	poolDictionaries:''
+	privateIn:XftFontDescription
+!
+
 ExternalAddress subclass:#FCPatternHandle
 	instanceVariableNames:''
 	classVariableNames:''
@@ -148,6 +157,14 @@
 
 !XftFontDescription class methodsFor:'initialization'!
 
+flushListOfAvailableFonts
+    CachedFontList := nil.
+
+    "
+     XftFontDescription flushListOfAvailableFonts
+    "
+!
+
 initialize
     "Invoked at system start or when the class is dynamically loaded."
 
@@ -258,9 +275,23 @@
     FC_LCD_LEGACY           := 3.
 
     StXFace2FCWeightMap := Dictionary withKeysAndValues:{
-	'regular'.  FC_WEIGHT_REGULAR.
-	'medium'.   FC_WEIGHT_MEDIUM.
-	'bold'.     FC_WEIGHT_BOLD.
+	'thin'.       FC_WEIGHT_THIN.
+	'extralight'. FC_WEIGHT_EXTRALIGHT.
+	'ultralight'. FC_WEIGHT_ULTRALIGHT.
+	'light'.      FC_WEIGHT_LIGHT.
+	'book'.       FC_WEIGHT_BOOK.
+	'regular'.    FC_WEIGHT_REGULAR.
+	'normal'.     FC_WEIGHT_NORMAL.
+	'medium'.     FC_WEIGHT_MEDIUM.
+	'demibold'.   FC_WEIGHT_DEMIBOLD.
+	'semibold'.   FC_WEIGHT_SEMIBOLD.
+	'bold'.       FC_WEIGHT_BOLD.
+	'extrabold'.  FC_WEIGHT_EXTRABOLD.
+	'ultrabold'.  FC_WEIGHT_ULTRABOLD.
+	'black'.      FC_WEIGHT_BLACK.
+	'heavy'.      FC_WEIGHT_HEAVY.
+	'extrablack'. FC_WEIGHT_EXTRABLACK.
+	'ultrablack'. FC_WEIGHT_ULTRABLACK.
     }.
     StXStyle2FCSlantMap := Dictionary withKeysAndValues:{
 	'roman'.    FC_SLANT_ROMAN.
@@ -271,6 +302,38 @@
     "Modified: / 30-12-2013 / 19:48:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
+!XftFontDescription class methodsFor:'instance creation'!
+
+family:familyString face:faceString style:styleString size:size sizeUnit:sizeUnit encoding:encoding
+    "returns a font for given family, face, style, size and the specified encoding.
+     The returned font is not associated to a specific device"
+
+    |proto|
+
+    CachedFontList notNil ifTrue:[
+	proto := CachedFontList
+		detect:[:fn |
+		    fn family = familyString
+		    and:[ fn face = faceString
+		    and:[ (fn style = styleString
+			  or:[ (fn style = 'oblique' and:[styleString = 'italic'])
+			  or:[ (fn style = 'italic' and:[styleString = 'oblique']) ]]) ]]]
+		ifNone:nil.
+	proto notNil ifTrue:[
+	    ^ (proto shallowCopy)
+		setDevice: nil patternId: nil fontId: nil;
+		family:familyString face:faceString style:styleString size:size sizeUnit:sizeUnit encoding:encoding
+	].
+    ].
+    ^ super
+	family:familyString face:faceString style:styleString size:size sizeUnit:sizeUnit encoding:encoding
+!
+
+new
+"/    self halt.
+    ^ super new.
+! !
+
 !XftFontDescription class methodsFor:'examples'!
 
 example1
@@ -316,16 +379,151 @@
     top open.
 
     "Created: / 30-12-2013 / 19:49:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+example3
+    "
+    XftFontDescription example2
+    "
+    |top textView|
+
+    top := StandardSystemView new.
+    top extent:300@200.
+
+    textView := EditTextView new.
+    textView origin:0.0 @ 0.0 corner:1.0 @ 1.0.
+    textView basicFont: (XftFontDescription family: 'Indie Flower' size: 30).
+
+    top addSubView:textView.
+
+    textView contents:('/etc/hosts' asFilename contentsOfEntireFile).
+
+    top open.
+
+    "Created: / 30-12-2013 / 19:49:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
-!XftFontDescription methodsFor:'accessing-private'!
+!XftFontDescription class methodsFor:'queries'!
+
+listOfAvailableFonts
+    "uses fc-list to get a list of available fontDescriptions"
+
+    CachedFontList isNil ifTrue:[
+	CachedFontList := FCFontListParser new listOfAvailableFonts
+    ].
+    ^ CachedFontList
+
+    "
+     XftFontDescription flushListOfAvailableFonts.
+     XftFontDescription listOfAvailableFonts
+    "
+! !
 
-getDevice
+!XftFontDescription methodsFor:'accessing'!
+
+encoding
+    ^ encoding ? #'iso10646-1'
+!
+
+face
+    ^ face ? ''
+!
+
+fullName
+    ^ name ? (self userFriendlyName)
+!
+
+graphicsDevice
     ^ device
 
     "Created: / 02-01-2014 / 23:22:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
+maxCode
+    ^ maxCode ? 16rFFFF
+!
+
+maxCode:something
+    maxCode := something.
+!
+
+minCode
+    ^ minCode ? 0
+!
+
+minCode:something
+    minCode := something.
+!
+
+size
+    ^ size ? 0
+!
+
+style
+    ^ style ? ''
+!
+
+weight:aNumber
+    "set the weight"
+
+    self assert:(self fontId isNil). "/ cannot change an instantiated font
+
+    aNumber == FC_WEIGHT_THIN ifTrue:[ face := 'thin'. ^ self].
+    aNumber == FC_WEIGHT_EXTRALIGHT ifTrue:[ face := 'extralight'. ^ self].
+    aNumber == FC_WEIGHT_LIGHT ifTrue:[ face := 'light'. ^ self].
+    aNumber == FC_WEIGHT_BOOK ifTrue:[ face := 'book'. ^ self].
+    aNumber == FC_WEIGHT_REGULAR ifTrue:[ face := 'regular'. ^ self].
+    aNumber == FC_WEIGHT_MEDIUM ifTrue:[ face := 'medium'. ^ self].
+    aNumber == FC_WEIGHT_DEMIBOLD ifTrue:[ face := 'demibold'. ^ self].
+    aNumber == FC_WEIGHT_BOLD ifTrue:[ face := 'bold'. ^ self].
+    aNumber == FC_WEIGHT_EXTRABOLD ifTrue:[ face := 'extrabold'. ^ self].
+    aNumber == FC_WEIGHT_BLACK ifTrue:[ face := 'black'. ^ self].
+    aNumber == FC_WEIGHT_EXTRABLACK ifTrue:[ face := 'extrablack'. ^ self].
+
+    aNumber <= (FC_WEIGHT_EXTRALIGHT + FC_WEIGHT_LIGHT // 2) ifTrue:[
+	face := 'extralight'.
+	^ self.
+    ].
+    aNumber <= (FC_WEIGHT_LIGHT + FC_WEIGHT_BOOK // 2) ifTrue:[
+	face := 'light'.
+	^ self.
+    ].
+    aNumber <= (FC_WEIGHT_MEDIUM + FC_WEIGHT_DEMIBOLD // 2) ifTrue:[
+	face := 'medium'.
+	^ self.
+    ].
+    aNumber <= (FC_WEIGHT_DEMIBOLD + FC_WEIGHT_BOLD // 2) ifTrue:[
+	face := 'demibold'.
+	^ self.
+    ].
+    aNumber <= (FC_WEIGHT_BOLD + FC_WEIGHT_BLACK // 2) ifTrue:[
+	face := 'bold'.
+	^ self.
+    ].
+    face := 'extrabold'.
+    ^ self
+
+"/    FC_WEIGHT_THIN          := 0.
+"/    FC_WEIGHT_EXTRALIGHT    := 40.
+"/    FC_WEIGHT_ULTRALIGHT    := FC_WEIGHT_EXTRALIGHT.
+"/    FC_WEIGHT_LIGHT         := 50.
+"/    FC_WEIGHT_BOOK          := 75.
+"/    FC_WEIGHT_REGULAR       := 80.
+"/    FC_WEIGHT_NORMAL        := FC_WEIGHT_REGULAR.
+"/    FC_WEIGHT_MEDIUM        := 100.
+"/    FC_WEIGHT_DEMIBOLD      := 180.
+"/    FC_WEIGHT_SEMIBOLD      := FC_WEIGHT_DEMIBOLD.
+"/    FC_WEIGHT_BOLD          := 200.
+"/    FC_WEIGHT_EXTRABOLD     := 205.
+"/    FC_WEIGHT_ULTRABOLD     := FC_WEIGHT_EXTRABOLD.
+"/    FC_WEIGHT_BLACK         := 210.
+"/    FC_WEIGHT_HEAVY         := FC_WEIGHT_BLACK.
+"/    FC_WEIGHT_EXTRABLACK    := 215.
+"/    FC_WEIGHT_ULTRABLACK    := FC_WEIGHT_EXTRABLACK.
+! !
+
+!XftFontDescription methodsFor:'accessing-private'!
+
 getFontId
     ^ fontId
 
@@ -334,58 +532,79 @@
 
 !XftFontDescription methodsFor:'displaying'!
 
-displayString:aString from:index1 to:index2 x:xArg y:yArg in:aGC opaque:opaque
+displayString:aString from:index1 to:index2Arg x:xArg y:yArg in:aGC opaque:opaque
     "display a partial string at some position in aGC."
 
-    |bytesPerCharacter transformation clipR clipX clipY clipW clipH fg fgR fgG fgB fgA fgPixel bg bgR bgG bgB bgA bgPixel drawX drawY displayId screen drawableId error |
-
-    bytesPerCharacter := aString bitsPerCharacter // 8.
-    transformation := aGC transformation.
+    |index2 bytesPerCharacter transformation clipR clipX clipY clipW clipH fg fgR fgG fgB fgA fgPixel
+     bg bgR bgG bgB bgA bgPixel drawX drawY displayId screen drawableId error stringLen|
 
-    transformation isNil ifTrue:[
-	drawX := xArg.
-	drawY := yArg.
-    ] ifFalse:[
-	drawX := transformation applyToX: xArg.
-	drawY := transformation applyToY: yArg.
+    "limit the string len, otherwise bad output is generated"
+    stringLen := index2Arg - index1.
+    stringLen > 4000 ifTrue:[
+        index2 := index1 + 4000.
+    ]  ifFalse:[
+        index2 := index2Arg.
+    ].
+    bytesPerCharacter := aString bitsPerCharacter // 8.
+
+    clipR := aGC deviceClippingBoundsOrNil.
+    clipR notNil ifTrue:[
+        clipX := clipR left.
+        clipY := clipR top.
+        clipW := clipR width.
+        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.].
     ].
 
-    clipR := aGC clippingRectangleOrNil.
-    clipR notNil ifTrue:[
-	clipX := clipR left.
-	clipY := clipR top.
-	clipW := clipR width.
-	clipH := clipR height.
-	transformation notNil ifTrue:[
-	    clipX := transformation applyToX: clipX.
-	    clipY := transformation applyToY: clipY.
-	    clipW := transformation applyScaleX: clipW.
-	    clipH := transformation applyScaleY: clipH.
-	].
+    transformation := aGC transformation.
+    transformation isNil ifTrue:[
+        drawX := xArg.
+        drawY := yArg.
+    ] ifFalse:[
+        drawX := (transformation applyToX:xArg) ceiling.
+        drawY := (transformation applyToY:yArg) ceiling.
     ].
 
     fg  :=  aGC paint.
     fgPixel := fg colorId.
-    "/ fgPixel isNil ifTrue:[
-	fgR := fg scaledRed.
-	fgG := fg scaledGreen.
-	fgB := fg scaledBlue.
-	fgA := (fg alpha * 65535) rounded.
-    "/].
+    fgA := fg scaledAlpha.
+    fgR := fg scaledRed.
+    fgR notNil ifTrue:[
+        fgG := fg scaledGreen.
+        fgB := fg scaledBlue.
+    ] ifFalse:[
+        "/ when drawing into a pixmap...
+        fgPixel == 0 ifTrue:[
+            fgR := fgG := fgB := 0.
+        ] ifFalse:[
+            fgR := fgG := fgB := 16rFFFF.
+        ]
+    ].
 
     opaque ifTrue:[
-	bg  := aGC backgroundPaint.
-	bgPixel := bg colorId.
-	"/bgPixel notNil ifTrue:[
-	    bgR := bg scaledRed.
-	    bgG := bg scaledGreen.
-	    bgB := bg scaledBlue.
-	    bgA := (bg alpha * 65535) rounded.
-	"/].
+        bg  := aGC backgroundPaint.
+        bgPixel := bg colorId.
+        bgA := bg scaledAlpha.
+        bgR := bg scaledRed.
+        bgR notNil ifTrue:[
+            bgG := bg scaledGreen.
+            bgB := bg scaledBlue.
+        ] ifFalse:[
+            "/ when drawing into a pixmap...
+            bgPixel == 0 ifTrue:[
+                bgR := bgG := bgB := 0.
+            ] ifFalse:[
+                bgR := bgG := bgB := 16rFFFF.
+            ]
+        ].
     ].
-    displayId := device displayId.
+    displayId := device displayIdOrErrorIfBroken.
+    displayId isNil ifTrue:[
+        ^ self.
+    ].
     screen := device screen.
-    drawableId := aGC id.
+    drawableId := aGC drawableId.
 
 %{
 #ifdef XFT
@@ -399,102 +618,103 @@
     int __bytesPerCharacter;
 
     if (!(__bothSmallInteger(drawX, drawY)
-	  && __bothSmallInteger(index1, index2)
-	  && __isSmallInteger(bytesPerCharacter)
-	  && (__isSmallInteger(fgPixel) || (__bothSmallInteger(fgR, fgG) && __bothSmallInteger(fgB, fgA)))
-	  && (opaque == false || __isSmallInteger(bgPixel) || (__bothSmallInteger(bgR, bgG) && __bothSmallInteger(bgB, bgA)))
-	  && __isNonNilObject(aString)
+          && __bothSmallInteger(index1, index2)
+          && __isSmallInteger(bytesPerCharacter)
+          && (__isSmallInteger(fgPixel) || (__bothSmallInteger(fgR, fgG) && __bothSmallInteger(fgB, fgA)))
+          && (opaque == false || __isSmallInteger(bgPixel) || (__bothSmallInteger(bgR, bgG) && __bothSmallInteger(bgB, bgA)))
+          && __isNonNilObject(aString)
     )) {
-	goto err;
+        goto err;
     }
 
     __bytesPerCharacter = __intVal(bytesPerCharacter);
 
-    if ( __INST(drawId) == nil ) {
-	__INST(drawId) = XFT_DRAW_HANDLE_NEW ( XftDrawCreate ( DISPLAY( displayId ) ,
-					       DRAWABLE( drawableId ) ,
-					       DefaultVisual( DISPLAY( displayId), SCREEN (screen) ) ,
-					       DefaultColormap( DISPLAY( displayId), SCREEN (screen) ) ) );
-	__STORE(self, __INST(drawId));
+    if ( __INST(sharedDrawId) == nil ) {
+        __INST(sharedDrawId) = XFT_DRAW_HANDLE_NEW ( XftDrawCreate ( DISPLAY( displayId ) ,
+                                               DRAWABLE( drawableId ) ,
+                                               DefaultVisual( DISPLAY( displayId), SCREEN (screen) ) ,
+                                               DefaultColormap( DISPLAY( displayId), SCREEN (screen) ) ) );
+        __STORE(self, __INST(sharedDrawId));
     }
 
-    if ( XftDrawDrawable ( XFT_DRAW ( __INST(drawId) ) ) != DRAWABLE( drawableId ) ) {
-	XftDrawChange( XFT_DRAW( __INST(drawId) ) , DRAWABLE( drawableId ) );
+    if ( XftDrawDrawable ( XFT_DRAW ( __INST(sharedDrawId) ) ) != DRAWABLE( drawableId ) ) {
+        XftDrawChange( XFT_DRAW( __INST(sharedDrawId) ) , DRAWABLE( drawableId ) );
     }
 
     string = __stringVal( aString ) + (( __intVal(index1) - 1 ) * __bytesPerCharacter);
     len = __intVal(index2) - __intVal(index1) + 1;
 
     if (clipR != nil) {
-	clipRX.x = __intVal(clipX);
-	clipRX.y = __intVal(clipY);
-	clipRX.width = __intVal(clipW);
-	clipRX.height = __intVal(clipH);
-	XftDrawSetClipRectangles( XFT_DRAW( __INST( drawId ) ) , 0, 0, &clipRX, 1);
+        clipRX.x = __intVal(clipX);
+        clipRX.y = __intVal(clipY);
+        clipRX.width = __intVal(clipW);
+        clipRX.height = __intVal(clipH);
+        XftDrawSetClipRectangles( XFT_DRAW( __INST( sharedDrawId ) ) , 0, 0, &clipRX, 1);
     } else {
-	XftDrawSetClip( XFT_DRAW( __INST( drawId ) ) , 0);
+        XftDrawSetClip( XFT_DRAW( __INST( sharedDrawId ) ) , 0);
     }
 
     if (opaque == true) {
-	if (bgPixel != nil) {
-	    color.pixel = (unsigned long)__intVal(bgPixel);
-	} 
-	// else {
-	    color.color.red = __intVal(bgR);
-	    color.color.green = __intVal(bgG);
-	    color.color.blue = __intVal(bgB);
-	    color.color.alpha = __intVal(bgA);
-	// }
-	switch (__bytesPerCharacter) {
-	case 1:
-	    XftTextExtents8( DISPLAY( displayId ), XFT_FONT( __INST( fontId ) ), (FcChar8*)string, len, &extents);
-	    break;
-	case 2:
-	    XftTextExtents16( DISPLAY( displayId ), XFT_FONT( __INST( fontId ) ), (FcChar16*)string, len, &extents);
-	    break;
-	case 4:
-	    XftTextExtents32( DISPLAY( displayId ), XFT_FONT( __INST( fontId ) ), (FcChar32*)string, len, &extents);
-	    break;
-	}
-	XftDrawRect( XFT_DRAW ( __INST( drawId ) ), &color, __intVal(drawX) - extents.x, __intVal(drawY) - XFT_FONT( __INST( fontId ) )->ascent, extents.width, XFT_FONT(__INST (fontId ) )->height);
+        if (bgPixel != nil) {
+            color.pixel = (unsigned long)__intVal(bgPixel);
+        }
+        // else {
+            color.color.red = __intVal(bgR);
+            color.color.green = __intVal(bgG);
+            color.color.blue = __intVal(bgB);
+            color.color.alpha = __intVal(bgA);
+        // }
+        switch (__bytesPerCharacter) {
+        case 1:
+            XftTextExtents8( DISPLAY( displayId ), XFT_FONT( __INST( fontId ) ), (FcChar8*)string, len, &extents);
+            break;
+        case 2:
+            XftTextExtents16( DISPLAY( displayId ), XFT_FONT( __INST( fontId ) ), (FcChar16*)string, len, &extents);
+            break;
+        case 4:
+            XftTextExtents32( DISPLAY( displayId ), XFT_FONT( __INST( fontId ) ), (FcChar32*)string, len, &extents);
+            break;
+        }
+if (extents.width < 0) printf("width: %d  < 0\n", extents.width);
+        XftDrawRect( XFT_DRAW ( __INST( sharedDrawId ) ), &color, __intVal(drawX) - extents.x, __intVal(drawY) - XFT_FONT( __INST( fontId ) )->ascent, extents.width, XFT_FONT(__INST (fontId ) )->height);
     }
     if (fgPixel != nil) {
-	color.pixel = (unsigned long)__intVal(fgPixel);
+        color.pixel = (unsigned long)__intVal(fgPixel);
     }
     // else {
-	color.color.red = __intVal(fgR);
-	color.color.green = __intVal(fgG);
-	color.color.blue = __intVal(fgB);
-	color.color.alpha = __intVal(fgA);
+        color.color.red = __intVal(fgR);
+        color.color.green = __intVal(fgG);
+        color.color.blue = __intVal(fgB);
+        color.color.alpha = __intVal(fgA);
     // }
     switch (__bytesPerCharacter) {
     case 1:
-	XftDrawString8( XFT_DRAW ( __INST( drawId ) ), &color, XFT_FONT( __INST( fontId ) ),
-			__intVal(drawX),
-			__intVal(drawY),
-			(FcChar8*)string,
-			len);
-	RETURN ( self );
-	break;
+        XftDrawString8( XFT_DRAW ( __INST( sharedDrawId ) ), &color, XFT_FONT( __INST( fontId ) ),
+                        __intVal(drawX),
+                        __intVal(drawY),
+                        (FcChar8*)string,
+                        len);
+        RETURN ( self );
+        break;
     case 2:
-	XftDrawString16( XFT_DRAW ( __INST( drawId ) ), &color, XFT_FONT( __INST( fontId ) ),
-			__intVal(drawX),
-			__intVal(drawY),
-			(FcChar16*)string,
-			len);
-	RETURN ( self );
-	break;
+        XftDrawString16( XFT_DRAW ( __INST( sharedDrawId ) ), &color, XFT_FONT( __INST( fontId ) ),
+                        __intVal(drawX),
+                        __intVal(drawY),
+                        (FcChar16*)string,
+                        len);
+        RETURN ( self );
+        break;
     case 4:
-	XftDrawString32( XFT_DRAW ( __INST( drawId ) ), &color, XFT_FONT( __INST( fontId ) ),
-			__intVal(drawX),
-			__intVal(drawY),
-			(FcChar32*)string,
-			len);
-	RETURN ( self );
-	break;
+        XftDrawString32( XFT_DRAW ( __INST( sharedDrawId ) ), &color, XFT_FONT( __INST( fontId ) ),
+                        __intVal(drawX),
+                        __intVal(drawY),
+                        (FcChar32*)string,
+                        len);
+        RETURN ( self );
+        break;
     }
+#endif
     err:;
-#endif
 %}.
     self primitiveFailed: error.
 
@@ -543,12 +763,30 @@
 	^ self
     ].
 
-    (closestFont notNil and:[closestFont getDevice == aGraphicsDevice]) ifTrue:[
+    (closestFont notNil and:[closestFont graphicsDevice == aGraphicsDevice]) ifTrue:[
 	^ closestFont onDevice: aGraphicsDevice.
     ].
 
+    RecentlyUsedFonts isNil ifTrue:[
+	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
+	]
+    ].
+
+    RecentlyUsedFonts size > 20 ifTrue:[
+	RecentlyUsedFonts removeLast.
+    ].
+
     aGraphicsDevice deviceFonts do:[:aFont |
-	(self sameDeviceFontAs:aFont) ifTrue:[
+	((aFont class == self class) and:[self sameDeviceFontAs:aFont]) ifTrue:[
+	    RecentlyUsedFonts addFirst:aFont.
 	    ^ aFont
 	].
     ].
@@ -561,15 +799,16 @@
 	] ifFalse:[
 	    self xftPatternAdd: myPatternId attribute: FC_SIZE value: size.
 	].
-	self xftPatternAdd: myPatternId attribute: FC_WEIGHT value: (StXFace2FCWeightMap at: face).
-	self xftPatternAdd: myPatternId attribute: FC_SLANT value: (StXStyle2FCSlantMap at: style).
+	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 exist!!
+	    "/ 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.
@@ -585,28 +824,30 @@
 	    "/ !!!!!!!! closestPatternId is no longer valid !!!!!!!!
 	    closestPatternId1 :=  nil.
 	    newFontId isNil ifTrue:[
-		self error: 'Pattern matched, but font could be open (should not happen)'.
+		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...
+	    "/ to check whether some other font instance represents the same font...
 	    aGraphicsDevice deviceFonts do:[:aFont |
-		((self class == aFont class) and:[ newFontId = aFont getFontId ]) ifTrue:[
+		((self class == aFont class) and:[newFontId = aFont getFontId]) ifTrue:[
 		    closestFont := aFont.
 		    ^ closestFont
 		].
 	    ].
 
-	    closestFont := self class new
+	    closestFont := self shallowCopy
 				setDevice: aGraphicsDevice patternId: closestPatternId2 fontId: newFontId;
 				yourself.
 	    aGraphicsDevice registerFont: closestFont.
+	    RecentlyUsedFonts addFirst:closestFont.
 	    ^ closestFont
 	].
     ] ensure:[
-	self xftPatternDestroy: myPatternId.
-	self xftPatternDestroy: closestPatternId1.
-	self xftPatternDestroy: closestPatternId2.
+	myPatternId notNil ifTrue:[self xftPatternDestroy: myPatternId].
+	closestPatternId1 notNil ifTrue:[self xftPatternDestroy: closestPatternId1].
+	closestPatternId2 notNil ifTrue:[self xftPatternDestroy: closestPatternId2].
     ].
 
     "
@@ -622,8 +863,7 @@
      myself on aWorkstation. This does NOT try to look for existing
      or replacement fonts (i.e. can be used to get physical fonts)."
 
-    "/ Apparently, this is not needed.
-    self shouldImplement
+    ^ self onDevice:aWorkstation
 
     "Modified: / 02-01-2014 / 23:15:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
     "Modified (comment): / 04-01-2014 / 02:06:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -634,15 +874,19 @@
 setDevice: deviceArg patternId: patternIdArg fontId: fontIdArg
     device := deviceArg.
     fontId := fontIdArg.
+    patternIdArg notNil ifTrue:[
+        family  := self xftPatternGet: patternIdArg attribute: FC_FAMILY index: 0.
+        size    := self xftPatternGet: patternIdArg attribute: FC_SIZE index: 0.
+        face    := self xftPatternGet: patternIdArg attribute: FC_WEIGHT index: 0.
+        face    := StXFace2FCWeightMap keyAtValue: face.
+        style   := self xftPatternGet: patternIdArg attribute: FC_SLANT index: 0.
+        style   := StXStyle2FCSlantMap keyAtValue: style.
 
-    family  := self xftPatternGet: patternIdArg attribute: FC_FAMILY index: 0.
-    size    := self xftPatternGet: patternIdArg attribute: FC_SIZE index: 0.
-    face    := self xftPatternGet: patternIdArg attribute: FC_WEIGHT index: 0.
-    face    := StXFace2FCWeightMap keyAtValue: face.
-    style   := self xftPatternGet: patternIdArg attribute: FC_SLANT index: 0.
-    style   := StXStyle2FCSlantMap keyAtValue: style.
+        name:= self xftPatternGet: patternIdArg attribute: 'fullname' index: 0.
 
-    encoding:= self xftPatternGet: patternIdArg attribute: 'encoding' index: 0.
+        encoding:= self xftPatternGet: patternIdArg attribute: 'encoding' index: 0.
+        encoding notNil ifTrue:[encoding := encoding asSymbol].
+    ].
 
     "Created: / 21-12-2013 / 00:46:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
     "Modified: / 30-12-2013 / 12:49:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -724,6 +968,14 @@
     g := aColor scaledGreen.
     b := aColor scaledBlue.
     a := aColor alpha * 65535.
+    r isNil ifTrue:[
+	"/ when drawing into a pixmap...
+	aColor colorId == 0 ifTrue:[
+	    r := g := b := 0.
+	] ifFalse:[
+	    r := g := b := 16rFFFF.
+	]
+    ].
     pix := aColor colorId.
 %{
 #ifdef XFT
@@ -814,6 +1066,14 @@
     g := aColor scaledGreen.
     b := aColor scaledBlue.
     a := aColor alpha * 65535.
+    r isNil ifTrue:[
+	"/ when drawing into a pixmap...
+	aColor colorId == 0 ifTrue:[
+	    r := g := b := 0.
+	] ifFalse:[
+	    r := g := b := 16rFFFF.
+	]
+    ].
     pix := aColor colorId.
 %{
 #ifdef XFT
@@ -1339,6 +1599,24 @@
     "Created: / 21-12-2013 / 01:20:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
+getFontMetrics
+    |info|
+
+    info := DeviceWorkstation::DeviceFontMetrics new.
+    info
+      ascent:self ascent
+      descent:self descent
+      maxAscent:self maxAscent
+      maxDescent:self maxDescent
+      minWidth:self maxWidth
+      maxWidth:self maxWidth
+      avgWidth:self maxWidth
+      minCode:self minCode
+      maxCode:self maxCode
+      direction:#LeftToRight.
+    ^ info
+!
+
 height
     "return the height - the number of pixels above plus below the baseLine."
 
@@ -1386,10 +1664,26 @@
 widthOf:aString from:start to:stop
     "return the width of a sub string"
 
-    | extents |
+    |extents maxWidthOfSingleGlyph|
 
     (stop < start) ifTrue:[^ 0].
-    extents := self xftTextExtents: device displayId font: fontId string: aString from: start to: stop.
+    maxWidthOfSingleGlyph := self maxWidth.
+    "xOff from XFTTextExtents is a signed short.
+     Work arond for long strings"
+    (stop - start + 1) * maxWidthOfSingleGlyph > 32767 ifTrue:[
+        |total chunkSize|
+
+        chunkSize := (32767 // maxWidthOfSingleGlyph) - 1.
+        total := 0.
+        start to:stop by:chunkSize do:[:eachChunkStart|
+            extents := self xftTextExtents:device displayId font:fontId string:aString 
+                            from:eachChunkStart to:((eachChunkStart+chunkSize-1) min:stop).
+            "/ extents --> #(width height x y xOff yOff)
+            total := total + extents fifth.
+        ].
+        ^ total.
+    ].    
+    extents := self xftTextExtents: device displayId font:fontId string:aString from:start to:stop.
     "/ extents --> #(width height x y xOff yOff)
     ^ extents fifth.
 
@@ -1400,7 +1694,6 @@
 !XftFontDescription methodsFor:'release'!
 
 releaseDrawIfAssociatedWith: view
-
     | drawableId |
 
     view isNil ifTrue:[ ^ self ].
@@ -1408,30 +1701,360 @@
     drawableId isNil ifTrue: [ ^ self ].
 %{
 #ifdef XFT
-    XftDraw *draw;
-    if ( __INST(drawId) != nil ) {
-	if ( XftDrawDrawable ( XFT_DRAW ( __INST(drawId) ) ) == DRAWABLE( drawableId ) ) {
-	    XftDrawDestroy( XFT_DRAW( __INST(drawId) ) );
-	    __INST(drawId) = nil;
+    if ( __INST(sharedDrawId) != nil ) {
+	if (XftDrawDrawable(XFT_DRAW(__INST(sharedDrawId))) == DRAWABLE(drawableId)) {
+	    __INST(sharedDrawId) = nil;
+	    XftDrawDestroy(DRAWABLE(drawableId));
 	}
     }
-    RETURN ( self );
+    RETURN (self);
 #endif
 %}.
     self primitiveFailed
 
     "Created: / 12-01-2014 / 19:48:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
     "Modified: / 12-01-2014 / 22:09:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+releaseFromDevice
+    "I am no longer available on the device"
+
+    device := nil.
+    fontId := nil.
+    sharedDrawId := nil.
+    closestFont := nil
+! !
+
+!XftFontDescription methodsFor:'testing'!
+
+isUsed
+    ^ sharedDrawId notNil
+!
+
+isXftFont
+    ^ true
+! !
+
+!XftFontDescription::FCFontListParser class methodsFor:'documentation'!
+
+documentation
+"
+    parses fc-list output to get a list of XftFontDescriptions
+
+    [author:]
+	cg
+
+    [instance variables:]
+
+    [class variables:]
+
+    [see also:]
+
+"
+! !
+
+!XftFontDescription::FCFontListParser methodsFor:'api'!
+
+listOfAvailableFonts
+    |readEntry list l fcListProg|
+
+    list := OrderedCollection new.
+
+    readEntry :=
+	[
+	    |key|
+
+	    [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
+	].
+
+    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.
+		    ].
+
+    pipeStream := PipeStream readingFrom:fcListProg, ' -v'.
+    [
+	[pipeStream atEnd] whileFalse:[
+	    l := pipeStream nextLine.
+	    readEntry value.
+	]
+    ] ensure:[
+	pipeStream close
+    ].
+    ^ list
+
+    "
+     FCFontListParser new listOfAvailableFonts
+    "
+! !
+
+!XftFontDescription::FCFontListParser methodsFor:'font list keywords'!
+
+fc_antialias
+    "helper for font listing"
+
+    currentDescription isAntialiasedFont:(self getBoolean).
+!
+
+fc_capability
+    "helper for font listing"
+
+    "currentDescription capability:" (self getString).
+!
+
+fc_charset
+    "helper for font listing"
+
+    |page bits l min max minCode maxCode|
+
+    [ l := pipeStream nextLine. l notEmpty ] whileTrue:[
+	"/ Transcript show:'->'; showCR:l.
+	(l startsWith:Character tab) ifFalse:[
+	    (l startsWith:'(') ifFalse:[self halt].
+	    currentDescription minCode:minCode.
+	    currentDescription maxCode:maxCode.
+	    ^ self.
+	].
+
+	lineStream := l readStream.
+	lineStream skipSeparators.
+	page := Integer readFrom:(lineStream upTo:$:) radix:16.
+	lineStream next.
+	bits := 0 to:7 collect:[:i|
+	    lineStream skipSeparators.
+	    Integer readFrom:(lineStream upToSeparator) radix:16.
+	].
+	min := (page * 256 + 0).
+	max := (page * 256 + 255).
+	minCode isNil ifTrue:[
+	    minCode := min.
+	    maxCode := max.
+	] ifFalse:[
+	    minCode := minCode min:min.
+	    maxCode := maxCode max:max.
+	].
+    ].
+    "/ currentDescription characterSet:(self getString).
+    currentDescription minCode:minCode.
+    currentDescription maxCode:maxCode.
+!
+
+fc_decorative
+    "helper for font listing"
+
+    currentDescription isDecorativeFont:(self getBoolean).
+!
+
+fc_family
+    "helper for font listing"
+
+    currentDescription family:(self getString).
+!
+
+fc_familylang
+    "helper for font listing"
+
+    "currentDescription familylang:" (self getString).
+!
+
+fc_file
+    "helper for font listing"
+
+    currentDescription file:(self getString).
+!
+
+fc_fontformat
+    "helper for font listing"
+
+    currentDescription fontFormat:(self getString).
+!
+
+fc_fontversion
+    "helper for font listing"
+
+    currentDescription fontVersion:(self getInteger).
+!
+
+fc_foundry
+    "helper for font listing"
+
+    currentDescription foundry:(self getString).
+!
+
+fc_fullname
+    "helper for font listing"
+
+    "currentDescription fullname:" (self getString).
+!
+
+fc_fullnamelang
+    "helper for font listing"
+
+    "currentDescription fullnamelang:" (self getString).
+!
+
+fc_hash
+    "helper for font listing"
+
+    "currentDescription hash:" self getString.
+!
+
+fc_index
+    "helper for font listing"
+
+    "currentDescription index:" (self getInteger).
+!
+
+fc_lang
+    "helper for font listing"
+
+    "/ currentDescription characterSet:(self getString).
+!
+
+fc_outline
+    "helper for font listing"
+
+    currentDescription isOutlineFont:(self getBoolean).
+!
+
+fc_pixelsize
+    "helper for font listing"
+
+    currentDescription setPixelSize:(self getInteger).
+    currentDescription setSizeUnit:#px.
+    "/ currentDescription setSize:(self getInteger).
+    "/ currentDescription setSizeUnit:#pt.
+!
+
+fc_postscriptname
+    "helper for font listing"
+
+    "currentDescription postscriptname:" self getString.
+!
+
+fc_scalable
+    "helper for font listing"
+
+    currentDescription isScalableFont:(self getBoolean).
+!
+
+fc_slant
+    "helper for font listing"
+
+    currentDescription slant:(self getInteger).
+!
+
+fc_spacing
+    "helper for font listing"
+
+    currentDescription spacing:(self getInteger).
+!
+
+fc_style
+    "helper for font listing"
+
+    |xftStyle|
+
+    xftStyle := self getString.
+"/    ((xftStyle includesString:'Bold') or:[xftStyle includesString:'Fett']) ifTrue:[
+"/        currentDescription face:'bold'.
+"/        currentDescription style:'roman'.
+"/        ^ self.
+"/    ].
+    ((xftStyle includesString:'Italic') or:[xftStyle includesString:'Oblique']) ifTrue:[
+"/        currentDescription face:'medium'.
+	currentDescription style:'italic'.
+	^ self.
+    ].
+"/    (xftStyle includesString:'Regular') ifTrue:[
+"/        currentDescription face:'regular'.
+"/        currentDescription style:'roman'.
+"/        ^ self.
+"/    ].
+"/ self halt.
+"/    currentDescription face:'medium'.
+    currentDescription style:'roman'.
+!
+
+fc_stylelang
+    "helper for font listing"
+
+    "currentDescription stylelang:" (self getString).
+!
+
+fc_weight
+    "helper for font listing"
+
+    currentDescription weight:(self getInteger).
+!
+
+fc_width
+    "helper for font listing"
+
+    currentDescription width:(self getInteger).
+! !
+
+!XftFontDescription::FCFontListParser methodsFor:'helpers'!
+
+getBoolean
+    "helper for font listing"
+
+    |s|
+
+    lineStream skipSeparators.
+    s := lineStream nextAlphaNumericWord.
+    ^ s = 'FcTrue'.
+!
+
+getInteger
+    "helper for font listing"
+
+    lineStream skipSeparators.
+    ^ Integer readFrom:lineStream.
+!
+
+getString
+    "helper for font listing"
+
+    lineStream skipSeparators.
+    lineStream peekFor:$".
+    ^ (lineStream upTo:$").
 ! !
 
 !XftFontDescription class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview/XftFontDescription.st,v 1.25 2014-02-04 10:22:47 stefan Exp $'
+    ^ '$Header: /cvs/stx/stx/libview/XftFontDescription.st,v 1.51.2.1 2014-05-08 08:27:51 stefan Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libview/XftFontDescription.st,v 1.25 2014-02-04 10:22:47 stefan Exp $'
+    ^ '$Header: /cvs/stx/stx/libview/XftFontDescription.st,v 1.51.2.1 2014-05-08 08:27:51 stefan Exp $'
 ! !