--- a/UserPreferences.st	Tue Oct 06 11:05:30 2015 +0200
+++ b/UserPreferences.st	Tue Oct 06 22:32:50 2015 +0200
@@ -1876,6 +1876,87 @@
     "Modified: / 11.9.1998 / 00:09:59 / cg"
 !
 
+fontPreferences
+    "experimental"
+
+    ^ self at:#fontPreferences
+
+    "
+     UserPreferences current fontPreferences
+     UserPreferences current fontPreferences:nil
+    "
+!
+
+fontPreferences:aDictionary
+    "experimental"
+
+    |fn getFont|
+    
+    self at:#fontPreferences put:aDictionary.
+
+    aDictionary isNil ifTrue:[^ self].
+
+    getFont := 
+        [:key|
+            |s fn|
+            
+            s := aDictionary at:key ifAbsent:nil.
+            s notNil ifTrue:[
+                fn := Font readFrom:s.
+                self useXftFontsOnly ifTrue:[
+                    fn := XftFontDescription for:fn
+                ]    
+            ].
+            fn
+        ].
+    
+    fn := getFont value:#Other.
+    fn notNil ifTrue:[    
+        SimpleView withAllSubclasses do:[:cls | cls defaultFont:fn].
+    ].
+    
+    fn := getFont value:#Label.
+    fn notNil ifTrue:[    
+        Label defaultFont:fn.
+        CheckBox defaultFont:fn.
+    ].
+    
+    fn := getFont value:#Button.
+    fn notNil ifTrue:[    
+        Button defaultFont:fn.
+        Toggle defaultFont:fn.
+    ].
+    
+    fn := getFont value:#Text.
+    fn notNil ifTrue:[    
+        TextView withAllSubclasses do:[:cls | cls defaultFont:fn].
+    ].
+    
+    fn := getFont value:#InputField.
+    fn notNil ifTrue:[    
+        EditField withAllSubclasses do:[:cls | cls defaultFont:fn].
+    ].
+    
+    fn := getFont value:#List.
+    fn notNil ifTrue:[    
+        SelectionInListView withAllSubclasses do:[:cls | cls defaultFont:fn].
+    ].
+    
+    fn := getFont value:#Tooltip.
+    fn notNil ifTrue:[    
+        ActiveHelpView withAllSubclasses do:[:cls | cls defaultFont:fn].
+    ].
+    
+    fn := getFont value:#Menu.
+    fn notNil ifTrue:[    
+        ListView defaultFont:fn.
+        MenuView defaultFont:fn.
+        MenuPanel defaultFont:fn.
+        NoteBookView defaultFont:fn.
+        PullDownMenu defaultFont:fn.
+    ].
+!
+
 forceWindowsIntoMonitorBounds
     "if true, windows are forced to be placed into a monitor's bounds completely;
      if false, they may be placed as to cross a boundary. This only affects initial placement,