1040 lines
34 KiB
ObjectPascal
1040 lines
34 KiB
ObjectPascal
unit DelphiXMLDataBindingGenerator;
|
|
|
|
interface
|
|
uses
|
|
Classes,
|
|
XMLSchema,
|
|
|
|
X2UtHashes,
|
|
|
|
DelphiXMLDataBindingResources,
|
|
XMLDataBindingGenerator,
|
|
XMLDataBindingHelpers;
|
|
|
|
|
|
type
|
|
TGetFileNameEvent = procedure(Sender: TObject; const SchemaName: String; var Result: String) of object;
|
|
|
|
|
|
TDelphiXMLDataBindingGenerator = class(TXMLDataBindingGenerator)
|
|
private
|
|
FOnGetFileName: TGetFileNameEvent;
|
|
FProcessedItems: TX2OIHash;
|
|
protected
|
|
procedure GenerateDataBinding(); override;
|
|
procedure GenerateSingleDataBinding();
|
|
procedure GenerateMultipleDataBinding();
|
|
|
|
function DelphiSafeName(const AName: String): String;
|
|
function TranslateItemName(AItem: TXMLDataBindingItem): String; override;
|
|
|
|
function DoGetFileName(const ASchemaName: String): String;
|
|
|
|
|
|
function GetDataTypeMapping(ADataType: IXMLTypeDef; out ATypeMapping: TTypeMapping): Boolean;
|
|
function TranslateDataType(ADataType: IXMLTypeDef): String;
|
|
function CreateNewGUID(): String;
|
|
|
|
procedure WriteUnitHeader(AStream: TStreamHelper; const AFileName: String);
|
|
procedure WriteSection(AStream: TStreamHelper; ASection: TDelphiXMLSection);
|
|
procedure WriteDocumentFunctions(AStream: TStreamHelper; ASection: TDelphiXMLSection);
|
|
procedure WriteEnumerationConstants(AStream: TStreamHelper);
|
|
procedure WriteEnumerationConversions(AStream: TStreamHelper);
|
|
procedure WriteDocumentation(AStream: TStreamHelper; AItem: TXMLDataBindingItem);
|
|
|
|
procedure WriteSchemaItem(AStream: TStreamHelper; AItem: TXMLDataBindingItem; ASection: TDelphiXMLSection);
|
|
procedure WriteSchemaInterface(AStream: TStreamHelper; AItem: TXMLDataBindingInterface; ASection: TDelphiXMLSection);
|
|
procedure WriteSchemaInterfaceProperties(AStream: TStreamHelper; AItem: TXMLDataBindingInterface; ASection: TDelphiXMLSection);
|
|
procedure WriteSchemaCollection(AStream: TStreamHelper; AItem: TXMLDataBindingCollection; ASection: TDelphiXMLSection);
|
|
procedure WriteSchemaCollectionProperties(AStream: TStreamHelper; AItem: TXMLDataBindingCollection; ASection: TDelphiXMLSection);
|
|
procedure WriteSchemaEnumeration(AStream: TStreamHelper; AItem: TXMLDataBindingEnumeration; ASection: TDelphiXMLSection);
|
|
procedure WriteSchemaEnumerationArray(AStream: TStreamHelper; AItem: TXMLDataBindingEnumeration);
|
|
|
|
function DataTypeConversion(const ADestination, ASource: string; ADataType: IXMLTypeDef; AToNative: Boolean; const ALinesBefore: string = ''): string;
|
|
function XMLToNativeDataType(const ADestination, ASource: string; ADataType: IXMLTypeDef; const ALinesBefore: string = ''): string;
|
|
function NativeDataTypeToXML(const ADestination, ASource: string; ADataType: IXMLTypeDef; const ALinesBefore: string = ''): string;
|
|
|
|
property ProcessedItems: TX2OIHash read FProcessedItems;
|
|
public
|
|
property OnGetFileName: TGetFileNameEvent read FOnGetFileName write FOnGetFileName;
|
|
end;
|
|
|
|
|
|
implementation
|
|
uses
|
|
Contnrs,
|
|
SysUtils,
|
|
|
|
X2UtNamedFormat;
|
|
|
|
|
|
|
|
{ TDelphiXMLDataBindingGenerator }
|
|
procedure TDelphiXMLDataBindingGenerator.GenerateDataBinding();
|
|
begin
|
|
case OutputType of
|
|
otSingle: GenerateSingleDataBinding();
|
|
otMultiple: GenerateMultipleDataBinding();
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TDelphiXMLDataBindingGenerator.GenerateSingleDataBinding();
|
|
var
|
|
unitName: String;
|
|
unitStream: TStreamHelper;
|
|
|
|
begin
|
|
unitName := DoGetFileName(Schemas[0].SchemaName);
|
|
unitStream := TStreamHelper.Create(TFileStream.Create(unitName, fmCreate), soOwned);
|
|
try
|
|
WriteUnitHeader(unitStream, unitName);
|
|
|
|
unitStream.Write(UnitInterface);
|
|
WriteSection(unitStream, dxsForward);
|
|
|
|
FProcessedItems := TX2OIHash.Create();
|
|
try
|
|
FProcessedItems.Clear();
|
|
WriteSection(unitStream, dxsInterface);
|
|
|
|
FProcessedItems.Clear();
|
|
WriteSection(unitStream, dxsClass);
|
|
finally
|
|
FreeAndNil(FProcessedItems);
|
|
end;
|
|
|
|
WriteDocumentFunctions(unitStream, dxsInterface);
|
|
WriteEnumerationConstants(unitStream);
|
|
|
|
unitStream.Write(UnitImplementation);
|
|
WriteDocumentFunctions(unitStream, dxsImplementation);
|
|
WriteEnumerationConversions(unitStream);
|
|
|
|
// #ToDo1 (MvR) 20-3-2008: write conversion methods
|
|
|
|
WriteSection(unitStream, dxsImplementation);
|
|
|
|
unitStream.Write(unitFooter);
|
|
finally
|
|
FreeAndNil(unitStream);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TDelphiXMLDataBindingGenerator.GenerateMultipleDataBinding();
|
|
begin
|
|
end;
|
|
|
|
|
|
function TDelphiXMLDataBindingGenerator.GetDataTypeMapping(ADataType: IXMLTypeDef; out ATypeMapping: TTypeMapping): Boolean;
|
|
var
|
|
mappingIndex: Integer;
|
|
dataTypeName: string;
|
|
|
|
begin
|
|
Assert(not ADataType.IsComplex, 'Complex DataTypes not supported');
|
|
Assert(ADataType.Enumerations.Count = 0, 'Enumerations not supported');
|
|
Result := False;
|
|
|
|
if (ADataType.NamespaceURI = SXMLSchemaURI_1999) or
|
|
(ADataType.NamespaceURI = SXMLSchemaURI_2000_10) or
|
|
(ADataType.NamespaceURI = SXMLSchemaURI_2001) then
|
|
begin
|
|
dataTypeName := ADataType.Name;
|
|
|
|
for mappingIndex := Low(SimpleTypeMapping) to High(SimpleTypeMapping) do
|
|
if SimpleTypeMapping[mappingIndex].SchemaName = dataTypeName then
|
|
begin
|
|
ATypeMapping := SimpleTypeMapping[mappingIndex];
|
|
Result := True;
|
|
Break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
function TDelphiXMLDataBindingGenerator.TranslateDataType(ADataType: IXMLTypeDef): String;
|
|
var
|
|
typeMapping: TTypeMapping;
|
|
|
|
begin
|
|
Result := 'Variant';
|
|
if GetDataTypeMapping(ADataType, typeMapping) then
|
|
Result := typeMapping.DelphiName;
|
|
end;
|
|
|
|
|
|
function TDelphiXMLDataBindingGenerator.DelphiSafeName(const AName: String): String;
|
|
var
|
|
wordIndex: Integer;
|
|
|
|
begin
|
|
Result := AName;
|
|
|
|
for wordIndex := Low(ReservedWords) to High(ReservedWords) do
|
|
begin
|
|
if Result = ReservedWords[wordIndex] then
|
|
begin
|
|
Result := '_' + Result;
|
|
Break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
function TDelphiXMLDataBindingGenerator.TranslateItemName(AItem: TXMLDataBindingItem): String;
|
|
begin
|
|
Result := DelphiSafeName(inherited TranslateItemName(AItem));
|
|
|
|
case AItem.ItemType of
|
|
itEnumerationMember:
|
|
Result := TXMLDataBindingEnumerationMember(AItem).Enumeration.TranslatedName + '_' + Result;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TDelphiXMLDataBindingGenerator.WriteUnitHeader(AStream: TStreamHelper; const AFileName: String);
|
|
begin
|
|
// #ToDo3 (MvR) 14-4-2007: if outputtype = multiple, use include files
|
|
AStream.WriteNamedFmt(UnitHeader,
|
|
['SourceFileName', SourceFileName,
|
|
'UnitName', ChangeFileExt(ExtractFileName(AFileName), '')]);
|
|
end;
|
|
|
|
|
|
procedure TDelphiXMLDataBindingGenerator.WriteSection(AStream: TStreamHelper; ASection: TDelphiXMLSection);
|
|
var
|
|
schemaIndex: Integer;
|
|
schema: TXMLDataBindingSchema;
|
|
itemIndex: Integer;
|
|
|
|
begin
|
|
for schemaIndex := 0 to Pred(SchemaCount) do
|
|
begin
|
|
schema := Schemas[schemaIndex];
|
|
AStream.WriteLnNamedFmt(SectionComments[ASection],
|
|
['SchemaName', schema.SchemaName]);
|
|
|
|
for itemIndex := 0 to Pred(schema.ItemCount) do
|
|
WriteSchemaItem(AStream, schema.Items[itemIndex], ASection);
|
|
|
|
AStream.WriteLn;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TDelphiXMLDataBindingGenerator.WriteDocumentFunctions(AStream: TStreamHelper; ASection: TDelphiXMLSection);
|
|
var
|
|
schemaIndex: Integer;
|
|
schema: TXMLDataBindingSchema;
|
|
itemIndex: Integer;
|
|
item: TXMLDataBindingItem;
|
|
interfaceItem: TXMLDataBindingInterface;
|
|
hasItem: Boolean;
|
|
|
|
begin
|
|
hasItem := False;
|
|
|
|
for schemaIndex := 0 to Pred(SchemaCount) do
|
|
begin
|
|
schema := Schemas[schemaIndex];
|
|
|
|
for itemIndex := 0 to Pred(schema.ItemCount) do
|
|
begin
|
|
item := schema.Items[itemIndex];
|
|
|
|
if item.ItemType = itInterface then
|
|
begin
|
|
interfaceItem := TXMLDataBindingInterface(item);
|
|
|
|
if item.DocumentElement then
|
|
begin
|
|
if not hasItem then
|
|
begin
|
|
if ASection = dxsInterface then
|
|
AStream.Write(' ');
|
|
|
|
AStream.WriteLn('{ Document functions }');
|
|
hasItem := True;
|
|
end;
|
|
|
|
with TNamedFormatStringList.Create() do
|
|
try
|
|
case ASection of
|
|
dxsInterface: Add(DocumentFunctionsInterface);
|
|
dxsImplementation: Add(DocumentFunctionsImplementation);
|
|
end;
|
|
|
|
AStream.Write(Format(['SourceName', interfaceItem.Name,
|
|
'Name', interfaceItem.TranslatedName]));
|
|
finally
|
|
Free();
|
|
end;
|
|
|
|
AStream.WriteLn();
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if hasItem and (ASection = dxsInterface) then
|
|
begin
|
|
// #ToDo3 (MvR) 9-3-2008: namespace support?
|
|
AStream.WriteLn('const');
|
|
AStream.WriteLn(' TargetNamespace = '''';');
|
|
AStream.WriteLn();
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TDelphiXMLDataBindingGenerator.WriteEnumerationConstants(AStream: TStreamHelper);
|
|
var
|
|
item: TXMLDataBindingItem;
|
|
itemIndex: Integer;
|
|
schema: TXMLDataBindingSchema;
|
|
schemaIndex: Integer;
|
|
enumerations: TObjectList;
|
|
|
|
begin
|
|
{ Write array constants for enumerations }
|
|
enumerations := TObjectList.Create(False);
|
|
try
|
|
for schemaIndex := 0 to Pred(SchemaCount) do
|
|
begin
|
|
schema := Schemas[schemaIndex];
|
|
|
|
for itemIndex := 0 to Pred(schema.ItemCount) do
|
|
begin
|
|
item := schema.Items[itemIndex];
|
|
|
|
if item.ItemType = itEnumeration then
|
|
enumerations.Add(item);
|
|
end;
|
|
end;
|
|
|
|
if enumerations.Count > 0 then
|
|
begin
|
|
AStream.WriteLn('const');
|
|
|
|
for itemIndex := 0 to Pred(enumerations.Count) do
|
|
WriteSchemaEnumerationArray(AStream, TXMLDataBindingEnumeration(enumerations[itemIndex]));
|
|
end;
|
|
finally
|
|
FreeAndNil(enumerations);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TDelphiXMLDataBindingGenerator.WriteEnumerationConversions(AStream: TStreamHelper);
|
|
begin
|
|
//
|
|
end;
|
|
|
|
|
|
procedure TDelphiXMLDataBindingGenerator.WriteDocumentation(AStream: TStreamHelper; AItem: TXMLDataBindingItem);
|
|
var
|
|
lines: TStringList;
|
|
lineIndex: Integer;
|
|
|
|
begin
|
|
// #ToDo2 (MvR) 9-3-2008: check for Delphi comment-ending sequences
|
|
if not AItem.HasDocumentation then
|
|
exit;
|
|
|
|
lines := TStringList.Create();
|
|
try
|
|
lines.Text := WrapText(AItem.Documentation, 76);
|
|
|
|
AStream.WriteLn(' {');
|
|
for lineIndex := 0 to Pred(lines.Count) do
|
|
AStream.WriteLn(' ' + lines[lineIndex]);
|
|
|
|
AStream.WriteLn(' }');
|
|
finally
|
|
FreeAndNil(lines);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TDelphiXMLDataBindingGenerator.WriteSchemaItem(AStream: TStreamHelper; AItem: TXMLDataBindingItem; ASection: TDelphiXMLSection);
|
|
begin
|
|
case AItem.ItemType of
|
|
itInterface: WriteSchemaInterface(AStream, TXMLDataBindingInterface(AItem), ASection);
|
|
itCollection: WriteSchemaCollection(AStream, TXMLDataBindingCollection(AItem), ASection);
|
|
itEnumeration: WriteSchemaEnumeration(AStream, TXMLDataBindingEnumeration(AItem), ASection);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TDelphiXMLDataBindingGenerator.WriteSchemaInterface(AStream: TStreamHelper; AItem: TXMLDataBindingInterface; ASection: TDelphiXMLSection);
|
|
var
|
|
parent: String;
|
|
|
|
begin
|
|
if ASection in [dxsInterface, dxsClass] then
|
|
begin
|
|
{ Ensure the base item is completely defined first, Delphi doesn't allow
|
|
inheritance with just a forward declaration. }
|
|
if ProcessedItems.Exists(AItem) then
|
|
exit;
|
|
|
|
if Assigned(AItem.BaseItem) then
|
|
WriteSchemaInterface(AStream, AItem.BaseItem, ASection);
|
|
|
|
ProcessedItems[AItem] := 1;
|
|
end;
|
|
|
|
|
|
case ASection of
|
|
dxsForward:
|
|
AStream.WriteLnNamedFmt(InterfaceItemForward,
|
|
['Name', AItem.TranslatedName]);
|
|
dxsInterface:
|
|
begin
|
|
if Assigned(AItem.BaseItem) then
|
|
parent := PrefixInterface + AItem.BaseItem.TranslatedName
|
|
else
|
|
parent := ItemInterface;
|
|
|
|
WriteDocumentation(AStream, AItem);
|
|
AStream.WriteLnNamedFmt(InterfaceItemInterface,
|
|
['Name', AItem.TranslatedName,
|
|
'ParentName', parent]);
|
|
AStream.WriteLn(' ' + CreateNewGUID());
|
|
|
|
WriteSchemaInterfaceProperties(AStream, AItem, ASection);
|
|
|
|
AStream.WriteLn(' end;');
|
|
AStream.WriteLn();
|
|
end;
|
|
dxsClass:
|
|
begin
|
|
if Assigned(AItem.BaseItem) then
|
|
parent := PrefixClass + AItem.BaseItem.TranslatedName
|
|
else
|
|
parent := ItemClass;
|
|
|
|
AStream.WriteLnNamedFmt(InterfaceItemClass,
|
|
['Name', AItem.TranslatedName,
|
|
'ParentName', parent]);
|
|
|
|
WriteSchemaInterfaceProperties(AStream, AItem, ASection);
|
|
|
|
AStream.WriteLn(' end;');
|
|
AStream.WriteLn();
|
|
end;
|
|
dxsImplementation:
|
|
begin
|
|
WriteSchemaInterfaceProperties(AStream, AItem, ASection);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TDelphiXMLDataBindingGenerator.WriteSchemaInterfaceProperties(AStream: TStreamHelper; AItem: TXMLDataBindingInterface; ASection: TDelphiXMLSection);
|
|
|
|
procedure WriteAfterConstruction;
|
|
var
|
|
propertyIndex: Integer;
|
|
propertyItem: TXMLDataBindingProperty;
|
|
itemProperty: TXMLDataBindingItemProperty;
|
|
hasInterface: Boolean;
|
|
|
|
begin
|
|
hasInterface := False;
|
|
|
|
for propertyIndex := 0 to Pred(AItem.PropertyCount) do
|
|
begin
|
|
propertyItem := AItem.Properties[propertyIndex];
|
|
|
|
if propertyItem.PropertyType = ptItem then
|
|
begin
|
|
itemProperty := TXMLDataBindingItemProperty(propertyItem);
|
|
|
|
if Assigned(itemProperty.Item) and
|
|
(itemProperty.Item.ItemType <> itEnumeration) then
|
|
begin
|
|
case ASection of
|
|
dxsClass:
|
|
begin
|
|
AStream.WriteLn(' public');
|
|
AStream.WriteLn(' procedure AfterConstruction; override;');
|
|
break;
|
|
end;
|
|
dxsImplementation:
|
|
begin
|
|
if not hasInterface then
|
|
begin
|
|
AStream.WriteLnFmt('procedure TXML%s.AfterConstruction;', [AItem.TranslatedName]);
|
|
AStream.WriteLn('begin');
|
|
hasInterface := True;
|
|
end;
|
|
|
|
AStream.WriteLnNamedFmt(' RegisterChildNode(''%<SourceName>:s'', TXML%<Name>:s);',
|
|
['SourceName', itemProperty.Item.Name,
|
|
'Name', itemProperty.Item.TranslatedName]);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if (ASection = dxsImplementation) and hasInterface then
|
|
begin
|
|
AStream.WriteLn('end;');
|
|
AStream.WriteLn();
|
|
end;
|
|
end;
|
|
|
|
|
|
var
|
|
propertyIndex: Integer;
|
|
itemProperty: TXMLDataBindingProperty;
|
|
propertyItem: TXMLDataBindingItem;
|
|
dataTypeName: String;
|
|
writeOptional: Boolean;
|
|
writeTextProp: Boolean;
|
|
hasMembers: Boolean;
|
|
member: TDelphiXMLMember;
|
|
value: String;
|
|
sourceCode: TNamedFormatStringList;
|
|
propertyItemName: String;
|
|
|
|
begin
|
|
// #ToDo1 (MvR) 9-3-2008: refactor WriteSchemaInterfaceProperties
|
|
if ASection = dxsForward then
|
|
Exit;
|
|
|
|
if ASection = dxsImplementation then
|
|
WriteAfterConstruction();
|
|
|
|
if ASection = dxsClass then
|
|
AStream.WriteLn(' protected');
|
|
|
|
hasMembers := False;
|
|
for member := Low(TDelphiXMLMember) to High(TDelphiXMLMember) do
|
|
begin
|
|
if hasMembers then
|
|
AStream.WriteLn;
|
|
|
|
hasMembers := False;
|
|
|
|
for propertyIndex := 0 to Pred(AItem.PropertyCount) do
|
|
begin
|
|
itemProperty := AItem.Properties[propertyIndex];
|
|
propertyItem := nil;
|
|
dataTypeName := '';
|
|
writeTextProp := False;
|
|
writeOptional := True;
|
|
|
|
{ Get data type }
|
|
case itemProperty.PropertyType of
|
|
ptSimple:
|
|
dataTypeName := TranslateDataType(TXMLDataBindingSimpleProperty(itemProperty).DataType);
|
|
ptItem:
|
|
begin
|
|
propertyItem := TXMLDataBindingItemProperty(itemProperty).Item;
|
|
if Assigned(propertyItem) then
|
|
begin
|
|
if propertyItem.ItemType = itEnumeration then
|
|
begin
|
|
dataTypeName := PrefixClass;
|
|
writeTextProp := True;
|
|
end else
|
|
dataTypeName := PrefixInterface;
|
|
|
|
{ Collections have a Count property, no need to write a
|
|
HasX property as well. }
|
|
writeOptional := (propertyItem.ItemType <> itCollection);
|
|
|
|
dataTypeName := dataTypeName + propertyItem.TranslatedName;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
if Length(dataTypeName) > 0 then
|
|
begin
|
|
writeOptional := writeOptional and
|
|
itemProperty.IsOptional and
|
|
(member in [dxmPropertyGet, dxmPropertyDeclaration]);
|
|
|
|
|
|
sourceCode := TNamedFormatStringList.Create();
|
|
try
|
|
case ASection of
|
|
dxsInterface,
|
|
dxsClass:
|
|
begin
|
|
{ Interface declaration }
|
|
case member of
|
|
dxmPropertyGet:
|
|
begin
|
|
if writeOptional then
|
|
sourceCode.Add(PropertyIntfMethodGetOptional);
|
|
|
|
if writeTextProp then
|
|
sourceCode.Add(PropertyIntfMethodGetText);
|
|
|
|
sourceCode.Add(PropertyIntfMethodGet);
|
|
hasMembers := True;
|
|
end;
|
|
|
|
dxmPropertySet:
|
|
if not itemProperty.IsReadOnly then
|
|
begin
|
|
if writeTextProp then
|
|
sourceCode.Add(PropertyIntfMethodSetText);
|
|
|
|
sourceCode.Add(PropertyIntfMethodSet);
|
|
hasMembers := True;
|
|
end;
|
|
|
|
dxmPropertyDeclaration:
|
|
begin
|
|
if writeOptional then
|
|
sourceCode.Add(PropertyInterfaceOptional);
|
|
|
|
if itemProperty.IsReadOnly then
|
|
begin
|
|
if writeTextProp then
|
|
sourceCode.Add(PropertyInterfaceTextReadOnly);
|
|
|
|
sourceCode.Add(PropertyInterfaceReadOnly);
|
|
end else
|
|
begin
|
|
if writeTextProp then
|
|
sourceCode.Add(PropertyInterfaceText);
|
|
|
|
sourceCode.Add(PropertyInterface);
|
|
end;
|
|
|
|
hasMembers := True;
|
|
end;
|
|
end;
|
|
end;
|
|
dxsImplementation:
|
|
begin
|
|
{ Implementation }
|
|
case member of
|
|
dxmPropertyGet:
|
|
begin
|
|
if writeOptional then
|
|
sourceCode.Add(PropertyImplMethodGetOptional);
|
|
|
|
if writeTextProp then
|
|
sourceCode.Add(PropertyImplMethodGetText);
|
|
|
|
sourceCode.Add('function TXML%<Name>:s.Get%<PropertyName>:s: %<DataType>:s;');
|
|
|
|
case itemProperty.PropertyType of
|
|
ptSimple:
|
|
sourceCode.Add(XMLToNativeDataType('Result',
|
|
'ChildNodes[''%<PropertySourceName>:s''].NodeValue',
|
|
TXMLDataBindingSimpleProperty(itemProperty).DataType));
|
|
|
|
ptItem:
|
|
begin
|
|
if Assigned(propertyItem) then
|
|
begin
|
|
case propertyItem.ItemType of
|
|
itInterface,
|
|
itCollection:
|
|
begin
|
|
sourceCode.Add('begin');
|
|
sourceCode.Add(' Result := (ChildNodes[''%<Name>:s''] as IXML%<PropertyItemName>:s);');
|
|
sourceCode.Add('end;');
|
|
end;
|
|
|
|
itEnumeration:
|
|
begin
|
|
sourceCode.Add('var');
|
|
sourceCode.Add(' nodeValue: WideString;');
|
|
sourceCode.Add(' enumValue: %<DataType>:s;');
|
|
sourceCode.AddLn;
|
|
sourceCode.Add('begin');
|
|
sourceCode.Add(' Result := %<DataType>:s(-1);');
|
|
sourceCode.Add(' nodeValue := Get%<PropertyName>:sText;');
|
|
sourceCode.Add(' for enumValue := Low(%<DataType>:s) to High(%<DataType>:s) do');
|
|
sourceCode.Add(' if %<PropertyName>:sValues[enumValue] = nodeValue then');
|
|
sourceCode.Add(' begin');
|
|
sourceCode.Add(' Result := enumValue;');
|
|
sourceCode.Add(' break;');
|
|
sourceCode.Add(' end;');
|
|
sourceCode.Add('end;');
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
sourceCode.AddLn;
|
|
end;
|
|
dxmPropertySet:
|
|
if not itemProperty.IsReadOnly then
|
|
begin
|
|
if writeTextProp then
|
|
sourceCode.Add(PropertyImplMethodSetText);
|
|
|
|
sourceCode.Add('procedure TXML%<Name>:s.Set%<PropertyName>:s(const Value: %<DataType>:s);');
|
|
value := 'ChildNodes[''%<PropertySourceName>:s''].NodeValue';
|
|
|
|
if Assigned(propertyItem) and (propertyItem.ItemType = itEnumeration) then
|
|
begin
|
|
sourceCode.Add('begin');
|
|
sourceCode.Add(' ' + value + ' := %<PropertyItemName>:sValues[Value]');
|
|
sourceCode.Add('end;');
|
|
sourceCode.AddLn;
|
|
end else
|
|
begin
|
|
if itemProperty.PropertyType <> ptSimple then
|
|
raise Exception.Create('Setter must be a simple type');
|
|
|
|
sourceCode.Add(NativeDataTypeToXML(value, 'Value',
|
|
TXMLDataBindingSimpleProperty(itemProperty).DataType));
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
propertyItemName := '';
|
|
if Assigned(propertyItem) then
|
|
propertyItemName := propertyItem.TranslatedName;
|
|
|
|
AStream.Write(sourceCode.Format(['Name', AItem.TranslatedName,
|
|
'PropertySourceName', itemProperty.Name,
|
|
'PropertyName', itemProperty.TranslatedName,
|
|
'PropertyItemName', propertyItemName,
|
|
'DataType', dataTypeName]));
|
|
finally
|
|
FreeAndNil(sourceCode);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if ASection = dxsClass then
|
|
WriteAfterConstruction();
|
|
end;
|
|
|
|
|
|
procedure TDelphiXMLDataBindingGenerator.WriteSchemaCollection(AStream: TStreamHelper; AItem: TXMLDataBindingCollection; ASection: TDelphiXMLSection);
|
|
begin
|
|
if not Assigned(AItem.CollectionItem) then
|
|
Exit;
|
|
|
|
case ASection of
|
|
dxsForward:
|
|
AStream.WriteLnNamedFmt(InterfaceItemForward,
|
|
['Name',
|
|
AItem.TranslatedName]);
|
|
dxsInterface:
|
|
begin
|
|
AStream.WriteLnNamedFmt(InterfaceItemInterface,
|
|
['Name', AItem.TranslatedName,
|
|
'ParentName', CollectionInterface]);
|
|
AStream.WriteLn(' ' + CreateNewGUID());
|
|
|
|
WriteSchemaCollectionProperties(AStream, AItem, ASection);
|
|
|
|
AStream.WriteLn(' end;');
|
|
AStream.WriteLn();
|
|
end;
|
|
dxsClass:
|
|
begin
|
|
AStream.WriteLnNamedFmt(InterfaceItemClass,
|
|
['Name', AItem.TranslatedName,
|
|
'ParentName', CollectionClass]);
|
|
|
|
WriteSchemaCollectionProperties(AStream, AItem, ASection);
|
|
|
|
AStream.WriteLn(' end;');
|
|
AStream.WriteLn();
|
|
end;
|
|
dxsImplementation:
|
|
begin
|
|
WriteSchemaCollectionProperties(AStream, AItem, ASection);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TDelphiXMLDataBindingGenerator.WriteSchemaCollectionProperties(AStream: TStreamHelper; AItem: TXMLDataBindingCollection; ASection: TDelphiXMLSection);
|
|
var
|
|
dataIntfName: string;
|
|
dataTypeName: string;
|
|
dataClassName: string;
|
|
sourceCode: TNamedFormatStringList;
|
|
typeDef: IXMLTypeDef;
|
|
|
|
begin
|
|
if ASection = dxsClass then
|
|
AStream.WriteLn(' protected');
|
|
|
|
// #ToDo1 (MvR) 17-3-2008: DataType for enumerations
|
|
case AItem.CollectionItem.PropertyType of
|
|
ptSimple:
|
|
begin
|
|
dataTypeName := TranslateDataType(TXMLDataBindingSimpleProperty(AItem.CollectionItem).DataType);
|
|
dataClassName := 'TXMLNode';
|
|
dataIntfName := 'IXMLNode';
|
|
end;
|
|
ptItem:
|
|
begin
|
|
dataTypeName := PrefixInterface + AItem.CollectionItem.TranslatedName;
|
|
dataClassName := PrefixClass + AItem.CollectionItem.TranslatedName;
|
|
dataIntfName := dataTypeName;
|
|
end;
|
|
end;
|
|
|
|
sourceCode := TNamedFormatStringList.Create();
|
|
try
|
|
case ASection of
|
|
dxsInterface,
|
|
dxsClass:
|
|
begin
|
|
sourceCode.Add(' function Get_%<ItemName>:s(Index: Integer): %<DataType>:s;');
|
|
|
|
case AItem.CollectionItem.PropertyType of
|
|
ptSimple:
|
|
begin
|
|
sourceCode.Add(' function Add(%<ItemName>:s: %<DataType>:s): %<DataInterface>:s;');
|
|
sourceCode.Add(' function Insert(Index: Integer; %<ItemName>:s: %<DataType>:s): %<DataInterface>:s;');
|
|
end;
|
|
|
|
ptItem:
|
|
begin
|
|
sourceCode.Add(' function Add: %<DataType>:s;');
|
|
sourceCode.Add(' function Insert(Index: Integer): %<DataType>:s;');
|
|
end;
|
|
end;
|
|
end;
|
|
dxsImplementation:
|
|
begin
|
|
sourceCode.Add('procedure TXML%<Name>:s.AfterConstruction;');
|
|
sourceCode.Add('begin');
|
|
sourceCode.Add(' RegisterChildNode(''%<ItemSourceName>:s'', %<DataClass>:s);');
|
|
sourceCode.AddLn;
|
|
sourceCode.Add(' ItemTag := ''%<ItemSourceName>:s'';');
|
|
sourceCode.Add(' ItemInterface := %<DataInterface>:s;');
|
|
sourceCode.AddLn;
|
|
sourceCode.Add(' inherited;');
|
|
sourceCode.Add('end;');
|
|
sourceCode.AddLn;
|
|
|
|
|
|
case AItem.CollectionItem.PropertyType of
|
|
ptSimple:
|
|
begin
|
|
typeDef := TXMLDataBindingSimpleProperty(AItem.CollectionItem).DataType;
|
|
|
|
// #ToDo1 (MvR) 19-3-2008: .Text for strings ?
|
|
sourceCode.Add('function TXML%<Name>:s.Get_%<ItemName>:s(Index: Integer): %<DataType>:s;');
|
|
sourceCode.Add(XMLToNativeDataType('Result', 'List[Index].NodeValue', typeDef));
|
|
sourceCode.AddLn;
|
|
|
|
sourceCode.Add('function TXML%<Name>:s.Add(%<ItemName>:s: %<DataType>:s): %<DataInterface>:s;');
|
|
sourceCode.Add(NativeDataTypeToXML('Result.NodeValue', '%<ItemName>:s', typeDef,
|
|
' Result := AddItem(-1);'));
|
|
sourceCode.AddLn;
|
|
|
|
sourceCode.Add('function TXML%<Name>:s.Insert(Index: Integer; %<ItemName>:s: %<DataType>:s): %<DataInterface>:s;');
|
|
sourceCode.Add(NativeDataTypeToXML('Result.NodeValue', '%<ItemName>:s', typeDef,
|
|
' Result := AddItem(Index);'));
|
|
sourceCode.AddLn;
|
|
end;
|
|
|
|
|
|
ptItem:
|
|
begin
|
|
sourceCode.Add('function TXML%<Name>:s.Get_%<ItemName>:s(Index: Integer): %<DataType>:s;');
|
|
sourceCode.Add('begin');
|
|
sourceCode.Add(' Result := (List[Index] as %<DataType>:s);');
|
|
sourceCode.Add('end;');
|
|
sourceCode.AddLn;
|
|
|
|
sourceCode.Add('function TXML%<Name>:s.Add: %<DataType>:s;');
|
|
sourceCode.Add('begin');
|
|
sourceCode.Add(' Result := (AddItem(-1) as %<DataType>:s);');
|
|
sourceCode.Add('end;');
|
|
sourceCode.AddLn;
|
|
|
|
sourceCode.Add('function TXML%<Name>:s.Insert(Index: Integer): %<DataType>:s;');
|
|
sourceCode.Add('begin');
|
|
sourceCode.Add(' Result := (AddItem(Index) as %<DataType>:s);');
|
|
sourceCode.Add('end;');
|
|
sourceCode.AddLn;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
case ASection of
|
|
dxsInterface:
|
|
begin
|
|
sourceCode.AddLn;
|
|
sourceCode.Add(' property %<ItemName>:s[Index: Integer]: %<DataType>:s read Get_%<ItemName>:s; default;');
|
|
end;
|
|
|
|
dxsClass:
|
|
begin
|
|
sourceCode.Add(' public');
|
|
sourceCode.Add(' procedure AfterConstruction; override;');
|
|
end;
|
|
end;
|
|
|
|
AStream.Write(sourceCode.Format(['Name', AItem.TranslatedName,
|
|
'ItemName', AItem.CollectionItem.TranslatedName,
|
|
'ItemSourceName', AItem.CollectionItem.Name,
|
|
'DataType', dataTypeName,
|
|
'DataClass', dataClassName,
|
|
'DataInterface', dataIntfName]));
|
|
finally
|
|
FreeAndNil(sourceCode);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TDelphiXMLDataBindingGenerator.WriteSchemaEnumeration(AStream: TStreamHelper; AItem: TXMLDataBindingEnumeration; ASection: TDelphiXMLSection);
|
|
var
|
|
memberIndex: Integer;
|
|
enumStart: String;
|
|
lineIndent: String;
|
|
|
|
begin
|
|
if (ASection <> dxsForward) or (AItem.MemberCount = 0) then
|
|
exit;
|
|
|
|
enumStart := NamedFormat(' TXML%<Name>:s = (',
|
|
['Name', AItem.TranslatedName]);
|
|
AStream.Write(enumStart);
|
|
lineIndent := StringOfChar(' ', Length(enumStart));
|
|
|
|
for memberIndex := 0 to Pred(AItem.MemberCount) do
|
|
begin
|
|
if memberIndex > 0 then
|
|
AStream.Write(lineIndent);
|
|
|
|
AStream.Write(AItem.Members[memberIndex].TranslatedName);
|
|
|
|
if memberIndex < Pred(AItem.MemberCount) then
|
|
AStream.WriteLn(',')
|
|
else
|
|
AStream.WriteLn(');');
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TDelphiXMLDataBindingGenerator.WriteSchemaEnumerationArray(AStream: TStreamHelper; AItem: TXMLDataBindingEnumeration);
|
|
var
|
|
memberIndex: Integer;
|
|
enumStart: String;
|
|
lineIndent: String;
|
|
|
|
begin
|
|
if (AItem.MemberCount = 0) then
|
|
exit;
|
|
|
|
enumStart := NamedFormat(' %<Name>:sValues: ', ['Name', AItem.TranslatedName]);
|
|
AStream.WriteLn(enumStart + NamedFormat('array[TXML%<Name>:s] of WideString =',
|
|
['Name', AItem.TranslatedName]));
|
|
|
|
lineIndent := StringOfChar(' ', Length(enumStart));
|
|
|
|
AStream.WriteLn(lineIndent + '(');
|
|
|
|
for memberIndex := 0 to Pred(AItem.MemberCount) do
|
|
begin
|
|
AStream.Write(NamedFormat('%<Indent>:s ''%<Name>:s''',
|
|
['Indent', lineIndent,
|
|
'Name', AItem.Members[memberIndex].Name]));
|
|
|
|
if memberIndex < Pred(AItem.MemberCount) then
|
|
AStream.WriteLn(',')
|
|
else
|
|
AStream.WriteLn();
|
|
end;
|
|
|
|
AStream.WriteLn(lineIndent + ');');
|
|
AStream.WriteLn();
|
|
end;
|
|
|
|
|
|
function TDelphiXMLDataBindingGenerator.DataTypeConversion(const ADestination, ASource: string; ADataType: IXMLTypeDef; AToNative: Boolean; const ALinesBefore: string): string;
|
|
var
|
|
typeMapping: TTypeMapping;
|
|
|
|
begin
|
|
with TNamedFormatStringList.Create() do
|
|
try
|
|
if not GetDataTypeMapping(ADataType, typeMapping) then
|
|
typeMapping.Conversion := tcNone;
|
|
|
|
|
|
if Length(TypeConversionVariables[typeMapping.Conversion]) > 0 then
|
|
begin
|
|
Add('var');
|
|
Add(TypeConversionVariables[typeMapping.Conversion]);
|
|
end;
|
|
|
|
Add('begin');
|
|
|
|
if Length(ALinesBefore) > 0 then
|
|
Add(ALinesBefore);
|
|
|
|
if AToNative then
|
|
Add(TypeConversionToNative[typeMapping.Conversion])
|
|
else
|
|
Add(TypeConversionToXML[typeMapping.Conversion]);
|
|
|
|
Add('end;');
|
|
|
|
Result := Format(['Destination', ADestination,
|
|
'Source', ASource]);
|
|
finally
|
|
Free();
|
|
end;
|
|
end;
|
|
|
|
|
|
function TDelphiXMLDataBindingGenerator.XMLToNativeDataType(const ADestination, ASource: string; ADataType: IXMLTypeDef; const ALinesBefore: string): string;
|
|
begin
|
|
Result := DataTypeConversion(ADestination, ASource, ADataType, True, ALinesBefore);
|
|
end;
|
|
|
|
|
|
function TDelphiXMLDataBindingGenerator.NativeDataTypeToXML(const ADestination, ASource: string; ADataType: IXMLTypeDef; const ALinesBefore: string): string;
|
|
begin
|
|
Result := DataTypeConversion(ADestination, ASource, ADataType, False, ALinesBefore);
|
|
end;
|
|
|
|
|
|
function TDelphiXMLDataBindingGenerator.CreateNewGUID(): String;
|
|
var
|
|
guid: TGUID;
|
|
|
|
begin
|
|
Result := '{ GUID generation failed }';
|
|
if CreateGUID(guid) = S_OK then
|
|
Result := '[''' + GUIDToString(guid) + ''']';
|
|
end;
|
|
|
|
|
|
function TDelphiXMLDataBindingGenerator.DoGetFileName(const ASchemaName: String): String;
|
|
begin
|
|
Result := OutputPath;
|
|
|
|
if OutputType = otMultiple then
|
|
begin
|
|
Result := IncludeTrailingPathDelimiter(Result) + ASchemaName + '.pas';
|
|
if Assigned(FOnGetFileName) then
|
|
FOnGetFileName(Self, ASchemaName, Result);
|
|
end;
|
|
end;
|
|
|
|
end.
|
|
|
|
|