Now there is a Jamfile for compiling
----------------------------------------------------------------------
This commit is contained in:
ocoursiere
23
bepascal/source/tools/codegen/Jamfile
Normal file
23
bepascal/source/tools/codegen/Jamfile
Normal file
@@ -0,0 +1,23 @@
|
||||
# BePascal - A pascal wrapper around the BeOS API
|
||||
# Copyright (C) 2002-2003 Olivier Coursiere
|
||||
# Matt Emson
|
||||
# Eric Jourde
|
||||
# Oscar Lesta
|
||||
#
|
||||
# This library is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU Library General Public
|
||||
# License as published by the Free Software Foundation; either
|
||||
# version 2 of the License, or (at your option) any later version.
|
||||
#
|
||||
# This library 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
|
||||
# Library General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU Library General Public
|
||||
# License along with this library; if not, write to the Free
|
||||
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||
|
||||
SubDir BEPASCAL_TOP source tools codegen ;
|
||||
|
||||
SubInclude BEPASCAL_TOP source tools codegen pas ;
|
||||
2
bepascal/source/tools/codegen/README
Normal file
2
bepascal/source/tools/codegen/README
Normal file
@@ -0,0 +1,2 @@
|
||||
This tool read XML description of BeAPIs and generate pascal and C/C++ source code
|
||||
to access this API from pascal source code
|
||||
32
bepascal/source/tools/codegen/pas/Jamfile
Normal file
32
bepascal/source/tools/codegen/pas/Jamfile
Normal file
@@ -0,0 +1,32 @@
|
||||
# BePascal - A pascal wrapper around the BeOS API
|
||||
# Copyright (C) 2002-2003 Olivier Coursiere
|
||||
# Matt Emson
|
||||
# Eric Jourde
|
||||
# Oscar Lesta
|
||||
#
|
||||
# This library is free software; you can redistribute it and/or
|
||||
# modify it under the terms of the GNU Library General Public
|
||||
# License as published by the Free Software Foundation; either
|
||||
# version 2 of the License, or (at your option) any later version.
|
||||
#
|
||||
# This library 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
|
||||
# Library General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU Library General Public
|
||||
# License along with this library; if not, write to the Free
|
||||
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||
|
||||
SubDir BEPASCAL_TOP source tools codegen pas ;
|
||||
|
||||
Objects codegen.pp ;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
642
bepascal/source/tools/codegen/pas/apireader.pp
Normal file
642
bepascal/source/tools/codegen/pas/apireader.pp
Normal file
@@ -0,0 +1,642 @@
|
||||
{ BePascal - A pascal wrapper around the BeOS API
|
||||
Copyright (C) 2002 Olivier Coursiere
|
||||
|
||||
This library is free software; you can redistribute it and/or
|
||||
modify it under the terms of the GNU Library General Public
|
||||
License as published by the Free Software Foundation; either
|
||||
version 2 of the License, or (at your option) any later version.
|
||||
|
||||
This library 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
|
||||
Library General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU Library General Public
|
||||
License along with this library; if not, write to the Free
|
||||
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||
}
|
||||
|
||||
unit apireader;
|
||||
|
||||
{$H+} // use AnsiStrings
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, xmlread, dom;
|
||||
|
||||
const
|
||||
ImportFuncString = ' cdecl; external BePascalLibName name ''%s_%s'';';
|
||||
|
||||
type
|
||||
TNode = class(TObject)
|
||||
private
|
||||
function GetCount : integer;
|
||||
function GetNode(Index : integer) : TNode;
|
||||
protected
|
||||
FNode : TDOMNode;
|
||||
FChildren : TStringList;
|
||||
public
|
||||
constructor Create(Node : TDOMNode); virtual;
|
||||
destructor Destroy; override;
|
||||
procedure Start; virtual;
|
||||
procedure Middle; virtual;
|
||||
procedure Ends; virtual;
|
||||
property Count : integer read GetCount;
|
||||
property Nodes[Index : integer] : TNode read GetNode;
|
||||
end;
|
||||
TClassess = class;
|
||||
TDocument = class(TNode)
|
||||
private
|
||||
function GetClasses(Index : integer) : TClassess;
|
||||
protected
|
||||
public
|
||||
constructor Create(Node : TDOMNode); override;
|
||||
procedure Start; override;
|
||||
procedure Middle; override;
|
||||
procedure Ends; override;
|
||||
property Classes[Index : integer] : TClassess read GetClasses;
|
||||
end;
|
||||
TClasse = class;
|
||||
TClassess = class(TNode)
|
||||
private
|
||||
function GetClasse(Index : integer) : TClasse;
|
||||
protected
|
||||
public
|
||||
constructor Create(Node : TDOMNode); override;
|
||||
procedure Start; override;
|
||||
procedure Middle; override;
|
||||
procedure Ends; override;
|
||||
property Classes[Index : integer] : TClasse read GetClasse;
|
||||
end;
|
||||
TNamedItem = class(TNode)
|
||||
private
|
||||
protected
|
||||
function GetName : string;
|
||||
public
|
||||
property Name : string read GetName;
|
||||
end;
|
||||
TFunction = class;
|
||||
TClasse = class(TNamedItem)
|
||||
private
|
||||
function GetFunction(Index : integer) : TFunction;
|
||||
protected
|
||||
function GetAncestor : string;
|
||||
public
|
||||
constructor Create(Node : TDOMNode); override;
|
||||
procedure Start; override;
|
||||
procedure Ends; override;
|
||||
property Ancestor : string read GetAncestor;
|
||||
property Functions[Index : integer] : TFunction read GetFunction;
|
||||
end;
|
||||
TResultType = class;
|
||||
TParam = class;
|
||||
TFunction = class(TNamedItem)
|
||||
private
|
||||
FResultType : TResultType;
|
||||
FClasse : TClasse;
|
||||
BodyPas : string;
|
||||
function GetParam(Index : integer) : TParam;
|
||||
protected
|
||||
public
|
||||
constructor Create(Node : TDOMNode); override;
|
||||
destructor Destroy; override;
|
||||
function IsConstructor : boolean;
|
||||
function IsDestructor : boolean;
|
||||
function HasParams : boolean;
|
||||
function ProcName : string;
|
||||
function ProcNameInObject : string;
|
||||
function SelfParam : string;
|
||||
function SelfParamImpl : string;
|
||||
procedure Start; override;
|
||||
procedure Ends; override;
|
||||
property ResultType : TResultType read FResultType;
|
||||
property Params[Index : integer] : TParam read GetParam;
|
||||
property Classe : TClasse read FClasse;
|
||||
end;
|
||||
TTypedItem = class(TNamedItem)
|
||||
private
|
||||
protected
|
||||
function GetType : string;
|
||||
public
|
||||
function IsObject : boolean;
|
||||
property Typ : string read GetType;
|
||||
end;
|
||||
TParam = class(TTypedItem)
|
||||
private
|
||||
FFunction : TFunction;
|
||||
protected
|
||||
public
|
||||
procedure Middle; override;
|
||||
property ParentFunction : TFunction read FFunction;
|
||||
end;
|
||||
TResultType = class(TNode)
|
||||
private
|
||||
protected
|
||||
function GetType : string;
|
||||
public
|
||||
property Typ : string read GetType;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
sourcewrite, typmap;
|
||||
|
||||
// Debug proc
|
||||
procedure NodeInfo(Node : TDOMNode);
|
||||
begin
|
||||
WriteLn(Node.NodeName + ',' + Node.NodeValue + ',' + IntToStr(Node.NodeType));
|
||||
end;
|
||||
|
||||
constructor TNode.Create(Node : TDOMNode);
|
||||
begin
|
||||
inherited Create;
|
||||
FNode := Node;
|
||||
end;
|
||||
|
||||
destructor TNode.Destroy;
|
||||
var
|
||||
i : integer;
|
||||
begin
|
||||
if FChildren <> nil then
|
||||
begin
|
||||
for i := 0 to FChildren.Count - 1 do
|
||||
begin
|
||||
if FChildren.Objects[i] <> nil then
|
||||
FChildren.Objects[i].Free;
|
||||
end;
|
||||
FChildren.Free;
|
||||
end;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TNode.GetCount : integer;
|
||||
begin
|
||||
if FChildren <> nil then
|
||||
Result := FChildren.Count
|
||||
else
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
function TNode.GetNode(Index : integer) : TNode;
|
||||
begin
|
||||
Result := FChildren.Objects[Index] as TNode;
|
||||
end;
|
||||
|
||||
procedure TNode.Start;
|
||||
begin
|
||||
Write('Start : ');
|
||||
if FNode <> nil then
|
||||
NodeInfo(FNode);
|
||||
end;
|
||||
|
||||
procedure TNode.Middle;
|
||||
var
|
||||
i : integer;
|
||||
begin
|
||||
Write('Middle : ');
|
||||
if FNode <> nil then
|
||||
begin
|
||||
NodeInfo(FNode);
|
||||
for i := 0 to Count - 1 do
|
||||
begin
|
||||
Nodes[i].Start;
|
||||
Nodes[i].Middle;
|
||||
Nodes[i].Ends;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TNode.Ends;
|
||||
begin
|
||||
Write('Ends : ');
|
||||
if FNode <> nil then
|
||||
NodeInfo(FNode);
|
||||
end;
|
||||
|
||||
constructor TDocument.Create(Node : TDOMNode);
|
||||
var
|
||||
i : integer;
|
||||
aClasses : TClassess;
|
||||
List : TStringList;
|
||||
begin
|
||||
if Node.HasChildNodes then
|
||||
begin
|
||||
List := TStringList.Create;
|
||||
for i := 0 to Node.ChildNodes.count - 1 do
|
||||
begin
|
||||
aClasses := TClassess.Create(Node.ChildNodes.Item[i]);
|
||||
List.AddObject(IntToStr(i), aClasses);
|
||||
end;
|
||||
FChildren := List;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDocument.GetClasses(Index : integer) : TClassess;
|
||||
begin
|
||||
Result := FChildren.Objects[Index] as TClassess;
|
||||
end;
|
||||
|
||||
procedure TDocument.Start;
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TDocument.Middle;
|
||||
var
|
||||
i : integer;
|
||||
begin
|
||||
for i := 0 to Count - 1 do
|
||||
begin
|
||||
Classes[i].Start;
|
||||
Classes[i].Middle;
|
||||
Classes[i].Ends;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDocument.Ends;
|
||||
begin
|
||||
end;
|
||||
|
||||
constructor TClassess.Create(Node : TDOMNode);
|
||||
var
|
||||
i : integer;
|
||||
aClasse : TClasse;
|
||||
List : TStringList;
|
||||
begin
|
||||
inherited;
|
||||
if Node.HasChildNodes then
|
||||
begin
|
||||
List := TStringList.Create;
|
||||
for i := 0 to Node.ChildNodes.count - 1 do
|
||||
begin
|
||||
aClasse := TClasse.Create(Node.ChildNodes.Item[i]);
|
||||
List.AddObject(aClasse.Name, aClasse);
|
||||
end;
|
||||
FChildren := List;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TClassess.GetClasse(Index : integer) : TClasse;
|
||||
begin
|
||||
Result := FChildren.Objects[Index] as TClasse;
|
||||
end;
|
||||
|
||||
function TNamedItem.GetName : string;
|
||||
var
|
||||
DomNode : TDOMNode;
|
||||
begin
|
||||
DomNode := FNode.Attributes.GetNamedItem('NAME');
|
||||
if DomNode <> nil then
|
||||
begin
|
||||
Result := DomNode.NodeValue;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TClassess.Start;
|
||||
begin
|
||||
SourceWriter.Pas.Add('');
|
||||
end;
|
||||
|
||||
procedure TClassess.Middle;
|
||||
var
|
||||
i : integer;
|
||||
begin
|
||||
for i := 0 to Count - 1 do
|
||||
begin
|
||||
Nodes[i].Start;
|
||||
Nodes[i].Middle;
|
||||
Nodes[i].Ends;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TClassess.Ends;
|
||||
begin
|
||||
end;
|
||||
|
||||
constructor TClasse.Create(Node : TDOMNode);
|
||||
var
|
||||
i : integer;
|
||||
aFunc : TFunction;
|
||||
List : TStringList;
|
||||
begin
|
||||
inherited;
|
||||
if Node.HasChildNodes then
|
||||
begin
|
||||
List := TStringList.Create;
|
||||
for i := 0 to Node.ChildNodes.count - 1 do
|
||||
begin
|
||||
aFunc := TFunction.Create(Node.ChildNodes.Item[i]);
|
||||
aFunc.FClasse := Self;
|
||||
WriteLn(aFunc.Name);
|
||||
WriteLn('');
|
||||
List.AddObject(aFunc.Name, aFunc);
|
||||
end;
|
||||
FChildren := List;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TClasse.GetAncestor : string;
|
||||
begin
|
||||
if FNode.Attributes.GetNamedItem('ANCESTOR') <> nil then
|
||||
Result := FNode.Attributes.GetNamedItem('ANCESTOR').NodeValue
|
||||
else
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
function TClasse.GetFunction(Index : integer) : TFunction;
|
||||
begin
|
||||
Result := FChildren.Objects[Index] as TFunction;
|
||||
end;
|
||||
|
||||
procedure TClasse.Start;
|
||||
begin
|
||||
with SourceWriter.InterfacePas do
|
||||
begin
|
||||
Add('type');
|
||||
Add(Format(' %s = class(%s)', [CppToPas(Name + ' *'), CppToPas(Ancestor + ' *')]));
|
||||
Add(' private');
|
||||
Add(' public');
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TClasse.Ends;
|
||||
begin
|
||||
with SourceWriter.InterfacePas do
|
||||
begin
|
||||
Add(' end;');
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TFunction.Create(Node : TDOMNode);
|
||||
var
|
||||
i : integer;
|
||||
aParam : TParam;
|
||||
List : TStringList;
|
||||
begin
|
||||
inherited;
|
||||
if Node.HasChildNodes then
|
||||
begin
|
||||
List := TStringList.Create;
|
||||
for i := 0 to Node.ChildNodes.count - 1 do
|
||||
begin
|
||||
if Node.ChildNodes.Item[i].Attributes.GetNamedItem('NAME') <> nil then
|
||||
begin
|
||||
aParam := TParam.Create(Node.ChildNodes.Item[i]);
|
||||
aParam.FFunction := Self;
|
||||
WriteLn('Param : ' + aParam.Name + '; ' + 'Type : ' + aParam.Typ);
|
||||
List.AddObject(aParam.Name, aParam);
|
||||
end
|
||||
else
|
||||
begin
|
||||
FResultType := TResultType.Create(Node.ChildNodes.Item[i]);
|
||||
WriteLn('ResultType : ' + FResultType.Typ);
|
||||
end;
|
||||
end;
|
||||
FChildren := List;
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TFunction.Destroy;
|
||||
begin
|
||||
if Assigned(FResultType) then
|
||||
FResultType.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TFunction.IsConstructor : boolean;
|
||||
begin
|
||||
Result := (Name = Classe.Name);
|
||||
end;
|
||||
|
||||
function TFunction.IsDestructor : boolean;
|
||||
begin
|
||||
Result := (Name[1] = '~');
|
||||
end;
|
||||
|
||||
function TFunction.GetParam(Index : integer) : TParam;
|
||||
begin
|
||||
Result := FChildren.Objects[Index] as TParam;
|
||||
end;
|
||||
|
||||
function TFunction.HasParams : boolean;
|
||||
begin
|
||||
Result := (Count > 0);
|
||||
end;
|
||||
|
||||
function TFunction.ProcName : string;
|
||||
begin
|
||||
if IsConstructor then
|
||||
Result := 'Create'
|
||||
else if IsDestructor then
|
||||
Result := 'Free'
|
||||
else
|
||||
Result := Name;
|
||||
end;
|
||||
|
||||
function TFunction.ProcNameInObject : string;
|
||||
begin
|
||||
if IsConstructor then
|
||||
Result := 'Create'
|
||||
else if IsDestructor then
|
||||
Result := 'Destroy'
|
||||
else
|
||||
Result := Name;
|
||||
end;
|
||||
|
||||
function TFunction.SelfParam : string;
|
||||
begin
|
||||
if IsConstructor then
|
||||
Result := '(AObject : TBeObject; '
|
||||
else
|
||||
Result := '(AObject : TCPlusObject; '
|
||||
end;
|
||||
|
||||
function TFunction.SelfParamImpl : string;
|
||||
begin
|
||||
if IsConstructor then
|
||||
Result := '(Self, '
|
||||
else
|
||||
Result := '(CPlusObject, '
|
||||
end;
|
||||
|
||||
procedure TFunction.Start;
|
||||
var
|
||||
EndChar : string;
|
||||
begin
|
||||
WriteLn('Function Start');
|
||||
if HasParams then
|
||||
EndChar := '('
|
||||
else
|
||||
EndChar := '';
|
||||
with SourceWriter.InterfacePas do
|
||||
begin
|
||||
if IsConstructor then
|
||||
Add(Format(' constructor %s%s', [ProcNameInObject, EndChar]))
|
||||
else if IsDestructor then
|
||||
Add(Format(' destructor %s%s', [ProcNameInObject, EndChar]))
|
||||
else if (ResultType.Typ = '') or (ResultType.Typ = 'void') then
|
||||
Add(Format(' procedure %s%s', [Name, EndChar]))
|
||||
else
|
||||
Add(Format(' function %s%s', [Name, EndChar]));
|
||||
end;
|
||||
// Import of C functions
|
||||
with SourceWriter.ImportFuncsPas do
|
||||
begin
|
||||
if ((ResultType.Typ = '') or (ResultType.Typ = 'void')) and
|
||||
not IsConstructor then
|
||||
Add(Format('procedure %s_%s%s', [Classe.Name, ProcName, SelfParam]))
|
||||
else
|
||||
Add(Format('function %s_%s%s', [Classe.Name, ProcName, SelfParam]));
|
||||
end;
|
||||
with SourceWriter.ImplementationPas do
|
||||
begin
|
||||
if (ResultType.Typ = '') or (ResultType.Typ = 'void') then
|
||||
begin
|
||||
if IsConstructor then
|
||||
Add(Format('constructor %s.%s%s', [CppToPas(Classe.Name + ' *'), ProcNameInObject, EndChar]))
|
||||
else if IsDestructor then
|
||||
Add(Format('destructor %s.%s%s', [CppToPas(Classe.Name + ' *'), ProcNameInObject, EndChar]))
|
||||
else
|
||||
Add(Format('procedure %s.%s%s', [CppToPas(Classe.Name + ' *'), ProcName, EndChar]));
|
||||
end
|
||||
else
|
||||
Add(Format('function %s.%s%s', [CppToPas(Classe.Name + ' *'), ProcName, EndChar]));
|
||||
end;
|
||||
// Implementation body
|
||||
if IsConstructor then
|
||||
BodyPas := Format(' CPlusObject := %s_%s%s', [Classe.Name, ProcName, SelfParamImpl])
|
||||
else if (ResultType.Typ = '') or (ResultType.Typ = 'void') then
|
||||
BodyPas := Format(' %s_%s%s', [Classe.Name, ProcName, SelfParamImpl])
|
||||
else
|
||||
BodyPas := Format(' Result := %s_%s%s', [Classe.Name, ProcName, SelfParamImpl]);
|
||||
end;
|
||||
|
||||
procedure TFunction.Ends;
|
||||
var
|
||||
EndChar : string;
|
||||
procedure DeleteLastSep(List : TStringList);
|
||||
var
|
||||
s : string;
|
||||
begin
|
||||
// Delete the last '; '
|
||||
s := List.Strings[List.Count - 1];
|
||||
System.Delete(s, Length(s) - 1, 2);
|
||||
List.Strings[List.Count - 1] := s;
|
||||
end;
|
||||
procedure AddLastSep(List : TStringList);
|
||||
var
|
||||
s : string;
|
||||
begin
|
||||
if not((ResultType.Typ = '') or (ResultType.Typ = 'void')) then
|
||||
begin
|
||||
WriteLn(ResultType.Typ);
|
||||
WriteLn(Name);
|
||||
s := Format('%s%s : %s;', [List.Strings[List.Count - 1], EndChar, CppToPas(ResultType.Typ)]);
|
||||
List.Strings[List.Count - 1] := s;
|
||||
end
|
||||
else if IsConstructor then
|
||||
begin
|
||||
WriteLn(ResultType.Typ);
|
||||
WriteLn(Name);
|
||||
s := Format('%s%s;', [List.Strings[List.Count - 1], EndChar]);
|
||||
List.Strings[List.Count - 1] := s;
|
||||
end
|
||||
else
|
||||
List.Strings[List.Count - 1] := Format('%s%s;', [List.Strings[List.Count - 1], EndChar]);
|
||||
end;
|
||||
var
|
||||
s : string;
|
||||
begin
|
||||
WriteLn('Function ends');
|
||||
if hasParams then
|
||||
begin
|
||||
EndChar := ')';
|
||||
DeleteLastSep(SourceWriter.InterfacePas);
|
||||
end
|
||||
else
|
||||
begin
|
||||
EndChar := '';
|
||||
end;
|
||||
AddLastSep(SourceWriter.InterfacePas);
|
||||
// Import C functions
|
||||
EndChar := ')';
|
||||
DeleteLastSep(SourceWriter.ImportFuncsPas);
|
||||
AddLastSep(SourceWriter.ImportFuncsPas);
|
||||
with SourceWriter.ImportFuncsPas do
|
||||
begin
|
||||
s := Format('%s' + ImportFuncString, [Strings[Count - 1], Classe.Name, ProcName]);
|
||||
Strings[Count - 1] := s;
|
||||
end;
|
||||
|
||||
if hasParams then
|
||||
begin
|
||||
EndChar := ')';
|
||||
DeleteLastSep(SourceWriter.ImplementationPas);
|
||||
end
|
||||
else
|
||||
begin
|
||||
EndChar := '';
|
||||
end;
|
||||
AddLastSep(SourceWriter.ImplementationPas);
|
||||
SourceWriter.ImplementationPas.Add('begin');
|
||||
System.Delete(BodyPas, Length(BodyPas) - 1, 2);
|
||||
SourceWriter.ImplementationPas.Add(BodyPas + ');');
|
||||
SourceWriter.ImplementationPas.Add('end;');
|
||||
SourceWriter.ImplementationPas.Add('');
|
||||
end;
|
||||
|
||||
function TTypedItem.GetType : string;
|
||||
begin
|
||||
Result := FNode.Attributes.GetNamedItem('TYPE').NodeValue;
|
||||
end;
|
||||
|
||||
function TTypedItem.IsObject : boolean;
|
||||
begin
|
||||
// The first letter is a 'B' -> this is an object !
|
||||
Result := (Typ[1] = 'B');
|
||||
end;
|
||||
|
||||
procedure TParam.Middle;
|
||||
procedure WriteParamImport(List : TStringList);
|
||||
var
|
||||
s : string;
|
||||
begin
|
||||
WriteLn('WriteParamImport');
|
||||
WriteLn(List.Strings[List.Count - 1]);
|
||||
if IsObject then
|
||||
begin
|
||||
WriteLn('IsObject');
|
||||
s := Format('%s%s : %s; ', [List.Strings[List.Count - 1], Name, 'TCPlusObject']);
|
||||
end
|
||||
else
|
||||
s := Format('%s%s : %s; ', [List.Strings[List.Count - 1], Name, CppToPas(Typ)]);
|
||||
List.Strings[List.Count - 1] := s;
|
||||
WriteLn(List.Strings[List.Count - 1]);
|
||||
end;
|
||||
procedure WriteParam(List : TStringList);
|
||||
var
|
||||
s : string;
|
||||
begin
|
||||
WriteLn(List.Strings[List.Count - 1]);
|
||||
s := Format('%s%s : %s; ', [List.Strings[List.Count - 1], Name, CppToPas(Typ)]);
|
||||
List.Strings[List.Count - 1] := s;
|
||||
WriteLn(List.Strings[List.Count - 1]);
|
||||
end;
|
||||
begin
|
||||
WriteLn('Param Middle');
|
||||
WriteParam(SourceWriter.InterfacePas);
|
||||
WriteParamImport(SourceWriter.ImportFuncsPas);
|
||||
WriteParam(SourceWriter.ImplementationPas);
|
||||
if IsObject then
|
||||
ParentFunction.BodyPas := Format('%s%s.CPlusObject, ', [ParentFunction.BodyPas, Name])
|
||||
else
|
||||
ParentFunction.BodyPas := Format('%s%s, ', [ParentFunction.BodyPas, Name]);
|
||||
end;
|
||||
|
||||
function TResultType.GetType : string;
|
||||
begin
|
||||
Result := FNode.Attributes.GetNamedItem('TYPE').NodeValue;
|
||||
end;
|
||||
|
||||
end.
|
||||
54
bepascal/source/tools/codegen/pas/codegen.pp
Normal file
54
bepascal/source/tools/codegen/pas/codegen.pp
Normal file
@@ -0,0 +1,54 @@
|
||||
{ BePascal - A pascal wrapper around the BeOS API
|
||||
Copyright (C) 2002 Olivier Coursiere
|
||||
|
||||
This library is free software; you can redistribute it and/or
|
||||
modify it under the terms of the GNU Library General Public
|
||||
License as published by the Free Software Foundation; either
|
||||
version 2 of the License, or (at your option) any later version.
|
||||
|
||||
This library 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
|
||||
Library General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU Library General Public
|
||||
License along with this library; if not, write to the Free
|
||||
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||
}
|
||||
program codegen;
|
||||
|
||||
{$H+} // use AnsiStrings
|
||||
|
||||
uses
|
||||
dom, xmlread, apireader, typmap, codewrite, SysUtils;
|
||||
|
||||
var
|
||||
aDoc : TXMLDocument;
|
||||
HooksDoc : TXMLDocument;
|
||||
Classes, Hooks : TDocument;
|
||||
SrcGen : TSourceGen;
|
||||
begin
|
||||
if ParamCount > 0 then
|
||||
begin
|
||||
ReadXMLFile(aDoc, Paramstr(1));
|
||||
ReadXMLFile(HooksDoc, 'hooks.xml');
|
||||
Classes := TDocument.Create(aDoc);
|
||||
try
|
||||
Hooks := TDocument.Create(HooksDoc);
|
||||
try
|
||||
SrcGen := TSourceGen.Create(Classes, Hooks, StringReplace(Paramstr(1), '.xml', '', []));
|
||||
try
|
||||
SrcGen.Gen;
|
||||
WriteLn('After gen');
|
||||
finally
|
||||
SrcGen.Free;
|
||||
end;
|
||||
finally
|
||||
Hooks.Free;
|
||||
end;
|
||||
finally
|
||||
Classes.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
80
bepascal/source/tools/codegen/pas/codewrite.pp
Normal file
80
bepascal/source/tools/codegen/pas/codewrite.pp
Normal file
@@ -0,0 +1,80 @@
|
||||
{ BePascal - A pascal wrapper around the BeOS API
|
||||
Copyright (C) 2002 Olivier Coursiere
|
||||
|
||||
This library is free software; you can redistribute it and/or
|
||||
modify it under the terms of the GNU Library General Public
|
||||
License as published by the Free Software Foundation; either
|
||||
version 2 of the License, or (at your option) any later version.
|
||||
|
||||
This library 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
|
||||
Library General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU Library General Public
|
||||
License along with this library; if not, write to the Free
|
||||
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||
}
|
||||
|
||||
unit codewrite;
|
||||
|
||||
interface
|
||||
|
||||
{$H+} // use AnsiStrings
|
||||
|
||||
uses
|
||||
Classes, SysUtils, apireader, sourcewrite;
|
||||
|
||||
type
|
||||
TSourceGen = class(TObject)
|
||||
private
|
||||
FClasses : TDocument;
|
||||
FHooks : TDocument;
|
||||
protected
|
||||
procedure Enum(Node : TNode);
|
||||
public
|
||||
constructor Create(Classes, Hooks : TDocument; FileName : string); virtual;
|
||||
destructor Destroy; override;
|
||||
procedure Gen;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
constructor TSourceGen.Create(Classes, Hooks : TDocument; FileName : string);
|
||||
begin
|
||||
inherited Create;
|
||||
FClasses := Classes;
|
||||
FHooks := Hooks;
|
||||
SourceWriter := TSourceWriter.Create(FileName);
|
||||
end;
|
||||
|
||||
destructor TSourceGen.Destroy;
|
||||
begin
|
||||
SourceWriter.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TSourceGen.Gen;
|
||||
begin
|
||||
Enum(FClasses);
|
||||
end;
|
||||
|
||||
procedure TSourceGen.Enum(Node : TNode);
|
||||
var
|
||||
i : integer;
|
||||
begin
|
||||
if Node <> nil then
|
||||
begin
|
||||
for i := 0 to Node.Count - 1 do
|
||||
begin
|
||||
Node.Start;
|
||||
WriteLn('Before Enum');
|
||||
Node.Middle;
|
||||
WriteLn('After enum');
|
||||
Node.Ends;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
140
bepascal/source/tools/codegen/pas/sourcewrite.pp
Normal file
140
bepascal/source/tools/codegen/pas/sourcewrite.pp
Normal file
@@ -0,0 +1,140 @@
|
||||
{ BePascal - A pascal wrapper around the BeOS API
|
||||
Copyright (C) 2002 Olivier Coursiere
|
||||
|
||||
This library is free software; you can redistribute it and/or
|
||||
modify it under the terms of the GNU Library General Public
|
||||
License as published by the Free Software Foundation; either
|
||||
version 2 of the License, or (at your option) any later version.
|
||||
|
||||
This library 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
|
||||
Library General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU Library General Public
|
||||
License along with this library; if not, write to the Free
|
||||
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||
}
|
||||
|
||||
unit sourcewrite;
|
||||
|
||||
{$H+} // use AnsiStrings
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes, apireader;
|
||||
|
||||
const
|
||||
Eol = #10;
|
||||
CLicense =
|
||||
'/* BePascal - A pascal wrapper around the BeOS API ' + Eol +
|
||||
' Copyright (C) 2002 Olivier Coursiere ' + Eol +
|
||||
' Eric Jourde ' + Eol +
|
||||
' ' + Eol +
|
||||
' This library is free software; you can redistribute it and/or ' + Eol +
|
||||
' modify it under the terms of the GNU Library General Public ' + Eol +
|
||||
' License as published by the Free Software Foundation; either ' + Eol +
|
||||
' version 2 of the License, or (at your option) any later version. ' + Eol +
|
||||
' ' + Eol +
|
||||
' This library is distributed in the hope that it will be useful, ' + Eol +
|
||||
' but WITHOUT ANY WARRANTY; without even the implied warranty of ' + Eol +
|
||||
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ' + Eol +
|
||||
' Library General Public License for more details. ' + Eol +
|
||||
' ' + Eol +
|
||||
' You should have received a copy of the GNU Library General Public ' + Eol +
|
||||
' License along with this library; if not, write to the Free ' + Eol +
|
||||
' Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA ' + Eol +
|
||||
'*/ ';
|
||||
PasLicense =
|
||||
'{ BePascal - A pascal wrapper around the BeOS API ' + Eol +
|
||||
' Copyright (C) 2002 Olivier Coursiere ' + Eol +
|
||||
' Eric Jourde ' + Eol +
|
||||
' ' + Eol +
|
||||
' This library is free software; you can redistribute it and/or ' + Eol +
|
||||
' modify it under the terms of the GNU Library General Public ' + Eol +
|
||||
' License as published by the Free Software Foundation; either ' + Eol +
|
||||
' version 2 of the License, or (at your option) any later version. ' + Eol +
|
||||
' ' + Eol +
|
||||
' This library is distributed in the hope that it will be useful, ' + Eol +
|
||||
' but WITHOUT ANY WARRANTY; without even the implied warranty of ' + Eol +
|
||||
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ' + Eol +
|
||||
' Library General Public License for more details. ' + Eol +
|
||||
' ' + Eol +
|
||||
' You should have received a copy of the GNU Library General Public ' + Eol +
|
||||
' License along with this library; if not, write to the Free ' + Eol +
|
||||
' Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA ' + Eol +
|
||||
'} ';
|
||||
|
||||
type
|
||||
TSourceWriter = class(TObject)
|
||||
private
|
||||
FH : TStringList;
|
||||
FCpp : TStringList;
|
||||
FPas : TStringList;
|
||||
FFileName : string;
|
||||
FHooks : TDocument;
|
||||
FInterfacePas : TStringList;
|
||||
FImplementationPas : TStringList;
|
||||
FImportFuncsPas : TStringList;
|
||||
public
|
||||
constructor Create(FileName : string); virtual;
|
||||
destructor Destroy; override;
|
||||
property H : TStringList read FH;
|
||||
property Cpp : TStringList read FCpp;
|
||||
property Pas : TStringList read FPas;
|
||||
property Hooks : TDocument read FHooks write FHooks;
|
||||
property InterfacePas : TStringList read FInterfacePas;
|
||||
property ImplementationPas : TStringList read FImplementationPas;
|
||||
property ImportFuncsPas : TStringList read FImportFuncsPas;
|
||||
end;
|
||||
|
||||
var
|
||||
SourceWriter : TSourceWriter;
|
||||
|
||||
implementation
|
||||
|
||||
constructor TSourceWriter.Create(FileName : string);
|
||||
begin
|
||||
inherited Create;
|
||||
FFileName := FileName;
|
||||
FH := TStringList.Create;
|
||||
FH.Add(CLicense);
|
||||
FCpp := TStringList.Create;
|
||||
FCpp.Add(CLicense);
|
||||
FPas := TStringList.Create;
|
||||
FPas.Add(PasLicense);
|
||||
FPas.Add('unit ' + LowerCase(FFileName) + ';');
|
||||
FPas.Add('');
|
||||
FPas.Add('interface');
|
||||
FPas.Add('');
|
||||
FPas.Add('uses');
|
||||
FPas.Add(' beobj;');
|
||||
FInterfacePas := TStringList.Create;
|
||||
FImplementationPas := TStringList.Create;
|
||||
FImportFuncsPas := TStringList.Create;
|
||||
end;
|
||||
|
||||
destructor TSourceWriter.Destroy;
|
||||
begin
|
||||
// Writing files
|
||||
FH.SaveToFile(FFileName + '.h');
|
||||
FH.Free;
|
||||
FCpp.SaveToFile(FFileName + '.cpp');
|
||||
FCpp.Free;
|
||||
FPas.Add(FInterfacePas.Text);
|
||||
FPas.Add(FImportFuncsPas.Text);
|
||||
FPas.Add('implementation');
|
||||
FPas.Add('');
|
||||
FPas.Add(FImplementationPas.Text);
|
||||
// write the end of pascal unit
|
||||
FPas.Add('end.');
|
||||
FPas.SaveToFile(LowerCase(FFileName) + '.pp');
|
||||
FPas.Free;
|
||||
FInterfacePas.Free;
|
||||
FImplementationPas.Free;
|
||||
FImportFuncsPas.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
end.
|
||||
51
bepascal/source/tools/codegen/pas/typmap.pp
Normal file
51
bepascal/source/tools/codegen/pas/typmap.pp
Normal file
@@ -0,0 +1,51 @@
|
||||
unit typmap;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes;
|
||||
|
||||
function CppToPas(CppType : string) : string;
|
||||
function PasToCpp(PasType : string) : string;
|
||||
|
||||
implementation
|
||||
|
||||
const
|
||||
TypMapFileName = 'typemap.txt';
|
||||
var
|
||||
aTypMap : TStringList;
|
||||
NewTypMap : TStringList;
|
||||
|
||||
function CppToPas(CppType : string) : string;
|
||||
var
|
||||
i : integer;
|
||||
begin
|
||||
Result := aTypMap.Values[CppType];
|
||||
if Result = '' then
|
||||
begin
|
||||
if not NewTypMap.Find(CppType + '=', i) then
|
||||
NewTypMap.Add(CppType + '=');
|
||||
end;
|
||||
end;
|
||||
|
||||
function PasToCpp(PasType : string) : string;
|
||||
begin
|
||||
// To implement if necessary
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
initialization
|
||||
aTypMap := TStringList.Create;
|
||||
aTypMap.LoadFromFile(TypMapFileName);
|
||||
aTypMap.Sorted := True;
|
||||
NewTypMap := TStringList.Create;
|
||||
NewTypMap.Sorted := True;
|
||||
|
||||
finalization
|
||||
// WriteLn(aTypMap.Text);
|
||||
aTypMap.SaveToFile(TypMapFileName);
|
||||
aTypMap.Free;
|
||||
NewTypMap.SaveToFile(TypMapFileName + '.new');
|
||||
NewTypMap.Free;
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user