mirror of
https://github.com/moparisthebest/Simba
synced 2024-11-11 03:45:06 -05:00
650 lines
14 KiB
ObjectPascal
650 lines
14 KiB
ObjectPascal
{
|
|
This file is part of the Mufasa Macro Library (MML)
|
|
Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
|
|
|
|
MML is free software: you can redistribute it and/or modify
|
|
it under the terms of the GNU General Public License as published by
|
|
the Free Software Foundation, either version 3 of the License, or
|
|
(at your option) any later version.
|
|
|
|
MML is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with MML. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
See the file COPYING, included in this distribution,
|
|
for details about the copyright.
|
|
|
|
Settings class for Mufasa Macro Library
|
|
}
|
|
|
|
unit settings;
|
|
|
|
{$mode objfpc}{$M+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, ComCtrls, xmlread, xmlwrite, DOM,mufasatypes,MufasaBase;
|
|
|
|
|
|
|
|
type
|
|
TSettingData = class(TObject)
|
|
public
|
|
Val: String;
|
|
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
|
|
end;
|
|
|
|
{
|
|
TMMLSettings; class to manage settings with XML.
|
|
Features:
|
|
- Loading and Saving to XML.
|
|
- Showing the settings as a tree.
|
|
- Changing, Creating settings. (No Deleting yet.)
|
|
- Bad naming conventions.
|
|
Bugs:
|
|
- Don't use '/' as a *name* for a node. It WILL fuck up.
|
|
It is no problem in values, but in NAMES for nodes, it will
|
|
simply not work.
|
|
- Poor naming.
|
|
}
|
|
|
|
TMMLSettings = class(TObject)
|
|
|
|
public
|
|
constructor Create(aNodes: TTreeNodes);
|
|
destructor Destroy; override;
|
|
|
|
private
|
|
Nodes: TTreeNodes;
|
|
function KeyNameToKeys(KeyName: String): TStringArray;
|
|
function WalkToNode(KeyName: String): TTreeNode;
|
|
|
|
procedure InternalLoadFromXML(XMLDoc: TXMLDocument);
|
|
procedure WriteXMLData(n: TTreeNode;
|
|
XMLNode: TDOMNode; XMLDoc: TXMLDocument;
|
|
var XMLChild: TDOMNode; var C: Integer);
|
|
procedure WalkTree(Node: TTreeNode; XMLNode: TDOMNode; XMLDoc: TXMLDocument;
|
|
var C: Integer);
|
|
|
|
public
|
|
function GetNodePath(Node: TTreeNode): String;
|
|
function ListKeys(KeyName: String): TStringArray;
|
|
|
|
function KeyExists(KeyName: String): Boolean;
|
|
function IsKey(KeyName: String): Boolean;
|
|
function IsDirectory(KeyName: String): Boolean;
|
|
|
|
function DeleteKey(KeyName: String): Boolean;
|
|
function DeleteSubKeys(KeyName: String): Boolean;
|
|
|
|
procedure SetKeyValue(KeyName: String; KeyValue: String);
|
|
function CreateKey(KeyName: String; CreatePath: Boolean = False): Boolean;
|
|
function GetKeyValue(KeyName: String): String;
|
|
|
|
// Horrible name
|
|
function GetSetDefaultKeyValue(KeyName, defVal: String): String;
|
|
private
|
|
// /facepalm
|
|
function GetSetLoadSaveDefaultKeyValue(KeyName, defVal, fileName: String): String;
|
|
public
|
|
// AAAAAAAAAAAHG??
|
|
function GetSetLoadSaveDefaultKeyValueIfNotExists(KeyName, defVal, fileName: String): String;
|
|
|
|
public
|
|
procedure LoadFromXML(fileName: String);
|
|
procedure SaveToXML(fileName: String);
|
|
|
|
end;
|
|
|
|
implementation
|
|
uses
|
|
stringutil;
|
|
|
|
constructor TSettingData.Create;
|
|
begin
|
|
inherited;
|
|
Val := '';
|
|
end;
|
|
|
|
destructor TSettingData.Destroy;
|
|
begin
|
|
Val := '';
|
|
inherited;
|
|
end;
|
|
|
|
|
|
constructor TMMLSettings.Create(aNodes: TTreeNodes);
|
|
begin
|
|
Self.Nodes := aNodes;
|
|
end;
|
|
|
|
destructor TMMLSettings.Destroy;
|
|
var
|
|
i : integer;
|
|
begin
|
|
for i := 0 to Nodes.Count - 1 do
|
|
if Nodes[i].data <> nil then
|
|
TSettingData(Nodes[i].Data).Free;
|
|
Nodes := nil;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
procedure TMMLSettings.InternalLoadFromXML(XMLDoc: TXMLDocument);
|
|
var
|
|
iNode: TDOMNode;
|
|
|
|
procedure ProcessNode(Node: TDOMNode; TreeNode: TTreeNode);
|
|
var
|
|
cNode: TDOMNode;
|
|
s: string;
|
|
d: TSettingData;
|
|
|
|
begin
|
|
if Node = nil then Exit; // Stops if reached a leaf
|
|
|
|
// Adds a node to the tree
|
|
s := Node.NodeName;
|
|
|
|
TreeNode := Nodes.AddChild(TreeNode, s);
|
|
if (Node.NodeType = 3) then
|
|
begin
|
|
d := TSettingData.Create;
|
|
D.Val := Node.NodeValue;
|
|
TreeNode.Data := D;
|
|
|
|
TreeNode.Text := Node.NodeValue;
|
|
end;
|
|
// Goes to the child node
|
|
cNode := Node.FirstChild;
|
|
|
|
// Processes all child nodes
|
|
while cNode <> nil do
|
|
begin
|
|
ProcessNode(cNode, TreeNode);
|
|
cNode := cNode.NextSibling;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
iNode := XMLDoc.DocumentElement;
|
|
if iNode.NodeName = 'Simba' then
|
|
iNode := iNode.ChildNodes[0];
|
|
while iNode <> nil do
|
|
begin
|
|
ProcessNode(iNode, nil); // Recursive
|
|
iNode := iNode.NextSibling;
|
|
end;
|
|
end;
|
|
|
|
function TMMLSettings.KeyNameToKeys(KeyName: String): TStringArray;
|
|
begin
|
|
Result := Explode('/',KeyName);
|
|
end;
|
|
|
|
function TMMLSettings.WalkToNode(KeyName: String): TTreeNode;
|
|
var
|
|
N: TTreeNode;
|
|
i: Integer;
|
|
S: TStringArray;
|
|
begin
|
|
Result := nil;
|
|
|
|
if KeyName[length(KeyName)]='/' then setlength(KeyName,length(KeyName)-1);
|
|
S := KeyNameToKeys(KeyName);
|
|
|
|
if not assigned(s) then
|
|
Exit(nil);
|
|
|
|
N := Nodes.GetFirstNode;
|
|
i := 0;
|
|
while N <> nil do
|
|
begin
|
|
if N.Text = s[i] then
|
|
begin
|
|
inc(i);
|
|
if i = length(s) then
|
|
break;
|
|
N := N.GetFirstChild;
|
|
end else
|
|
N := N.GetNextSibling;
|
|
end;
|
|
Result := N;
|
|
end;
|
|
|
|
{
|
|
Return the "path" of the given Node.
|
|
The node should be in Nodes. (TreeView.Items)
|
|
}
|
|
|
|
function TMMLSettings.GetNodePath(Node: TTreeNode): String;
|
|
var
|
|
N: TTreeNode;
|
|
s: TStringArray;
|
|
i: Integer;
|
|
begin
|
|
if Node = nil then
|
|
Exit('');
|
|
|
|
N := Node;
|
|
setlength(s, 0);
|
|
while N <> nil do
|
|
begin
|
|
setlength(s,length(s) + 1);
|
|
s[high(s)] := N.Text;
|
|
N := N.Parent;
|
|
end;
|
|
|
|
result := '';
|
|
for i := high(s) downto 0 do
|
|
result := result + s[i] + '/';
|
|
if length(result) > 1 then
|
|
setlength(result,length(result)-1);
|
|
end;
|
|
|
|
{
|
|
Equivalent to 'ls' or 'dir'. It lists the keys in a certain key (directory)
|
|
}
|
|
|
|
function TMMLSettings.ListKeys(KeyName: String): TStringArray;
|
|
var
|
|
N: TTreeNode;
|
|
begin
|
|
SetLength(Result, 0);
|
|
N := WalkToNode(KeyName);
|
|
if N <> nil then
|
|
N := N.GetFirstChild;
|
|
|
|
while N <> nil do
|
|
begin
|
|
setlength(result,length(result)+1);
|
|
result[high(result)] := N.Text;
|
|
N := N.GetNextSibling;
|
|
end;
|
|
end;
|
|
|
|
{
|
|
Return wether the given key exists or not
|
|
}
|
|
|
|
function TMMLSettings.KeyExists(KeyName: String): Boolean;
|
|
|
|
begin
|
|
Result := WalkToNode(KeyName) <> nil;
|
|
end;
|
|
|
|
{
|
|
Return wether the given key is a key. (again, bad naming)
|
|
What I mean is, a 'key' only has a 'Value', which a 'directory key' has other
|
|
keys (or none) as childs.
|
|
}
|
|
|
|
function TMMLSettings.IsKey(KeyName: String): Boolean;
|
|
var
|
|
N: TTreeNode;
|
|
|
|
begin
|
|
N := WalkToNode(KeyName);
|
|
if N = nil then
|
|
Exit(False);
|
|
|
|
n := N.GetFirstChild;
|
|
while n <> nil do
|
|
begin
|
|
if n.HasChildren then
|
|
exit(false);
|
|
n := N.GetNextSibling;
|
|
end;
|
|
exit(true);
|
|
end;
|
|
|
|
{
|
|
Perhaps this should just do Exit(not IsKey(KeyName))
|
|
}
|
|
|
|
function TMMLSettings.IsDirectory(KeyName: String): Boolean;
|
|
var
|
|
N: TTreeNode;
|
|
begin
|
|
N := WalkToNode(KeyName);
|
|
if N <> nil then
|
|
Exit(N.HasChildren);
|
|
Exit(False);
|
|
end;
|
|
|
|
{
|
|
Get the value of a Key. (String)
|
|
}
|
|
|
|
function TMMLSettings.GetKeyValue(KeyName: String): String;
|
|
var
|
|
N: TTreeNode;
|
|
begin
|
|
if not KeyExists(KeyName) then
|
|
Exit('');
|
|
N := WalkToNode(KeyName);
|
|
if N <> nil then
|
|
N := N.GetFirstChild;
|
|
while N <> nil do
|
|
begin
|
|
if assigned(n.Data) then
|
|
begin
|
|
Exit(TSettingData(n.Data).Val);
|
|
end;
|
|
N := N.GetNextSibling;
|
|
end;
|
|
Exit('');
|
|
end;
|
|
|
|
{
|
|
If the key exists - return the value.
|
|
If it does not exist, create the key - with a possible path, set it to
|
|
defVal and return defVal.
|
|
}
|
|
|
|
function TMMLSettings.GetSetDefaultKeyValue(KeyName, defVal: String): String;
|
|
var
|
|
Res: String;
|
|
begin
|
|
if not IsKey(KeyName) then
|
|
begin
|
|
CreateKey(KeyName, True);
|
|
SetKeyValue(KeyName, defVal);
|
|
exit(defVal);
|
|
end;
|
|
Res := GetKeyValue(KeyName);
|
|
if Res = '' then
|
|
begin
|
|
SetKeyValue(KeyName, defVal);
|
|
exit(defVal);
|
|
end;
|
|
Exit(Res);
|
|
end;
|
|
|
|
function TMMLSettings.DeleteKey(KeyName: String): Boolean;
|
|
var
|
|
Node, C: TTreeNode;
|
|
begin
|
|
if not isKey(KeyName) and not IsDirectory(KeyName) then
|
|
exit(false);
|
|
Node := WalkToNode(KeyName);
|
|
|
|
if Node = nil then // This should not happen
|
|
exit;
|
|
|
|
C := Node.GetFirstChild;
|
|
if C = nil then
|
|
begin
|
|
TSettingData(Node.Data).Free;
|
|
Node.Delete;
|
|
exit;
|
|
end;
|
|
|
|
While C <> nil do
|
|
begin
|
|
TSettingData(C.Data).Free;
|
|
C := C.GetNextSibling;
|
|
end;
|
|
Node.DeleteChildren;
|
|
|
|
TSettingData(Node.Data).Free;
|
|
Node.Delete;
|
|
end;
|
|
|
|
function TMMLSettings.DeleteSubKeys(KeyName: String): Boolean;
|
|
var
|
|
Node, C: TTreeNode;
|
|
begin
|
|
if not isKey(KeyName) and not IsDirectory(KeyName) then
|
|
exit(false);
|
|
Node := WalkToNode(KeyName);
|
|
if Node = nil then // This should not happen
|
|
exit;
|
|
|
|
C := Node.GetFirstChild;
|
|
While C <> nil do
|
|
begin
|
|
TSettingData(C.Data).Free;
|
|
C := C.GetNextSibling;
|
|
end;
|
|
|
|
Node.DeleteChildren;
|
|
end;
|
|
|
|
{
|
|
Clear the entire tree. Load from fileName. call GetSetDefaultKeyValue.
|
|
}
|
|
|
|
function TMMLSettings.GetSetLoadSaveDefaultKeyValue(KeyName, defVal, fileName: String): String;
|
|
begin
|
|
Nodes.Clear;
|
|
LoadFromXML(fileName);
|
|
Result := GetSetDefaultKeyValue(KeyName, defVal);
|
|
SaveToXML(fileName);
|
|
end;
|
|
|
|
{
|
|
If Key exists, call getSetDefaultKeyValue, else call GetSetLoadSaveDefaultKeyValue
|
|
}
|
|
function TMMLSettings.GetSetLoadSaveDefaultKeyValueIfNotExists(KeyName, defVal, fileName: String): String;
|
|
begin
|
|
if KeyExists(KeyName) then
|
|
Exit(GetSetDefaultKeyValue(KeyName, defVal))
|
|
else
|
|
Exit(GetSetLoadSaveDefaultKeyValue(KeyName, defVal, fileName));
|
|
end;
|
|
|
|
{
|
|
Create the given key. If CreatePath = true, then create every key that is
|
|
required to create the key. (Say KeyName = 'a/b/c/d/e' and only key a exists,
|
|
and CreatePath = True, then b,c,d and e are all created.
|
|
}
|
|
|
|
function TMMLSettings.CreateKey(KeyName: String; CreatePath: Boolean = False): Boolean;
|
|
var
|
|
N, newN, nParent: TTreeNode;
|
|
Path: TStringArray;
|
|
NewPath: String;
|
|
i: Integer;
|
|
|
|
begin
|
|
if KeyExists(KeyName) then
|
|
begin
|
|
Exit(False);
|
|
end;
|
|
NewPath := '';
|
|
N := nil;
|
|
Path := KeyNameToKeys(KeyName);
|
|
|
|
if length(path) < 2 then
|
|
begin
|
|
mDebugLn('CreateKey - Path too short!');
|
|
exit(false);
|
|
end;
|
|
nParent := WalkToNode(path[0]);
|
|
if nParent = nil then
|
|
nParent := Nodes.Add(nil,path[0]);
|
|
{ if path[0] <> nParent.Text then
|
|
begin
|
|
writeln('First key doesn''t match. First key should always match');
|
|
exit(false);
|
|
end;}
|
|
for i := 0 to length(Path) - 2 do
|
|
begin
|
|
if Path[i] = '' then
|
|
begin
|
|
mDebugLn('CreateKey - Invalid Key Path / Name');
|
|
exit(false);
|
|
end;
|
|
NewPath := NewPath + Path[i] + '/';
|
|
N := WalkToNode(NewPath);
|
|
|
|
if (N = nil) and (not CreatePath) then
|
|
exit(false);
|
|
|
|
if (N = nil) and CreatePath then
|
|
begin
|
|
newN := TTreeNode.Create(Nodes);
|
|
newN.Text := Path[i];
|
|
if (nParent = nil) then
|
|
begin
|
|
mDebugLn('CreateKey - This shouldn''t happen...');
|
|
newN.MoveTo(Nodes.GetFirstNode, naAddChild);
|
|
nParent := newN;
|
|
end
|
|
else
|
|
begin
|
|
newN.MoveTo(nParent, naAddChild);
|
|
nParent := newN;
|
|
end;
|
|
end;
|
|
|
|
if N <> nil then
|
|
nParent := N;
|
|
end;
|
|
|
|
if nParent = nil then
|
|
exit(false);
|
|
|
|
newN := TTreeNode.Create(Nodes);
|
|
newN.Text := Path[High(Path)];
|
|
newN.MoveTo(nParent, naAddChild);
|
|
end;
|
|
|
|
{
|
|
Set the value of a key.
|
|
}
|
|
|
|
procedure TMMLSettings.SetKeyValue(KeyName: String; KeyValue: String);
|
|
var
|
|
N, NN: TTreeNode;
|
|
begin
|
|
if not KeyExists(KeyName) then
|
|
begin
|
|
mDebugLn('SetKeyValue - Key does not exist');
|
|
Exit;
|
|
end;
|
|
if not IsKey(KeyName) then
|
|
begin
|
|
mDebugLn('SetKeyValue - IsKey returned false');
|
|
Exit;
|
|
end;
|
|
N := WalkToNode(KeyName);
|
|
|
|
if not N.HasChildren then
|
|
begin
|
|
NN := TTreeNode.Create(Nodes);
|
|
NN.Text := KeyValue;
|
|
NN.MoveTo(N, naAddChild);
|
|
end;
|
|
|
|
if n <> nil then
|
|
N := N.GetFirstChild;
|
|
while N <> nil do
|
|
begin
|
|
if Assigned(N.Data) then
|
|
TSettingData(N.Data).Free;
|
|
N.Data := TSettingData.Create;
|
|
TSettingData(N.Data).Val := KeyValue;
|
|
mDebugLn('Setting ' + KeyName + ' to ' + KeyValue);
|
|
N := N.GetNextSibling;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ load from xml }
|
|
procedure TMMLSettings.LoadFromXML(fileName: String);
|
|
var
|
|
Doc: TXMLDocument;
|
|
begin
|
|
Nodes.Clear;
|
|
if not fileExists(fileName) then
|
|
begin
|
|
mDebugLn('SettingsFile hasn''t been created yet.');
|
|
// create file.
|
|
SaveToXML(fileName);
|
|
end;
|
|
ReadXMLFile(Doc, fileName);
|
|
InternalLoadFromXML(Doc);
|
|
Doc.Free;
|
|
end;
|
|
|
|
procedure TMMLSettings.WriteXMLData(n: TTreeNode;
|
|
XMLNode: TDOMNode; XMLDoc: TXMLDocument;
|
|
var XMLChild: TDOMNode; var C: Integer);
|
|
begin
|
|
if assigned(n.data) and (n.HasChildren) then
|
|
mDebugLn('WriteXMLData - Has data and children! Please close simba and remove settings.xml. if problem persists, please report your settings.xml');
|
|
if assigned(n.Data) then
|
|
begin
|
|
XMLChild := XMLDoc.CreateTextNode(TSettingData(N.Data).Val);
|
|
end else
|
|
begin
|
|
XMLChild := XMLDoc.CreateElement(n.Text);
|
|
end;
|
|
Inc(C);
|
|
XMLNode.AppendChild(XMLChild);
|
|
end;
|
|
|
|
procedure TMMLSettings.WalkTree(Node: TTreeNode; XMLNode: TDOMNode; XMLDoc: TXMLDocument;
|
|
var C: Integer);
|
|
var
|
|
N: TTreeNode;
|
|
XMLChild: TDOMNode;
|
|
|
|
begin
|
|
N := Node.GetFirstChild;
|
|
|
|
while assigned(n) do
|
|
begin
|
|
WriteXMLData(n, XMLNode, XMLDoc, XMLChild, C);
|
|
|
|
WalkTree(n, XMLChild, XMLDoc, C);
|
|
n := n.GetNextSibling;
|
|
end;
|
|
end;
|
|
|
|
{ save to xml }
|
|
|
|
procedure TMMLSettings.SaveToXML(fileName: String);
|
|
var
|
|
XMLDoc: TXMLDocument;
|
|
Simba,DOMNode: TDOMNode;
|
|
TreeNode : TTreeNode;
|
|
C: Integer;
|
|
begin
|
|
XMLDoc := TXMLDocument.Create;
|
|
|
|
C := 0;
|
|
|
|
Simba := XMLDoc.CreateElement('Simba');
|
|
Simba := XMLDoc.AppendChild(Simba);
|
|
|
|
TreeNode := Nodes.GetFirstNode;
|
|
while TreeNode <> nil do
|
|
begin;
|
|
DOMNode := XMLDoc.CreateElement(TreeNode.Text);
|
|
Simba.AppendChild(DOMNode);
|
|
WalkTree(TreeNode, DOMNode, XMLDoc, C);
|
|
TreeNode := TreeNode.GetNextSibling;
|
|
end;
|
|
|
|
try
|
|
WriteXMLFile(XMLDoc, fileName);
|
|
except
|
|
mDebugLn('Failed to write ' + fileName);
|
|
end;
|
|
XMLDoc.Free;
|
|
end;
|
|
|
|
end.
|
|
|