Completed Fl_Preferences API binding

6 files changed, 1330 insertions, 338 deletions

diff --git a/doc/fl_preferences.html b/doc/fl_preferences.html
index 136ebca..37f99be 100644
--- a/doc/fl_preferences.html
+++ b/doc/fl_preferences.html
@@ -34,12 +34,22 @@
 
   <tr>
     <td>Fl_Preferences</td>
-    <td>Preferences</td>
+    <td>Database</td>
   </tr>
 
   <tr>
     <td>&nbsp;</td>
-    <td>Preferences_Reference</td>
+    <td>Database_Reference</td>
+  </tr>
+
+  <tr>
+    <td>&nbsp;</td>
+    <td>Pref_Group</td>
+  </tr>
+
+  <tr>
+    <td>&nbsp;</td>
+    <td>Pref_Group_Reference</td>
   </tr>
 
   <tr>
@@ -48,6 +58,11 @@
   </tr>
 
   <tr>
+    <td>Name</td>
+    <td>&nbsp;</td>
+  </tr>
+
+  <tr>
     <td>Root</td>
     <td>Scope</td>
   </tr>
@@ -61,6 +76,42 @@
 
 
 
+<table class="type">
+  <tr><th colspan="2">Errors</th></tr>
+
+  <tr>
+    <td>&nbsp;</td>
+    <td>Preference_Error</td>
+  </tr>
+
+</table>
+
+
+
+<table class="function">
+  <tr><th colspan="2">Static Functions and Procedures</th></tr>
+
+  <tr>
+<td><pre>
+static const char * newUUID();
+</pre></td>
+<td><pre>
+function New_UUID
+    return String;
+</pre></td>
+  </tr>
+
+  <tr>
+<td><pre>
+static char remove(ID id_);
+</pre></td>
+<td>&nbsp;</td>
+  </tr>
+
+</table>
+
+
+
 <table class="function">
   <tr><th colspan="2">Functions and Procedures</th></tr>
 
@@ -68,17 +119,23 @@
 <td><pre>
 Fl_Preferences(Root root, const char *vendor, const char *application);
 </pre></td>
-<td>TBA</td>
+<td><pre>
+function From_Scope
+       (Extent              : in Scope;
+        Vendor, Application : in String)
+    return Database;
+</pre></td>
   </tr>
 
   <tr>
 <td><pre>
-Fl_Preferences(const char *path, const char *vendor, const char *application);
+Fl_Preferences(const char *path, const char *vendor,
+    const char *application);
 </pre></td>
 <td><pre>
 function From_Filesystem
-       (Path, Vendor, Application : in String)
-    return Preferences;
+       (Directory, Vendor, Application : in String)
+    return Database;
 </pre></td>
   </tr>
 
@@ -87,7 +144,16 @@ function From_Filesystem
 Fl_Preferences(Fl_Preferences &parent, const char *group);
 Fl_Preferences(Fl_Preferences *parent, const char *group);
 </pre></td>
-<td>TBA</td>
+<td><pre>
+function By_Name
+       (From : in Pref_Group;
+        Name : in String)
+    return Pref_Group'Class;
+
+function In_Memory
+       (Name : in String)
+    return Pref_Group;
+</pre></td>
   </tr>
 
   <tr>
@@ -95,14 +161,23 @@ Fl_Preferences(Fl_Preferences *parent, const char *group);
 Fl_Preferences(Fl_Preferences &parent, int groupIndex);
 Fl_Preferences(Fl_Preferences *parent, int groupIndex);
 </pre></td>
-<td>TBA</td>
+<td><pre>
+function By_Index
+       (From  : in Pref_Group;
+        Index : in Positive)
+    return Pref_Group'Class;
+</pre></td>
   </tr>
 
   <tr>
 <td><pre>
 Fl_Preferences(const Fl_Preferences &);
 </pre></td>
-<td>TBA</td>
+<td><pre>
+function Root
+       (From : in Database)
+    return Pref_Group'Class;
+</pre></td>
   </tr>
 
   <tr>
@@ -111,7 +186,9 @@ char clear();
 </pre></td>
 <td><pre>
 procedure Clear
-       (This : in out Preferences);
+       (This : in out Pref_Group)
+with Post => This.Number_Of_Entries = 0 and
+        This.Number_Of_Groups = 0;
 </pre></td>
   </tr>
 
@@ -121,7 +198,8 @@ char deleteAllEntries();
 </pre></td>
 <td><pre>
 procedure Delete_All_Entries
-       (This : in out Preferences);
+       (This : in out Pref_Group)
+with Post => This.Number_Of_Entries = 0;
 </pre></td>
   </tr>
 
@@ -129,7 +207,11 @@ procedure Delete_All_Entries
 <td><pre>
 char deleteAllGroups();
 </pre></td>
-<td>TBA</td>
+<td><pre>
+procedure Delete_All_Groups
+       (This : in out Pref_Group)
+with Post => This.Number_Of_Groups = 0;
+</pre></td>
   </tr>
 
   <tr>
@@ -138,8 +220,9 @@ char deleteEntry(const char *entry);
 </pre></td>
 <td><pre>
 procedure Delete_Entry
-       (This : in out Preferences;
-        Key  : in     String);
+       (This : in out Pref_Group;
+        Key  : in     String)
+with Post => This.Key_Exists (Key) = False;
 </pre></td>
   </tr>
 
@@ -147,7 +230,12 @@ procedure Delete_Entry
 <td><pre>
 char deleteGroup(const char *group);
 </pre></td>
-<td>TBA</td>
+<td><pre>
+procedure Delete_Group
+       (This : in out Pref_Group;
+        Name : in     String)
+with Post => This.Group_Exists (Name) = False;
+</pre></td>
   </tr>
 
   <tr>
@@ -156,7 +244,7 @@ int entries();
 </pre></td>
 <td><pre>
 function Number_Of_Entries
-       (This : in Preferences)
+       (This : in Pref_Group)
     return Natural;
 </pre></td>
   </tr>
@@ -166,10 +254,11 @@ function Number_Of_Entries
 const char * entry(int index);
 </pre></td>
 <td><pre>
-function Get_Key
-       (This  : in Preferences;
-        Index : in Natural)
-    return String;
+function Entry_Key
+       (This  : in Pref_Group;
+        Index : in Positive)
+    return String
+with Pre => Index in 1 .. This.Number_Of_Entries;
 </pre></td>
   </tr>
 
@@ -178,8 +267,8 @@ function Get_Key
 char entryExists(const char *key);
 </pre></td>
 <td><pre>
