--- a/XftFontDescription.st	Wed Jan 01 19:24:58 2014 +0100
+++ b/XftFontDescription.st	Thu Jan 02 23:54:56 2014 +0100
@@ -1,7 +1,7 @@
 "{ Package: 'stx:libview' }"
 
 FontDescription subclass:#XftFontDescription
-	instanceVariableNames:'device fontId drawId'
+	instanceVariableNames:'device fontId drawId closestFont'
 	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
@@ -321,6 +321,22 @@
     "Created: / 30-12-2013 / 19:49:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
+!XftFontDescription methodsFor:'accessing-private'!
+
+getDevice
+
+    ^ device
+
+    "Created: / 02-01-2014 / 23:22:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+getFontId
+
+    ^ fontId
+
+    "Created: / 02-01-2014 / 23:29:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
 !XftFontDescription methodsFor:'displaying'!
 
 displayString:aString from:index1 to:index2 x:x y:y in:aGC opaque:opaque
@@ -381,12 +397,17 @@
         ^ self
     ].
 
+    (closestFont notNil and:[closestFont getDevice == aGraphicsDevice]) ifTrue:[
+        ^ closestFont onDevice: aGraphicsDevice.
+    ].
+
     aGraphicsDevice deviceFonts do:[:aFont |
         (self sameDeviceFontAs:aFont) ifTrue:[
             ^ aFont
         ].
     ].
 
+
     [
         myPatternId := self xftPatternCreate.
         self xftPatternAdd: myPatternId attribute: FC_FAMILY  value: family.
@@ -403,10 +424,9 @@
             "/ Good, this font exist!!
             fontId := newFontId.
             device := aGraphicsDevice.
-            self shouldImplement. "/ Register font...
+            aGraphicsDevice registerFont:self.
             ^ self.
         ] ifFalse:[
-            | family size |
             closestPatternId1 := self xftFontMatch: aGraphicsDevice displayId screen: aGraphicsDevice screen pattern: myPatternId.
             closestPatternId1 isNil ifTrue:[
                 self error: 'No font matches'.
@@ -422,9 +442,21 @@
             newFontId isNil ifTrue:[
                 self error: 'Pattern matched, but font could be open (should not happen)'.
             ].
-            ^ self class new
-                setDevice: aGraphicsDevice patternId: closestPatternId2 fontId: newFontId;
-                yourself.
+            "/ 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 class new
+                                setDevice: aGraphicsDevice patternId: closestPatternId2 fontId: newFontId;
+                                yourself.
+            aGraphicsDevice registerFont: closestFont.
+            ^ closestFont
         ].
     ] ensure:[
         self xftPatternDestroy: myPatternId.
@@ -437,17 +469,17 @@
     "
 
     "Modified: / 14-04-1997 / 18:22:31 / cg"
-    "Modified: / 30-12-2013 / 12:41:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 02-01-2014 / 23:43:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
-onDevice:aDevice ifAbsent:exceptionBlock
+onDevice:aWorkstation ifAbsent:aBlock
     "Create a new XftFont representing the same font as
-     myself on aDevice. This does NOT try to look for existing
+     myself on aWorkstation. This does NOT try to look for existing
      or replacement fonts (i.e. can be used to get physical fonts)."
 
-    ^ self shouldImplement
+    self shouldImplement
 
-    "Modified: / 20-12-2013 / 10:54:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 02-01-2014 / 23:15:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !XftFontDescription methodsFor:'initialization'!
@@ -1230,11 +1262,11 @@
 !XftFontDescription class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview/XftFontDescription.st,v 1.11 2014-01-01 18:24:58 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libview/XftFontDescription.st,v 1.12 2014-01-02 22:54:56 vrany Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libview/XftFontDescription.st,v 1.11 2014-01-01 18:24:58 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libview/XftFontDescription.st,v 1.12 2014-01-02 22:54:56 vrany Exp $'
 ! !