--- a/Font.st	Fri May 07 14:03:59 2004 +0200
+++ b/Font.st	Fri May 07 14:18:59 2004 +0200
@@ -341,22 +341,32 @@
     "create a new Font representing the same font as
      myself on aDevice; if one already exists, return the one."
 
-    |newFont rep|
+    |newFont rep nearestFont|
 
     "if I am already assigned to that device ..."
     (device == aDevice) ifTrue:[^ self].
 
     aDevice isNil ifTrue:[^ self].
-        
+
+
     "first look if not already there"
     aDevice deviceFonts do:[:aFont |
-        (size == aFont size) ifTrue:[
-            (family = aFont family) ifTrue:[
-                (face = aFont face) ifTrue:[
-                    (style = aFont style) ifTrue:[
-                        (encoding isNil or:[encoding == aFont encoding]) ifTrue:[
+        (family = aFont family) ifTrue:[
+            (face = aFont face) ifTrue:[
+                (style = aFont style) ifTrue:[
+                    (encoding isNil or:[encoding == aFont encoding]) ifTrue:[
+                        (size == aFont size) ifTrue:[
                             ^ aFont
-                        ]
+                        ].
+                        nearestFont isNil ifTrue:[
+                            "font exists, but has different size,
+                             remember the font with the nearest size"
+                            nearestFont = aFont.
+                        ] ifFalse:[
+                            ((nearestFont size - size) abs > (aFont size - size) abs) ifTrue:[
+                                nearestFont := aFont.
+                            ].
+                        ].
                     ]
                 ]
             ]
@@ -403,7 +413,7 @@
      myself on aDevice. This does NOT try to look for existing
      or replacement fonts (i.e. can be used to get physical fonts)."
 
-    | id|
+    |id|
 
     "receiver was not associated - do it now"
     device isNil ifTrue:[
@@ -432,27 +442,46 @@
      an image is restored on another type of display, or one which has
      a different set of fonts."
 
-    |id f alternative|
+    |id f alternative trySize|
+
+    "try font with smaller size"
 
-    alternative := Replacements at:family ifAbsent:nil.
-    alternative notNil ifTrue:[
-        id := aDevice getFontWithFamily:alternative
+    trySize := size - 1.
+    [
+        id := aDevice getFontWithFamily:family
                                    face:face
                                   style:style 
-                                   size:size
+                                   size:trySize
                                encoding:encoding.
-    ].
+    ] doWhile:[id isNil and:[trySize := trySize - 1. trySize > 4]].
+
     id notNil ifTrue:[
-        ('Font [info]: use alternative for ' , (self userFriendlyName)) infoPrintCR.
+        ('Font [info]: use alternative size ', trySize printString, ' for ' , (self userFriendlyName)) infoPrintCR.
     ] ifFalse:[
-        id := aDevice getDefaultFont.
-        ('Font [info]: use default for ' , (self userFriendlyName)) infoPrintCR.
+        alternative := Replacements at:family ifAbsent:nil.
+        alternative notNil ifTrue:[
+            trySize := size - 1.
+            [
+                id := aDevice getFontWithFamily:alternative
+                                           face:face
+                                          style:style 
+                                           size:trySize
+                                       encoding:encoding.
+            ] doWhile:[id isNil and:[trySize := trySize - 1. trySize > 4]].
+        ].
+        id notNil ifTrue:[
+            ('Font [info]: use alternative for ' , (self userFriendlyName)) infoPrintCR.
+        ] ifFalse:[
+            id := aDevice getDefaultFont.
+            ('Font [info]: use default for ' , (self userFriendlyName)) infoPrintCR.
+        ].
+        id isNil ifTrue:[
+            "oops did not work - this is a serious an error"
+            self error:'cannot get default font' mayProceed:true.
+            ^ nil
+        ].
     ].
-    id isNil ifTrue:[
-        "oops did not work - this is a serious an error"
-        self error:'cannot get default font' mayProceed:true.
-        ^ nil
-    ].
+
     f := self class basicNew.
     f setDevice:aDevice fontId:id.
     f getFontInfos.
@@ -1123,7 +1152,7 @@
 !Font class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview/Font.st,v 1.93 2004-04-06 20:18:50 stefan Exp $'
+    ^ '$Header: /cvs/stx/stx/libview/Font.st,v 1.94 2004-05-07 12:18:59 stefan Exp $'
 ! !
 
 Font initialize!