summaryrefslogtreecommitdiff
path: root/src/fltk-environment.ads
diff options
context:
space:
mode:
Diffstat (limited to 'src/fltk-environment.ads')
-rw-r--r--src/fltk-environment.ads296
1 files changed, 226 insertions, 70 deletions
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;
+