-function Entry_Exists
-       (This : in Preferences;
+function Key_Exists
+       (This : in Pref_Group;
         Key  : in String)
     return Boolean;
 </pre></td>
@@ -191,7 +280,7 @@ void flush();
 </pre></td>
 <td><pre>
 procedure Flush
-       (This : in Preferences);
+       (This : in Database);
 </pre></td>
   </tr>
 
@@ -201,12 +290,12 @@ char get(const char *entry, int &value, int defaultValue);
 </pre></td>
 <td><pre>
 function Get
-       (This : in Preferences;
+       (This : in Pref_Group;
         Key  : in String)
     return Integer;
 
 function Get
-       (This    : in Preferences;
+       (This    : in Pref_Group;
         Key     : in String;
         Default : in Integer)
     return Integer;
@@ -219,12 +308,12 @@ char get(const char *entry, float &value, float defaultValue);
 </pre></td>
 <td><pre>
 function Get
-       (This : in Preferences;
+       (This : in Pref_Group;
         Key  : in String)
     return Float;
 
 function Get
-       (This    : in Preferences;
+       (This    : in Pref_Group;
         Key     : in String;
         Default : in Float)
     return Float;
@@ -237,12 +326,12 @@ char get(const char *entry, double &value, double defaultValue);
 </pre></td>
 <td><pre>
 function Get
-       (This : in Preferences;
+       (This : in Pref_Group;
         Key  : in String)
     return Long_Float;
 
 function Get
-       (This    : in Preferences;
+       (This    : in Pref_Group;
         Key     : in String;
         Default : in Long_Float)
     return Long_Float;
@@ -255,12 +344,12 @@ char get(const char *entry, char *&value, const char *defaultValue);
 </pre></td>
 <td><pre>
 function Get
-       (This : in Preferences;
+       (This : in Pref_Group;
         Key  : in String)
     return String;
 
 function Get
-       (This    : in Preferences;
+       (This    : in Pref_Group;
         Key     : in String;
         Default : in String)
     return String;
@@ -269,72 +358,129 @@ function Get
 
   <tr>
 <td><pre>
-char get(const char *entry, char *value, const char *defaultValue, int maxSize);
+char get(const char *entry, char *value, const char *defaultValue,
+    int maxSize);
+</pre></td>
+<td><pre>
+function Get
+       (This       : in Pref_Group;
+        Key        : in String;
+        Default    : in String;
+        Max_Length : in Natural)
+    return String
+with Post => Get'Result'Length <= Max_Length;
 </pre></td>
-<td>TBA</td>
   </tr>
 
   <tr>
 <td><pre>
-char get(const char *entry, void *&value, const void *defaultValue, int defaultSize);
+char get(const char *entry, void *&value, const void *defaultValue,
+    int defaultSize);
+</pre></td>
+<td><pre>
+function Get
+       (This : in Pref_Group;
+        Key  : in String)
+    return Binary_Data;
+
+function Get
+       (This    : in Pref_Group;
+        Key     : in String;
+        Default : in Binary_Data)
+    return Binary_Data;
 </pre></td>
-<td>TBA</td>
   </tr>
 
   <tr>
 <td><pre>
-char get(const char *entry, void *value, const void *defaultValue, int defaultSize, int maxSize);
+char get(const char *entry, void *value, const void *defaultValue,
+    int defaultSize, int maxSize);
+</pre></td>
+<td><pre>
+function Get
+       (This       : in Pref_Group;
+        Key        : in String;
+        Default    : in Binary_Data;
+        Max_Length : in Natural)
+    return Binary_Data
+with Post => Get'Result'Length <= Max_Length;
 </pre></td>
-<td>TBA</td>
   </tr>
 
   <tr>
 <td><pre>
 char getUserdataPath(char *path, int pathlen);
 </pre></td>
-<td>TBA</td>
+<td><pre>
+function Userdata_Path
+       (This : in Database)
+    return String;
+</pre></td>
   </tr>
 
   <tr>
 <td><pre>
 const char * group(int num_group);
 </pre></td>
-<td>TBA</td>
+<td><pre>
+function Group_Name
+       (This  : in Pref_Group;
+        Index : in Positive)
+    return String
+with Pre => Index in 1 .. This.Number_Of_Groups;
+</pre></td>
   </tr>
 
   <tr>
 <td><pre>
 char groupExists(const char *key);
 </pre></td>
-<td>TBA</td>
+<td><pre>
+function Group_Exists
+       (This : in Pref_Group;
+        Name : in String)
+    return Boolean;
+</pre></td>
   </tr>
 
   <tr>
 <td><pre>
 int groups();
 </pre></td>
-<td>TBA</td>
+<td><pre>
+function Number_Of_Groups
+       (This : in Pref_Group)
+    return Natural;
+</pre></td>
   </tr>
 
   <tr>
 <td><pre>
 ID id();
 </pre></td>
-<td>TBA</td>
+<td>&nbsp;</td>
   </tr>
 
   <tr>
 <td><pre>
 const char * name();
 </pre></td>
-<td>TBA</td>
+<td><pre>
+function At_Name
+       (This : in Pref_Group)
+    return String;
+</pre></td>
   </tr>
 
   <tr>
 <td><pre>
 const char * path();
 </pre></td>
-<td>TBA</td>
+<td><pre>
+function At_Path
+       (This : in Pref_Group)
+    return String;
+</pre></td>
   </tr>
 
   <tr>
@@ -343,9 +489,10 @@ char set(const char *entry, int value);
 </pre></td>
 <td><pre>
 procedure Set
-       (This  : in out Preferences;
+       (This  : in out Pref_Group;
         Key   : in     String;
-        Value : in     Integer);
+        Value : in     Integer)
+with Post => This.Key_Exists (Key);
 </pre></td>
   </tr>
 
@@ -355,9 +502,10 @@ char set(const char *entry, float value);
 </pre></td>
 <td><pre>
 procedure Set
-       (This  : in out Preferences;
+       (This  : in out Pref_Group;
         Key   : in     String;
-        Value : in     Float);
+        Value : in     Float)
+with Post => This.Key_Exists (Key);
 </pre></td>
   </tr>
 
@@ -367,10 +515,11 @@ char set(const char *entry, float value, int precision);
 </pre></td>
 <td><pre>
 procedure Set
-       (This      : in out Preferences;
+       (This      : in out Pref_Group;
         Key       : in     String;
         Value     : in     Float;
-        Precision : in     Natural);
+        Precision : in     Natural)
+with Post => This.Key_Exists (Key);
 </pre></td>
   </tr>
 
@@ -380,9 +529,10 @@ char set(const char *entry, double value);
 </pre></td>
 <td><pre>
 procedure Set
-       (This  : in out Preferences;
+       (This  : in out Pref_Group;
         Key   : in     String;
-        Value : in     Long_Float);
+        Value : in     Long_Float)
+with Post => This.Key_Exists (Key);
 </pre></td>
   </tr>
 
@@ -392,10 +542,11 @@ char set(const char *entry, double value, int precision);
 </pre></td>
 <td><pre>
 procedure Set
-       (This      : in out Preferences;
+       (This      : in out Pref_Group;
         Key       : in     String;
         Value     : in     Long_Float;
-        Precision : in     Natural);
+        Precision : in     Natural)
+with Post => This.Key_Exists (Key);
 </pre></td>
   </tr>
 
@@ -405,9 +556,10 @@ char set(const char *entry, const char *value);
 </pre></td>
 <td><pre>
 procedure Set
-       (This  : in out Preferences;
+       (This  : in out Pref_Group;
         Key   : in     String;
-        Value : in     String);
+        Value : in     String)
+with Post => This.Key_Exists (Key);
 </pre></td>
   </tr>
 
@@ -415,7 +567,13 @@ procedure Set
 <td><pre>
 char set(const char *entry, const void *value, int size);
 </pre></td>
-<td>TBA</td>
+<td><pre>
+procedure Set
+       (This  : in out Pref_Group;
+        Key   : in     String;
+        Value : in     Binary_Data)
+with Post => This.Key_Exists (Key);
+</pre></td>
   </tr>
 
   <tr>
@@ -423,27 +581,13 @@ char set(const char *entry, const void *value, int size);
 int size(const char *entry);
 </pre></td>
 <td><pre>
-function Entry_Size
-       (This : in Preferences;
+function Value_Size
+       (This : in Pref_Group;
         Key  : in String)
     return Natural;
 </pre></td>
   </tr>
 
-  <tr>
-<td><pre>
-static const char * newUUID();
-</pre></td>
-<td>TBA</td>
-  </tr>
-
-  <tr>
-<td><pre>
-static char remove(ID id_);
-</pre></td>
-<td>TBA</td>
-  </tr>
-
 </table>
 
 
diff --git a/progress.txt b/progress.txt
index 1cfb0be..c0d48f9 100644
--- a/progress.txt
+++ b/progress.txt
@@ -28,6 +28,7 @@ FLTK.Devices.Surfaces.Paged
 FLTK.Devices.Surfaces.Paged.Printers
 FLTK.Dialogs
 FLTK.Draw
+FLTK.Environment
 FLTK.Event
 FLTK.Images
 FLTK.Images.Bitmaps
@@ -125,7 +126,6 @@ Partially Done:
 
 FLTK.Devices.Graphics (incomplete API, otherwise polished)
 FLTK.Devices.Surfaces (incomplete API, otherwise polished)
-FLTK.Environment (incomplete API, otherwise polished)
 
 
 
diff --git a/src/c_fl_preferences.cpp b/src/c_fl_preferences.cpp
index 56f95ff..6f2e1ad 100644
--- a/src/c_fl_preferences.cpp
+++ b/src/c_fl_preferences.cpp
@@ -5,23 +5,121 @@
 
 
 #include <FL/Fl_Preferences.H>
+#include <FL/filename.H>
+#include <cstdlib>
 #include "c_fl_preferences.h"
 
 
 
 
-PREFS new_fl_preferences(char * p, char * v, char * a) {
-    Fl_Preferences *e = new Fl_Preferences(p,v,a);
+const int root_fl_prefs_system = Fl_Preferences::SYSTEM;
+const int root_fl_prefs_user = Fl_Preferences::USER;
+
+const int const_fl_path_max = FL_PATH_MAX;
+
+
+
+
+const char * fl_preferences_new_uuid() {
+    return Fl_Preferences::newUUID();
+}
+
+
+
+
+class My_Preferences : public Fl_Preferences {
+    public:
+        using Fl_Preferences::Fl_Preferences;
+        int reference_count = 0;
+};
+
+
+
+
+PREFS new_fl_pref_database_path(char * p, char * v, char * a) {
+    My_Preferences *e = new My_Preferences(p, v, a);
+    return e;
+}
+
+PREFS new_fl_pref_database_scope(int s, char * v, char * a) {
+    My_Preferences *e = new My_Preferences((Fl_Preferences::Root)s, v, a);
     return e;
 }
 
-void free_fl_preferences(PREFS e) {
+void upref_fl_pref_database(PREFS e) {
+    reinterpret_cast<My_Preferences*>(e)->reference_count += 1;
+}
+
+void free_fl_pref_database(PREFS e) {
+    if (reinterpret_cast<My_Preferences*>(e)->reference_count <= 0) {
+        delete reinterpret_cast<My_Preferences*>(e);
+    } else {
+        reinterpret_cast<My_Preferences*>(e)->reference_count -= 1;
+    }
+}
+
+
+PREFS new_fl_pref_group_copy(PREFS e) {
+    Fl_Preferences *g = new Fl_Preferences(reinterpret_cast<Fl_Preferences*>(e));
+    return g;
+}
+
+PREFS new_fl_pref_group_memory(char * n) {
+    Fl_Preferences *g = new Fl_Preferences(NULL, n);
+    return g;
+}
+
+PREFS new_fl_pref_group_name(PREFS e, char * n) {
+    Fl_Preferences *g = new Fl_Preferences(reinterpret_cast<Fl_Preferences*>(e), n);
+    return g;
+}
+
+PREFS new_fl_pref_group_index(PREFS e, int i) {
+    Fl_Preferences *g = new Fl_Preferences(reinterpret_cast<Fl_Preferences*>(e), i);
+    return g;
+}
+
+void free_fl_pref_group(PREFS e) {
     delete reinterpret_cast<Fl_Preferences*>(e);
 }
 
 
 
 
+void fl_preferences_flush(PREFS e) {
+    reinterpret_cast<Fl_Preferences*>(e)->flush();
+}
+
+int fl_preferences_getuserdatapath(PREFS e, char * p, int len) {
+    return (int)reinterpret_cast<Fl_Preferences*>(e)->getUserdataPath(p, len);
+}
+
+
+
+
+int fl_preferences_deleteentry(PREFS e, const char * k) {
+    return (int)reinterpret_cast<Fl_Preferences*>(e)->deleteEntry(k);
+}
+
+int fl_preferences_deleteallentries(PREFS e) {
+    return (int)reinterpret_cast<Fl_Preferences*>(e)->deleteAllEntries();
+}
+
+int fl_preferences_deletegroup(PREFS e, const char * g) {
+    return (int)reinterpret_cast<Fl_Preferences*>(e)->deleteGroup(g);
+}
+
+int fl_preferences_deleteallgroups(PREFS e) {
+    return (int)reinterpret_cast<Fl_Preferences*>(e)->deleteAllGroups();
+}
+
+int fl_preferences_clear(PREFS e) {
+    return (int)reinterpret_cast<Fl_Preferences*>(e)->clear();
+}
+
+
+
+
 int fl_preferences_entries(PREFS e) {
     return reinterpret_cast<Fl_Preferences*>(e)->entries();
 }
@@ -31,7 +129,7 @@ const char * fl_preferences_entry(PREFS e, int i) {
 }
 
 int fl_preferences_entryexists(PREFS e, const char * k) {
-    return reinterpret_cast<Fl_Preferences*>(e)->entryExists(k);
+    return (int)reinterpret_cast<Fl_Preferences*>(e)->entryExists(k);
 }
 
 int fl_preferences_size(PREFS e, const char * k) {
@@ -41,69 +139,95 @@ int fl_preferences_size(PREFS e, const char * k) {
 
 
 
-int fl_preferences_get_int(PREFS e, const char * k, int& v, int d) {
-    return reinterpret_cast<Fl_Preferences*>(e)->get(k,v,d);
+int fl_preferences_groups(PREFS e) {
+    return reinterpret_cast<Fl_Preferences*>(e)->groups();
 }
 
-int fl_preferences_get_float(PREFS e, const char * k, float& v, float d) {
-    return reinterpret_cast<Fl_Preferences*>(e)->get(k,v,d);
+const char * fl_preferences_group(PREFS e, int i) {
+    return reinterpret_cast<Fl_Preferences*>(e)->group(i);
 }
 
-int fl_preferences_get_double(PREFS e, const char * k, double& v, double d) {
-    return reinterpret_cast<Fl_Preferences*>(e)->get(k,v,d);
+int fl_preferences_groupexists(PREFS e, const char * g) {
+    return (int)reinterpret_cast<Fl_Preferences*>(e)->groupExists(g);
 }
 
-int fl_preferences_get_str(PREFS e, const char * k, char *& v, const char * d) {
-    return reinterpret_cast<Fl_Preferences*>(e)->get(k,v,d);
+
+
+
+const char * fl_preferences_name(PREFS e) {
+    return reinterpret_cast<Fl_Preferences*>(e)->name();
 }
 
+const char * fl_preferences_path(PREFS e) {
+    return reinterpret_cast<Fl_Preferences*>(e)->path();
+}
 
 
 
-int fl_preferences_set_int(PREFS e, const char * k, int v) {
-    return reinterpret_cast<Fl_Preferences*>(e)->set(k,v);
+
+int fl_preferences_get_int(PREFS e, const char * k, int& v, int d) {
+    return (int)reinterpret_cast<Fl_Preferences*>(e)->get(k,v,d);
 }
 
-int fl_preferences_set_float(PREFS e, const char * k, float v) {
-    return reinterpret_cast<Fl_Preferences*>(e)->set(k,v);
+int fl_preferences_get_float(PREFS e, const char * k, float& v, float d) {
+    return (int)reinterpret_cast<Fl_Preferences*>(e)->get(k,v,d);
 }
 
-int fl_preferences_set_float_prec(PREFS e, const char * k, float v, int p) {
-    return reinterpret_cast<Fl_Preferences*>(e)->set(k,v,p);
+int fl_preferences_get_double(PREFS e, const char * k, double& v, double d) {
+    return (int)reinterpret_cast<Fl_Preferences*>(e)->get(k,v,d);
 }
 
-int fl_preferences_set_double(PREFS e, const char * k, double v) {
-    return reinterpret_cast<Fl_Preferences*>(e)->set(k,v);
+//  must deallocate result afterwards
+int fl_preferences_get_str(PREFS e, const char * k, char *& v, const char * d) {
+    return (int)reinterpret_cast<Fl_Preferences*>(e)->get(k,v,d);
 }
 
-int fl_preferences_set_double_prec(PREFS e, const char * k, double v, int p) {
-    return reinterpret_cast<Fl_Preferences*>(e)->set(k,v,p);
+int fl_preferences_get_str_limit (PREFS e, const char * k, char * v, const char * d, int m) {
+    return (int)reinterpret_cast<Fl_Preferences*>(e)->get(k, v, d, m);
 }
 
-int fl_preferences_set_str(PREFS e, const char * k, const char * v) {
-    return reinterpret_cast<Fl_Preferences*>(e)->set(k,v);
+//  must deallocate result afterwards
+int fl_preferences_get_void (PREFS e, const char * k, void *& v, const void * d, int ds) {
+    return (int)reinterpret_cast<Fl_Preferences*>(e)->get(k, v, d, ds);
+}
+
+int fl_preferences_get_void_limit (PREFS e, const char * k, void * v, const void * d, int ds, int ms) {
+    return (int)reinterpret_cast<Fl_Preferences*>(e)->get(k, v, d, ds, ms);
 }
 
+void free_fl_preferences_void_data(void * v) {
+    free(v);
+}
 
 
 
-int fl_preferences_deleteentry(PREFS e, const char * k) {
-    return reinterpret_cast<Fl_Preferences*>(e)->deleteEntry(k);
+
+int fl_preferences_set_int(PREFS e, const char * k, int v) {
+    return (int)reinterpret_cast<Fl_Preferences*>(e)->set(k,v);
 }
 
-int fl_preferences_deleteallentries(PREFS e) {
-    return reinterpret_cast<Fl_Preferences*>(e)->deleteAllEntries();
+int fl_preferences_set_float(PREFS e, const char * k, float v) {
+    return (int)reinterpret_cast<Fl_Preferences*>(e)->set(k,v);
 }
 
-int fl_preferences_clear(PREFS e) {
-    return reinterpret_cast<Fl_Preferences*>(e)->clear();
+int fl_preferences_set_float_prec(PREFS e, const char * k, float v, int p) {
+    return (int)reinterpret_cast<Fl_Preferences*>(e)->set(k,v,p);
 }
 
+int fl_preferences_set_double(PREFS e, const char * k, double v) {
+    return (int)reinterpret_cast<Fl_Preferences*>(e)->set(k,v);
+}
 
+int fl_preferences_set_double_prec(PREFS e, const char * k, double v, int p) {
+    return (int)reinterpret_cast<Fl_Preferences*>(e)->set(k,v,p);
+}
 
+int fl_preferences_set_str(PREFS e, const char * k, const char * v) {
+    return (int)reinterpret_cast<Fl_Preferences*>(e)->set(k,v);
+}
 
-void fl_preferences_flush(PREFS e) {
-    reinterpret_cast<Fl_Preferences*>(e)->flush();
+int fl_preferences_set_void(PREFS e, const char * k, const void * d, int ds) {
+    return (int)reinterpret_cast<Fl_Preferences*>(e)->set(k, d, ds);
 }
 
 
diff --git a/src/c_fl_preferences.h b/src/c_fl_preferences.h
index 513cbe4..efc6254 100644
--- a/src/c_fl_preferences.h
+++ b/src/c_fl_preferences.h
@@ -15,22 +15,71 @@ typedef void* PREFS;
 
 
 
-extern "C" PREFS new_fl_preferences(char * p, char * v, char * a);
-extern "C" void free_fl_preferences(PREFS e);
+extern const int root_fl_prefs_system;
+extern const int root_fl_prefs_user;
 
+extern const int const_fl_path_max;
 
 
 
+
+extern "C" const char * fl_preferences_new_uuid();
+
+
+
+
+extern "C" PREFS new_fl_pref_database_path(char * p, char * v, char * a);
+extern "C" PREFS new_fl_pref_database_scope(int s, char * v, char * a);
+extern "C" void upref_fl_pref_database(PREFS e);
+extern "C" void free_fl_pref_database(PREFS e);
+
+extern "C" PREFS new_fl_pref_group_copy(PREFS e);
+extern "C" PREFS new_fl_pref_group_memory(char * n);
+extern "C" PREFS new_fl_pref_group_name(PREFS e, char * n);
+extern "C" PREFS new_fl_pref_group_index(PREFS e, int i);
+extern "C" void free_fl_pref_group(PREFS e);
+
+
+
+
+extern "C" void fl_preferences_flush(PREFS e);
+extern "C" int fl_preferences_getuserdatapath(PREFS e, char * p, int len);
+
+
+extern "C" int fl_preferences_deleteentry(PREFS e, const char * k);
+extern "C" int fl_preferences_deleteallentries(PREFS e);
+extern "C" int fl_preferences_deletegroup(PREFS e, const char * g);
+extern "C" int fl_preferences_deleteallgroups(PREFS e);
+extern "C" int fl_preferences_clear(PREFS e);
+
+
 extern "C" int fl_preferences_entries(PREFS e);
 extern "C" const char * fl_preferences_entry(PREFS e, int i);
 extern "C" int fl_preferences_entryexists(PREFS e, const char * k);
 extern "C" int fl_preferences_size(PREFS e, const char * k);
 
 
+extern "C" int fl_preferences_groups(PREFS e);
+extern "C" const char * fl_preferences_group(PREFS e, int i);
+extern "C" int fl_preferences_groupexists(PREFS e, const char * g);
+
+
+extern "C" const char * fl_preferences_name(PREFS e);
+extern "C" const char * fl_preferences_path(PREFS e);
+
+
 extern "C" int fl_preferences_get_int(PREFS e, const char * k, int& v, int d);
 extern "C" int fl_preferences_get_float(PREFS e, const char * k, float& v, float d);
 extern "C" int fl_preferences_get_double(PREFS e, const char * k, double& v, double d);
-extern "C" int fl_preferences_get_str(PREFS e, const char * k, char *& v, const char * d);
+extern "C" int fl_preferences_get_str
+    (PREFS e, const char * k, char *& v, const char * d);
+extern "C" int fl_preferences_get_str_limit
+    (PREFS e, const char * k, char * v, const char * d, int m);
+extern "C" int fl_preferences_get_void
+    (PREFS e, const char * k, void *& v, const void * d, int ds);
+extern "C" int fl_preferences_get_void_limit
+    (PREFS e, const char * k, void * v, const void * d, int ds, int ms);
+extern "C" void free_fl_preferences_void_data(void * v);
 
 
 extern "C" int fl_preferences_set_int(PREFS e, const char * k, int v);
@@ -39,14 +88,7 @@ extern "C" int fl_preferences_set_float_prec(PREFS e, const char * k, float v, i
 extern "C" int fl_preferences_set_double(PREFS e, const char * k, double v);
 extern "C" int fl_preferences_set_double_prec(PREFS e, const char * k, double v, int p);
 extern "C" int fl_preferences_set_str(PREFS e, const char * k, const char * v);
-
-
-extern "C" int fl_preferences_deleteentry(PREFS e, const char * k);
-extern "C" int fl_preferences_deleteallentries(PREFS e);
-extern "C" int fl_preferences_clear(PREFS e);
-
-
-extern "C" void fl_preferences_flush(PREFS e);
+extern "C" int fl_preferences_set_void(PREFS e, const char * k, const void * d, int ds);
 
 
 #endif
diff --git a/src/fltk-environment.adb b/src/fltk-environment.adb
index a9bfc88..c13c3ec 100644
--- a/src/fltk-environment.adb
+++ b/src/fltk-environment.adb
@@ -17,16 +17,141 @@ use type
 package body FLTK.Environment is
 
 
-    function new_fl_preferences
+    ------------------------
+    --  Constants From C  --
+    ------------------------
+
+    root_fl_prefs_system : constant Interfaces.C.int;
+    pragma Import (C, root_fl_prefs_system, "root_fl_prefs_system");
+
+    root_fl_prefs_user : constant Interfaces.C.int;
+    pragma Import (C, root_fl_prefs_user, "root_fl_prefs_user");
+
+    const_fl_path_max : constant Interfaces.C.int;
+    pragma Import (C, const_fl_path_max, "const_fl_path_max");
+
+
+
+
+    ------------------------
+    --  Functions From C  --
+    ------------------------
+
+    function fl_preferences_new_uuid
+        return Interfaces.C.Strings.chars_ptr;
+    pragma Import (C, fl_preferences_new_uuid, "fl_preferences_new_uuid");
+    pragma Inline (fl_preferences_new_uuid);
+
+
+
+
+    function new_fl_pref_database_path
            (P, V, A : in Interfaces.C.char_array)
         return Storage.Integer_Address;
-    pragma Import (C, new_fl_preferences, "new_fl_preferences");
-    pragma Inline (new_fl_preferences);
+    pragma Import (C, new_fl_pref_database_path, "new_fl_pref_database_path");
+    pragma Inline (new_fl_pref_database_path);
+
+    function new_fl_pref_database_scope
+           (S    : in Interfaces.C.int;
+            V, A : in Interfaces.C.char_array)
+        return Storage.Integer_Address;
+    pragma Import (C, new_fl_pref_database_scope, "new_fl_pref_database_scope");
+    pragma Inline (new_fl_pref_database_scope);
+
+    procedure upref_fl_pref_database
+           (P : in Storage.Integer_Address);
+    pragma Import (C, upref_fl_pref_database, "upref_fl_pref_database");
+    pragma Inline (upref_fl_pref_database);
+
+    procedure free_fl_pref_database
+           (E : in Storage.Integer_Address);
+    pragma Import (C, free_fl_pref_database, "free_fl_pref_database");
+    pragma Inline (free_fl_pref_database);
+
+
+
+
+    function new_fl_pref_group_copy
+           (D : in Storage.Integer_Address)
+        return Storage.Integer_Address;
+    pragma Import (C, new_fl_pref_group_copy, "new_fl_pref_group_copy");
+    pragma Inline (new_fl_pref_group_copy);
+
+    function new_fl_pref_group_memory
+           (N : in Interfaces.C.char_array)
+        return Storage.Integer_Address;
+    pragma Import (C, new_fl_pref_group_memory, "new_fl_pref_group_memory");
+    pragma Inline (new_fl_pref_group_memory);
 
-    procedure free_fl_preferences
+    function new_fl_pref_group_name
+           (G : in Storage.Integer_Address;
+            N : in Interfaces.C.char_array)
+        return Storage.Integer_Address;
+    pragma Import (C, new_fl_pref_group_name, "new_fl_pref_group_name");
+    pragma Inline (new_fl_pref_group_name);
+
+    function new_fl_pref_group_index
+           (G : in Storage.Integer_Address;
+            N : in Interfaces.C.int)
+        return Storage.Integer_Address;
+    pragma Import (C, new_fl_pref_group_index, "new_fl_pref_group_index");
+    pragma Inline (new_fl_pref_group_index);
+
+    procedure free_fl_pref_group
+           (G : in Storage.Integer_Address);
+    pragma Import (C, free_fl_pref_group, "free_fl_pref_group");
+    pragma Inline (free_fl_pref_group);
+
+
+
+
+    procedure fl_preferences_flush
            (E : in Storage.Integer_Address);
-    pragma Import (C, free_fl_preferences, "free_fl_preferences");
-    pragma Inline (free_fl_preferences);
+    pragma Import (C, fl_preferences_flush, "fl_preferences_flush");
+    pragma Inline (fl_preferences_flush);
+
+    function fl_preferences_getuserdatapath
+           (E : in Storage.Integer_Address;
+            P : in Interfaces.C.char_array;
+            L : in Interfaces.C.int)
+        return Interfaces.C.int;
+    pragma Import (C, fl_preferences_getuserdatapath, "fl_preferences_getuserdatapath");
+    pragma Inline (fl_preferences_getuserdatapath);
+
+
+
+
+    function fl_preferences_deleteentry
+           (E : in Storage.Integer_Address;
+            K : in Interfaces.C.char_array)
+        return Interfaces.C.int;
+    pragma Import (C, fl_preferences_deleteentry, "fl_preferences_deleteentry");
+    pragma Inline (fl_preferences_deleteentry);
+
+    function fl_preferences_deleteallentries
+           (E : in Storage.Integer_Address)
+        return Interfaces.C.int;
+    pragma Import (C, fl_preferences_deleteallentries, "fl_preferences_deleteallentries");
+    pragma Inline (fl_preferences_deleteallentries);
+
+    function fl_preferences_deletegroup
+           (P : in Storage.Integer_Address;
+            G : in Interfaces.C.char_array)
+        return Interfaces.C.int;
+    pragma Import (C, fl_preferences_deletegroup, "fl_preferences_deletegroup");
+    pragma Inline (fl_preferences_deletegroup);
+
+    function fl_preferences_deleteallgroups
+           (P : in Storage.Integer_Address)
+        return Interfaces.C.int;
+    pragma Import (C, fl_preferences_deleteallgroups, "fl_preferences_deleteallgroups");
+    pragma Inline (fl_preferences_deleteallgroups);
+
+    function fl_preferences_clear
+           (E : in Storage.Integer_Address)
+        return Interfaces.C.int;
+    pragma Import (C, fl_preferences_clear, "fl_preferences_clear");
+    pragma Inline (fl_preferences_clear);
 
 
 
@@ -61,6 +186,44 @@ package body FLTK.Environment is
 
 
 
+    function fl_preferences_groups
+           (P : in Storage.Integer_Address)
+        return Interfaces.C.int;
+    pragma Import (C, fl_preferences_groups, "fl_preferences_groups");
+    pragma Inline (fl_preferences_groups);
+
+    function fl_preferences_group
+           (P : in Storage.Integer_Address;
+            N : in Interfaces.C.int)
+        return Interfaces.C.Strings.chars_ptr;
+    pragma Import (C, fl_preferences_group, "fl_preferences_group");
+    pragma Inline (fl_preferences_group);
+
+    function fl_preferences_groupexists
+           (P : in Storage.Integer_Address;
+            G : in Interfaces.C.char_array)
+        return Interfaces.C.int;
+    pragma Import (C, fl_preferences_groupexists, "fl_preferences_groupexists");
+    pragma Inline (fl_preferences_groupexists);
+
+
+
+
+    function fl_preferences_name
+           (P : in Storage.Integer_Address)
+        return Interfaces.C.Strings.chars_ptr;
+    pragma Import (C, fl_preferences_name, "fl_preferences_name");
+    pragma Inline (fl_preferences_name);
+
+    function fl_preferences_path
+           (P : in Storage.Integer_Address)
+        return Interfaces.C.Strings.chars_ptr;
+    pragma Import (C, fl_preferences_path, "fl_preferences_path");
+    pragma Inline (fl_preferences_path);
+
+
+
+
     function fl_preferences_get_int
            (E : in     Storage.Integer_Address;
             K : in     Interfaces.C.char_array;
@@ -97,6 +260,40 @@ package body FLTK.Environment is
     pragma Import (C, fl_preferences_get_str, "fl_preferences_get_str");
     pragma Inline (fl_preferences_get_str);
 
+    function fl_preferences_get_str_limit
+           (E : in Storage.Integer_Address;
+            K : in Interfaces.C.char_array;
+            V : in Interfaces.C.char_array;
+            D : in Interfaces.C.char_array;
+            M : in Interfaces.C.int)
+        return Interfaces.C.int;
+    pragma Import (C, fl_preferences_get_str_limit, "fl_preferences_get_str_limit");
+    pragma Inline (fl_preferences_get_str_limit);
+
+    function fl_preferences_get_void
+           (E  : in     Storage.Integer_Address;
+            K  : in     Interfaces.C.char_array;
+            V  :    out Storage.Integer_Address;
+            D  : in     Storage.Integer_Address;
+            DS : in     Interfaces.C.int)
+        return Interfaces.C.int;
+    pragma Import (C, fl_preferences_get_void, "fl_preferences_get_void");
+    pragma Inline (fl_preferences_get_void);
+
+    function fl_preferences_get_void_limit
+           (E      : in Storage.Integer_Address;
+            K      : in Interfaces.C.char_array;
+            V, D   : in Storage.Integer_Address;
+            DS, MS : in Interfaces.C.int)
+        return Interfaces.C.int;
+    pragma Import (C, fl_preferences_get_void_limit, "fl_preferences_get_void_limit");
+    pragma Inline (fl_preferences_get_void_limit);
+
+    procedure free_fl_preferences_void_data
+           (V : in Storage.Integer_Address);
+    pragma Import (C, free_fl_preferences_void_data, "free_fl_preferences_void_data");
+    pragma Inline (free_fl_preferences_void_data);
+
 
 
 
@@ -150,119 +347,382 @@ package body FLTK.Environment is
     pragma Import (C, fl_preferences_set_str, "fl_preferences_set_str");
     pragma Inline (fl_preferences_set_str);
 
+    function fl_preferences_set_void
+           (E  : in Storage.Integer_Address;
+            K  : in Interfaces.C.char_array;
+            D  : in Storage.Integer_Address;
+            DS : in Interfaces.C.int)
+        return Interfaces.C.int;
+    pragma Import (C, fl_preferences_set_void, "fl_preferences_set_void");
+    pragma Inline (fl_preferences_set_void);
 
 
 
-    function fl_preferences_deleteentry
-           (E : in Storage.Integer_Address;
-            K : in Interfaces.C.char_array)
-        return Interfaces.C.int;
-    pragma Import (C, fl_preferences_deleteentry, "fl_preferences_deleteentry");
-    pragma Inline (fl_preferences_deleteentry);
 
-    function fl_preferences_deleteallentries
-           (E : in Storage.Integer_Address)
-        return Interfaces.C.int;
-    pragma Import (C, fl_preferences_deleteallentries, "fl_preferences_deleteallentries");
-    pragma Inline (fl_preferences_deleteallentries);
+    ------------------------
+    --  Internal Utility  --
+    ------------------------
 
-    function fl_preferences_clear
-           (E : in Storage.Integer_Address)
-        return Interfaces.C.int;
-    pragma Import (C, fl_preferences_clear, "fl_preferences_clear");
-    pragma Inline (fl_preferences_clear);
+    function To_Cint
+           (Extent : in Scope)
+        return Interfaces.C.int is
+    begin
+        case Extent is
+        when Global =>
+            return root_fl_prefs_system;
+        when User =>
+            return root_fl_prefs_user;
+        end case;
+    end To_Cint;
+
+    function To_Scope
+           (Num : in Interfaces.C.int)
+        return Scope is
+    begin
+        if Num = root_fl_prefs_system then
+            return Global;
+        elsif Num = root_fl_prefs_user then
+            return User;
+        else
+            raise Constraint_Error;
+        end if;
+    end To_Scope;
 
 
 
 
-    procedure fl_preferences_flush
-           (E : in Storage.Integer_Address);
-    pragma Import (C, fl_preferences_flush, "fl_preferences_flush");
-    pragma Inline (fl_preferences_flush);
-
+    -----------------------------------
+    --  Controlled Type Subprograms  --
+    -----------------------------------
 
+    procedure Finalize
+           (This : in out Database) is
+    begin
+        if  This.Void_Ptr /= Null_Pointer and then
+            This in Database'Class
+        then
+            free_fl_pref_database (This.Void_Ptr);
+            This.Void_Ptr := Null_Pointer;
+        end if;
+        Finalize (Wrapper (This));
+    end Finalize;
 
 
     procedure Finalize
-           (This : in out Preferences) is
+           (This : in out Pref_Group) is
     begin
         if  This.Void_Ptr /= Null_Pointer and then
-            This in Preferences'Class
+            This in Pref_Group'Class
         then
-            free_fl_preferences (This.Void_Ptr);
+            free_fl_pref_group (This.Void_Ptr);
+            if This.Root_Ptr /= Null_Pointer then
+                free_fl_pref_database (This.Root_Ptr);
+                This.Root_Ptr := Null_Pointer;
+            end if;
             This.Void_Ptr := Null_Pointer;
         end if;
+        Finalize (Wrapper (This));
     end Finalize;
 
 
 
 
+    -----------------------
+    --  Preferences API  --
+    -----------------------
+
+    function New_UUID
+        return String
+    is
+        Text : Interfaces.C.Strings.chars_ptr := fl_preferences_new_uuid;
+    begin
+        return Interfaces.C.Strings.Value (Text);
+    end New_UUID;
+
+
+
+
     package body Forge is
 
+
         function From_Filesystem
-               (Path, Vendor, Application : in String)
-            return Preferences is
+               (Directory, Vendor, Application : in String)
+            return Database is
         begin
-            return This : Preferences do
-                This.Void_Ptr := new_fl_preferences
-                   (Interfaces.C.To_C (Path),
+            return This : Database do
+                This.Void_Ptr := new_fl_pref_database_path
+                   (Interfaces.C.To_C (Directory),
                     Interfaces.C.To_C (Vendor),
                     Interfaces.C.To_C (Application));
             end return;
         end From_Filesystem;
 
+
+        function From_Scope
+               (Extent              : in Scope;
+                Vendor, Application : in String)
+            return Database is
+        begin
+            return This : Database do
+                This.Void_Ptr := new_fl_pref_database_scope
+                   (To_Cint (Extent),
+                    Interfaces.C.To_C (Vendor),
+                    Interfaces.C.To_C (Application));
+            end return;
+        end From_Scope;
+
+
+        function Root
+               (From : in Database)
+            return Pref_Group'Class is
+        begin
+            return Result : Pref_Group do
+                Result.Void_Ptr := new_fl_pref_group_copy (From.Void_Ptr);
+                Result.Root_Ptr := From.Void_Ptr;
+                upref_fl_pref_database (Result.Root_Ptr);
+            end return;
+        end Root;
+
+
+        function In_Memory
+               (Name : in String)
+            return Pref_Group is
+        begin
+            return Result : Pref_Group do
+                Result.Void_Ptr := new_fl_pref_group_memory (Interfaces.C.To_C (Name));
+                Result.Root_Ptr := Null_Pointer;
+            end return;
+        end In_Memory;
+
+
+        function By_Name
+               (From : in Pref_Group;
+                Name : in String)
+            return Pref_Group'Class is
+        begin
+            return Result : Pref_Group do
+                Result.Void_Ptr := new_fl_pref_group_name
+                   (From.Void_Ptr,
+                    Interfaces.C.To_C (Name));
+                Result.Root_Ptr := From.Root_Ptr;
+                if Result.Root_Ptr /= Null_Pointer then
+                    upref_fl_pref_database (Result.Root_Ptr);
+                end if;
+            end return;
+        end By_Name;
+
+
+        function By_Index
+               (From  : in Pref_Group;
+                Index : in Positive)
+            return Pref_Group'Class is
+        begin
+            return Result : Pref_Group do
+                Result.Void_Ptr := new_fl_pref_group_index
+                   (From.Void_Ptr,
+                    Interfaces.C.int (Index - 1));
+                Result.Root_Ptr := From.Root_Ptr;
+                if Result.Root_Ptr /= Null_Pointer then
+                    upref_fl_pref_database (Result.Root_Ptr);
+                end if;
+            end return;
+        end By_Index;
+
+
     end Forge;
 
 
 
 
+    procedure Flush
+           (This : in Database) is
+    begin
+        fl_preferences_flush (This.Void_Ptr);
+    end Flush;
+
+
+    function Userdata_Path
+           (This : in Database)
+        return String
+    is
+        Buffer : Interfaces.C.char_array :=
+            (1 .. Interfaces.C.size_t (const_fl_path_max + 1) => ' ');
+    begin
+        if fl_preferences_getuserdatapath
+           (This.Void_Ptr,
+            Buffer,
+            const_fl_path_max) = 0
+        then
+            raise Preference_Error;
+        end if;
+        return Interfaces.C.To_Ada (Buffer);
+    end Userdata_Path;
+
+
+
+
+    procedure Delete_Entry
+           (This : in out Pref_Group;
+            Key  : in     String) is
+    begin
+        if fl_preferences_deleteentry (This.Void_Ptr, Interfaces.C.To_C (Key)) = 0 then
+            raise Preference_Error;
+        end if;
+    end Delete_Entry;
+
+
+    procedure Delete_All_Entries
+           (This : in out Pref_Group) is
+    begin
+        if fl_preferences_deleteallentries (This.Void_Ptr) = 0 then
+            raise Preference_Error;
+        end if;
+    end Delete_All_Entries;
+
+
+    procedure Delete_Group
+           (This : in out Pref_Group;
+            Name : in     String) is
+    begin
+        if fl_preferences_deletegroup (This.Void_Ptr, Interfaces.C.To_C (Name)) = 0 then
+            raise Preference_Error;
+        end if;
+    end Delete_Group;
+
+
+    procedure Delete_All_Groups
+           (This : in out Pref_Group) is
+    begin
+        if fl_preferences_deleteallgroups (This.Void_Ptr) = 0 then
+            raise Preference_Error;
+        end if;
+    end Delete_All_Groups;
+
+
+    procedure Clear
+           (This : in out Pref_Group) is
+    begin
+        if fl_preferences_clear (This.Void_Ptr) = 0 then
+            raise Preference_Error;
+        end if;
+    end Clear;
+
+
+
+
     function Number_Of_Entries
-           (This : in Preferences)
+           (This : in Pref_Group)
         return Natural is
     begin
         return Natural (fl_preferences_entries (This.Void_Ptr));
     end Number_Of_Entries;
 
 
-    function Get_Key
-           (This  : in Preferences;
-            Index : in Natural)
+    function Entry_Key
+           (This  : in Pref_Group;
+            Index : in Positive)
         return String
     is
         Key : Interfaces.C.Strings.chars_ptr :=
-            fl_preferences_entry (This.Void_Ptr, Interfaces.C.int (Index));
+            fl_preferences_entry (This.Void_Ptr, Interfaces.C.int (Index) - 1);
     begin
         --  no need for dealloc?
         if Key = Interfaces.C.Strings.Null_Ptr then
-            raise Constraint_Error;
+            raise Preference_Error;
         else
             return Interfaces.C.Strings.Value (Key);
         end if;
-    end Get_Key;
+    end Entry_Key;
 
 
-    function Entry_Exists
-           (This : in Preferences;
+    function Key_Exists
+           (This : in Pref_Group;
             Key  : in String)
         return Boolean is
     begin
         return fl_preferences_entryexists (This.Void_Ptr, Interfaces.C.To_C (Key)) /= 0;
-    end Entry_Exists;
+    end Key_Exists;
 
 
-    function Entry_Size
-           (This : in Preferences;
+    function Value_Size
+           (This : in Pref_Group;
             Key  : in String)
         return Natural is
     begin
         return Natural (fl_preferences_size (This.Void_Ptr, Interfaces.C.To_C (Key)));
-    end Entry_Size;
+    end Value_Size;
+
+
+
+
+    function Number_Of_Groups
+           (This : in Pref_Group)
+        return Natural is
+    begin
+        return Natural (fl_preferences_groups (This.Void_Ptr));
+    end Number_Of_Groups;
+
+
+    function Group_Name
+           (This  : in Pref_Group;
+            Index : in Positive)
+        return String
+    is
+        Name : Interfaces.C.Strings.chars_ptr :=
+            fl_preferences_group (This.Void_Ptr, Interfaces.C.int (Index) - 1);
+    begin
+        --  no need for dealloc?
+        if Name = Interfaces.C.Strings.Null_Ptr then
+            raise Preference_Error;
+        else
+            return Interfaces.C.Strings.Value (Name);
+        end if;
+    end Group_Name;
+
+
+    function Group_Exists
+           (This : in Pref_Group;
+            Name : in String)
+        return Boolean is
+    begin
+        return fl_preferences_groupexists (This.Void_Ptr, Interfaces.C.To_C (Name)) /= 0;
+    end Group_Exists;
+
+
+
+
+    function At_Name
+           (This : in Pref_Group)
+        return String
+    is
+        Text : Interfaces.C.Strings.chars_ptr := fl_preferences_name (This.Void_Ptr);
+    begin
+        if Text = Interfaces.C.Strings.Null_Ptr then
+            return "";
+        else
+            return Interfaces.C.Strings.Value (Text);
+        end if;
+    end At_Name;
+
+
+    function At_Path
+           (This : in Pref_Group)
+        return String
+    is
+        Text : Interfaces.C.Strings.chars_ptr := fl_preferences_path (This.Void_Ptr);
+    begin
+        if Text = Interfaces.C.Strings.Null_Ptr then
+            return "";
+        else
+            return Interfaces.C.Strings.Value (Text);
+        end if;
+    end At_Path;
 
 
 
 
     function Get
-           (This : in Preferences;
+           (This : in Pref_Group;
             Key  : in String)
         return Integer
     is
@@ -280,7 +740,24 @@ package body FLTK.Environment is
 
 
     function Get
-           (This : in Preferences;
+           (This    : in Pref_Group;
+            Key     : in String;
+            Default : in Integer)
+        return Integer
+    is
+        Value, X : Interfaces.C.int;
+    begin
+        X := fl_preferences_get_int
+           (This.Void_Ptr,
+            Interfaces.C.To_C (Key),
+            Value,
+            Interfaces.C.int (Default));
+        return Integer (Value);
+    end Get;
+
+
+    function Get
+           (This : in Pref_Group;
             Key  : in String)
         return Float
     is
@@ -298,7 +775,25 @@ package body FLTK.Environment is
 
 
     function Get
-           (This : in Preferences;
+           (This    : in Pref_Group;
+            Key     : in String;
+            Default : in Float)
+        return Float
+    is
+        Value : Interfaces.C.C_float;
+        X : Interfaces.C.int;
+    begin
+        X := fl_preferences_get_float
+           (This.Void_Ptr,
+            Interfaces.C.To_C (Key),
+            Value,
+            Interfaces.C.C_float (Default));
+        return Float (Value);
+    end Get;
+
+
+    function Get
+           (This : in Pref_Group;
             Key  : in String)
         return Long_Float
     is
@@ -316,118 +811,172 @@ package body FLTK.Environment is
 
 
     function Get
-           (This : in Preferences;
+           (This    : in Pref_Group;
+            Key     : in String;
+            Default : in Long_Float)
+        return Long_Float
+    is
+        Value : Interfaces.C.double;
+        X : Interfaces.C.int;
+    begin
+        X := fl_preferences_get_double
+           (This.Void_Ptr,
+            Interfaces.C.To_C (Key),
+            Value,
+            Interfaces.C.double (Default));
+        return Long_Float (Value);
+    end Get;
+
+
+    function Get
+           (This : in Pref_Group;
             Key  : in String)
         return String
     is
-        Value : Interfaces.C.Strings.chars_ptr;
+        Text : Interfaces.C.Strings.chars_ptr;
         Check : Interfaces.C.int := fl_preferences_get_str
            (This.Void_Ptr,
             Interfaces.C.To_C (Key),
-            Value,
+            Text,
             Interfaces.C.To_C ("default"));
     begin
         if Check = 0 then
             raise Preference_Error;
         end if;
-        if Value = Interfaces.C.Strings.Null_Ptr then
+        if Text = Interfaces.C.Strings.Null_Ptr then
             return "";
-        else
-            declare
-                Str : String := Interfaces.C.Strings.Value (Value);
-            begin
-                Interfaces.C.Strings.Free (Value);
-                return Str;
-            end;
         end if;
+        return Str : String := Interfaces.C.Strings.Value (Text) do
+            Interfaces.C.Strings.Free (Text);
+        end return;
     end Get;
 
 
-
-
     function Get
-           (This    : in Preferences;
+           (This    : in Pref_Group;
             Key     : in String;
-            Default : in Integer)
-        return Integer
+            Default : in String)
+        return String
     is
-        Value, X : Interfaces.C.int;
-    begin
-        X := fl_preferences_get_int
+        Text : Interfaces.C.Strings.chars_ptr;
+        X : Interfaces.C.int := fl_preferences_get_str
            (This.Void_Ptr,
             Interfaces.C.To_C (Key),
-            Value,
-            Interfaces.C.int (Default));
-        return Integer (Value);
+            Text,
+            Interfaces.C.To_C (Default));
+    begin
+        if Text = Interfaces.C.Strings.Null_Ptr then
+            return Default;
+        end if;
+        return Str : String := Interfaces.C.Strings.Value (Text) do
+            Interfaces.C.Strings.Free (Text);
+        end return;
     end Get;
 
 
     function Get
-           (This    : in Preferences;
-            Key     : in String;
-            Default : in Float)
-        return Float
+           (This       : in Pref_Group;
+            Key        : in String;
+            Default    : in String;
+            Max_Length : in Natural)
+        return String
     is
-        Value : Interfaces.C.C_float;
-        X : Interfaces.C.int;
+        Text : Interfaces.C.char_array := (1 .. Interfaces.C.size_t (Max_Length + 1) => ' ');
+        Check : Interfaces.C.int := fl_preferences_get_str_limit
+           (This.Void_Ptr,
+            Interfaces.C.To_C (Key),
+            Text,
+            Interfaces.C.To_C (Default),
+            Interfaces.C.int (Max_Length));
     begin
-        X := fl_preferences_get_float
+        if Check = 0 then
+            return Default;
+        else
+            return Interfaces.C.To_Ada (Text);
+        end if;
+    end Get;
+
+
+    function Get
+           (This : in Pref_Group;
+            Key  : in String)
+        return Binary_Data
+    is
+        Thing : Storage.Integer_Address;
+        Dummy : Interfaces.C.int := 42;
+        Check : Interfaces.C.int := fl_preferences_get_void
            (This.Void_Ptr,
             Interfaces.C.To_C (Key),
-            Value,
-            Interfaces.C.C_float (Default));
-        return Float (Value);
+            Thing,
+            Storage.To_Integer (Dummy'Address),
+            1);
+    begin
+        if Check = 0 then
+            free_fl_preferences_void_data (Thing);
+            raise Preference_Error;
+        end if;
+        declare
+            Length : Natural := This.Value_Size (Key) * Natural (c_pointer_size);
+            Actual : Binary_Data (1 .. Length);
+            for Actual'Address use Storage.To_Address (Thing);
+            pragma Import (Ada, Actual);
+        begin
+            return Result : Binary_Data := Actual do
+                free_fl_preferences_void_data (Thing);
+            end return;
+        end;
     end Get;
 
 
     function Get
-           (This    : in Preferences;
+           (This    : in Pref_Group;
             Key     : in String;
-            Default : in Long_Float)
-        return Long_Float
+            Default : in Binary_Data)
+        return Binary_Data
     is
-        Value : Interfaces.C.double;
-        X : Interfaces.C.int;
-    begin
-        X := fl_preferences_get_double
+        Thing  : Storage.Integer_Address;
+        Ignore : Interfaces.C.int := fl_preferences_get_void
            (This.Void_Ptr,
             Interfaces.C.To_C (Key),
-            Value,
-            Interfaces.C.double (Default));
-        return Long_Float (Value);
+            Thing,
+            Storage.To_Integer (Default'Address),
+            Default'Length / Interfaces.C.int (c_pointer_size));
+        Length : Natural := This.Value_Size (Key) * Natural (c_pointer_size);
+        Actual : Binary_Data (1 .. Length);
+        for Actual'Address use Storage.To_Address (Thing);
+        pragma Import (Ada, Actual);
+    begin
+        return Result : Binary_Data := Actual do
+            free_fl_preferences_void_data (Thing);
+        end return;
     end Get;
 
 
     function Get
-           (This    : in Preferences;
-            Key     : in String;
-            Default : in String)
-        return String
+           (This       : in Pref_Group;
+            Key        : in String;
+            Default    : in Binary_Data;
+            Max_Length : in Natural)
+        return Binary_Data
     is
-        Value : Interfaces.C.Strings.chars_ptr;
-        X : Interfaces.C.int := fl_preferences_get_str
+        Actual : Binary_Data (1 .. Max_Length);
+        Ignore : Interfaces.C.int := fl_preferences_get_void_limit
            (This.Void_Ptr,
             Interfaces.C.To_C (Key),
-            Value,
-            Interfaces.C.To_C (Default));
+            Storage.To_Integer (Actual'Address),
+            Storage.To_Integer (Default'Address),
+            Default'Length / Interfaces.C.int (c_pointer_size),
+            Interfaces.C.int (Max_Length) / Interfaces.C.int (c_pointer_size));
+        Length : Natural := This.Value_Size (Key) * Natural (c_pointer_size);
     begin
-        if Value = Interfaces.C.Strings.Null_Ptr then
-            return "";
-        else
-            declare
-                Str : String := Interfaces.C.Strings.Value (Value);
-            begin
-                Interfaces.C.Strings.Free (Value);
-                return Str;
-            end;
-        end if;
+        return Actual (1 .. Length);
     end Get;
 
 
 
 
     procedure Set
-           (This  : in out Preferences;
+           (This  : in out Pref_Group;
             Key   : in     String;
             Value : in     Integer) is
     begin
@@ -442,7 +991,7 @@ package body FLTK.Environment is
 
 
     procedure Set
-           (This  : in out Preferences;
+           (This  : in out Pref_Group;
             Key   : in     String;
             Value : in     Float) is
     begin
@@ -457,7 +1006,7 @@ package body FLTK.Environment is
 
 
     procedure Set
-           (This      : in out Preferences;
+           (This      : in out Pref_Group;
             Key       : in     String;
             Value     : in     Float;
             Precision : in     Natural) is
@@ -474,7 +1023,7 @@ package body FLTK.Environment is
 
 
     procedure Set
-           (This  : in out Preferences;
+           (This  : in out Pref_Group;
             Key   : in     String;
             Value : in     Long_Float) is
     begin
@@ -489,7 +1038,7 @@ package body FLTK.Environment is
 
 
     procedure Set
-           (This      : in out Preferences;
+           (This      : in out Pref_Group;
             Key       : in     String;
             Value     : in     Long_Float;
             Precision : in     Natural) is
@@ -506,7 +1055,7 @@ package body FLTK.Environment is
 
 
     procedure Set
-           (This  : in out Preferences;
+           (This  : in out Pref_Group;
             Key   : in     String;
             Value : in     String) is
     begin
@@ -520,43 +1069,20 @@ package body FLTK.Environment is
     end Set;
 
 
-
-
-    procedure Delete_Entry
-           (This : in out Preferences;
-            Key  : in     String) is
-    begin
-        if fl_preferences_deleteentry (This.Void_Ptr, Interfaces.C.To_C (Key)) = 0 then
-            raise Preference_Error;
-        end if;
-    end Delete_Entry;
-
-
-    procedure Delete_All_Entries
-           (This : in out Preferences) is
-    begin
-        if fl_preferences_deleteallentries (This.Void_Ptr) = 0 then
-            raise Preference_Error;
-        end if;
-    end Delete_All_Entries;
-
-
-    procedure Clear
-           (This : in out Preferences) is
+    procedure Set
+           (This  : in out Pref_Group;
+            Key   : in     String;
+            Value : in     Binary_Data) is
     begin
-        if fl_preferences_clear (This.Void_Ptr) = 0 then
+        if fl_preferences_set_void
+           (This.Void_Ptr,
+            Interfaces.C.To_C (Key),
+            Storage.To_Integer (Value'Address),
+            Value'Length / Interfaces.C.int (c_pointer_size)) = 0
+        then
             raise Preference_Error;
         end if;
-    end Clear;
-
-
-
-
-    procedure Flush
-           (This : in Preferences) is
-    begin
-        fl_preferences_flush (This.Void_Ptr);
-    end Flush;
+    end Set;
 
 
 end FLTK.Environment;
diff --git a/src/fltk-environment.ads b/src/fltk-environment.ads
index 4eed857..132e610 100644
--- a/src/fltk-environment.ads
+++ b/src/fltk-environment.ads
@@ -4,15 +4,31 @@
 --  Released into the public domain
 
 
+with
+
+    Interfaces;
+
+private with
+
+    Interfaces.C;
+
+
 package FLTK.Environment is
 
 
-    type Preferences is new Wrapper with private;
+    type Database is new Wrapper with private;
+
+    type Database_Reference (Data : not null access Database'Class) is
+        limited null record with Implicit_Dereference => Data;
+
+    type Pref_Group is new Wrapper with private;
 
-    type Preferences_Reference (Data : not null access Preferences'Class) is
+    type Pref_Group_Reference (Data : not null access Pref_Group'Class) is
         limited null record with Implicit_Dereference => Data;
 
-    type Scope is (Root, User);
+    type Scope is (Global, User);
+
+    type Binary_Data is array (Positive range <>) of Interfaces.Unsigned_8;
 
 
 
@@ -22,169 +38,309 @@ package FLTK.Environment is
 
 
 
+    function New_UUID
+        return String;
+
+
+
+
     package Forge is
 
         function From_Filesystem
-               (Path, Vendor, Application : in String)
-            return Preferences;
+               (Directory, Vendor, Application : in String)
+            return Database;
+
+        function From_Scope
+               (Extent              : in Scope;
+                Vendor, Application : in String)
+            return Database;
+
+        function Root
+               (From : in Database)
+            return Pref_Group'Class;
+
+        function In_Memory
+               (Name : in String)
+            return Pref_Group;
+
+        function By_Name
+               (From : in Pref_Group;
+                Name : in String)
+            return Pref_Group'Class;
+
+        function By_Index
+               (From  : in Pref_Group;
+                Index : in Positive)
+            return Pref_Group'Class;
 
     end Forge;
 
 
 
 
+    procedure Flush
+           (This : in Database);
+
+    function Userdata_Path
+           (This : in Database)
+        return String;
+
+
+
+
+    procedure Delete_Entry
+           (This : in out Pref_Group;
+            Key  : in     String)
+    with Post => This.Key_Exists (Key) = False;
+
+    procedure Delete_All_Entries
+           (This : in out Pref_Group)
+    with Post => This.Number_Of_Entries = 0;
+
+    procedure Delete_Group
+           (This : in out Pref_Group;
+            Name : in     String)
+    with Post => This.Group_Exists (Name) = False;
+
+    procedure Delete_All_Groups
+           (This : in out Pref_Group)
+    with Post => This.Number_Of_Groups = 0;
+
+    procedure Clear
+           (This : in out Pref_Group)
+    with Post => This.Number_Of_Entries = 0 and
+            This.Number_Of_Groups = 0;
+
+
+
+
     function Number_Of_Entries
-           (This : in Preferences)
+           (This : in Pref_Group)
         return Natural;
 
-    function Get_Key
-           (This  : in Preferences;
-            Index : in Natural)
-        return String;
+    function Entry_Key
+           (This  : in Pref_Group;
+            Index : in Positive)
+        return String
+    with Pre => Index in 1 .. This.Number_Of_Entries;
 
-    function Entry_Exists
-           (This : in Preferences;
+    function Key_Exists
+           (This : in Pref_Group;
             Key  : in String)
         return Boolean;
 
-    function Entry_Size
-           (This : in Preferences;
+    function Value_Size
+           (This : in Pref_Group;
             Key  : in String)
         return Natural;
 
 
 
 
-    function Get
-           (This : in Preferences;
-            Key  : in String)
-        return Integer;
+    function Number_Of_Groups
+           (This : in Pref_Group)
+        return Natural;
 
-    function Get
-           (This : in Preferences;
-            Key  : in String)
-        return Float;
+    function Group_Name
+           (This  : in Pref_Group;
+            Index : in Positive)
+        return String
+    with Pre => Index in 1 .. This.Number_Of_Groups;
 
-    function Get
-           (This : in Preferences;
-            Key  : in String)
-        return Long_Float;
+    function Group_Exists
+           (This : in Pref_Group;
+            Name : in String)
+        return Boolean;
 
-    function Get
-           (This : in Preferences;
-            Key  : in String)
+
+
+
+    function At_Name
+           (This : in Pref_Group)
+        return String;
+
+    function At_Path
+           (This : in Pref_Group)
         return String;
 
 
 
 
     function Get
-           (This    : in Preferences;
+           (This : in Pref_Group;
+            Key  : in String)
+        return Integer;
+
+    function Get
+           (This    : in Pref_Group;
             Key     : in String;
             Default : in Integer)
         return Integer;
 
     function Get
-           (This    : in Preferences;
+           (This : in Pref_Group;
+            Key  : in String)
+        return Float;
+
+    function Get
+           (This    : in Pref_Group;
             Key     : in String;
             Default : in Float)
         return Float;
 
     function Get
-           (This    : in Preferences;
+           (This : in Pref_Group;
+            Key  : in String)
+        return Long_Float;
+
+    function Get
+           (This    : in Pref_Group;
             Key     : in String;
             Default : in Long_Float)
         return Long_Float;
 
     function Get
-           (This    : in Preferences;
+           (This : in Pref_Group;
+            Key  : in String)
+        return String;
+
+    function Get
+           (This    : in Pref_Group;
             Key     : in String;
             Default : in String)
         return String;
 
+    function Get
+           (This       : in Pref_Group;
+            Key        : in String;
+            Default    : in String;
+            Max_Length : in Natural)
+        return String
+    with Post => Get'Result'Length <= Max_Length;
+
+    function Get
+           (This : in Pref_Group;
+            Key  : in String)
+        return Binary_Data;
+
+    function Get
+           (This    : in Pref_Group;
+            Key     : in String;
+            Default : in Binary_Data)
+        return Binary_Data;
+
+    function Get
+           (This       : in Pref_Group;
+            Key        : in String;
+            Default    : in Binary_Data;
+            Max_Length : in Natural)
+        return Binary_Data
+    with Post => Get'Result'Length <= Max_Length;
+
 
 
 
     procedure Set
-           (This  : in out Preferences;
+           (This  : in out Pref_Group;
             Key   : in     String;
-            Value : in     Integer);
+            Value : in     Integer)
+    with Post => This.Key_Exists (Key);
 
     procedure Set
-           (This  : in out Preferences;
+           (This  : in out Pref_Group;
             Key   : in     String;
-            Value : in     Float);
+            Value : in     Float)
+    with Post => This.Key_Exists (Key);
 
     procedure Set
-           (This      : in out Preferences;
+           (This      : in out Pref_Group;
             Key       : in     String;
             Value     : in     Float;
-            Precision : in     Natural);
+            Precision : in     Natural)
+    with Post => This.Key_Exists (Key);
 
     procedure Set
-           (This  : in out Preferences;
+           (This  : in out Pref_Group;
             Key   : in     String;
-            Value : in     Long_Float);
+            Value : in     Long_Float)
+    with Post => This.Key_Exists (Key);
 
     procedure Set
-           (This      : in out Preferences;
+           (This      : in out Pref_Group;
             Key       : in     String;
             Value     : in     Long_Float;
-            Precision : in     Natural);
+            Precision : in     Natural)
+    with Post => This.Key_Exists (Key);
 
     procedure Set
-           (This  : in out Preferences;
+           (This  : in out Pref_Group;
             Key   : in     String;
-            Value : in     String);
-
-
+            Value : in     String)
+    with Post => This.Key_Exists (Key);
 
+    procedure Set
+           (This  : in out Pref_Group;
+            Key   : in     String;
+            Value : in     Binary_Data)
+    with Post => This.Key_Exists (Key);
 
-    procedure Delete_Entry
-           (This : in out Preferences;
-            Key  : in     String);
 
-    procedure Delete_All_Entries
-           (This : in out Preferences);
-
-    procedure Clear
-           (This : in out Preferences);
+private
 
 
+    type Database is new Wrapper with null record;
 
+    overriding procedure Finalize
+           (This : in out Database);
 
-    procedure Flush
-           (This : in Preferences);
 
+    type Pref_Group is new Wrapper with record
+        Root_Ptr : Storage.Integer_Address;
+    end record;
 
-private
+    overriding procedure Finalize
+           (This : in out Pref_Group);
 
 
-    type Preferences is new Wrapper with null record;
+    pragma Convention (C, Binary_Data);
+    pragma Pack (Binary_Data);
+    for Binary_Data'Component_Size use Interfaces.C.CHAR_BIT;
 
-    overriding procedure Finalize
-           (This : in out Preferences);
 
+    pragma Inline (New_UUID);
 
+    pragma Inline (Flush);
 
+    pragma Inline (Delete_Entry);
+    pragma Inline (Delete_All_Entries);
+    pragma Inline (Delete_Group);
+    pragma Inline (Delete_All_Groups);
+    pragma Inline (Clear);
 
     pragma Inline (Number_Of_Entries);
-    pragma Inline (Get_Key);
-    pragma Inline (Entry_Exists);
-    pragma Inline (Entry_Size);
+    pragma Inline (Entry_Key);
+    pragma Inline (Key_Exists);
+    pragma Inline (Value_Size);
 
+    pragma Inline (Number_Of_Groups);
+    pragma Inline (Group_Name);
+    pragma Inline (Group_Exists);
 
-    pragma Inline (Get);
-    pragma Inline (Set);
+    pragma Inline (At_Name);
+    pragma Inline (At_Path);
 
+    pragma Inline (Set);
 
-    pragma Inline (Delete_Entry);
-    pragma Inline (Delete_All_Entries);
-    pragma Inline (Clear);
 
+    function To_Cint
+           (Extent : in Scope)
+        return Interfaces.C.int;
 
-    pragma Inline (Flush);
+    function To_Scope
+           (Num : in Interfaces.C.int)
+        return Scope;
 
 
 end FLTK.Environment;
 
+