mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 06:08:22 +02:00
716 lines
21 KiB
ObjectPascal
716 lines
21 KiB
ObjectPascal
{
|
|
|
|
FPDoc - Free Pascal Documentation Tool
|
|
Copyright (C) 2000 - 2003 by
|
|
Areca Systems GmbH / Sebastian Guenther, sg@freepascal.org
|
|
2005-2012 by
|
|
various FPC contributors
|
|
|
|
* 'XML struct' output generator
|
|
|
|
See the file COPYING, included in this distribution,
|
|
for details about the copyright.
|
|
|
|
This program 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.
|
|
}
|
|
{$mode objfpc}
|
|
{$H+}
|
|
|
|
|
|
unit dw_XML;
|
|
|
|
interface
|
|
|
|
uses DOM, PasTree, dGlobals, dwriter, xmlWrite, SysUtils, Classes;
|
|
|
|
Type
|
|
|
|
{ TXMLWriter }
|
|
|
|
TXMLWriter = Class(TMultiFileDocWriter)
|
|
private
|
|
FShowSourceInfo:Boolean;
|
|
FUseFlatStructure:Boolean;
|
|
protected
|
|
function CreateAllocator : TFileAllocator; override;
|
|
procedure AllocatePackagePages; override;
|
|
procedure AllocateModulePages(AModule: TPasModule; {%H-}LinkList: TObjectList); override;
|
|
procedure WriteDocPage(const aFileName: String; aElement: TPasElement; {%H-}aSubPageIndex: Integer); override;
|
|
// Here we write the documentation.
|
|
Procedure DoWriteDocumentation; override;
|
|
public
|
|
constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); override;
|
|
function ModuleToXMLStruct(AModule: TPasModule): TXMLDocument;
|
|
class procedure Usage(List: TStrings); override;
|
|
function InterPretOption(const Cmd,Arg : String): boolean; override;
|
|
end;
|
|
|
|
{ TFlatFileAllocator }
|
|
|
|
TFlatFileAllocator = class(TFileAllocator)
|
|
private
|
|
FExtension: String;
|
|
public
|
|
constructor Create(const AExtension: String);
|
|
function GetFilename(AElement: TPasElement; ASubindex: Integer): String; override;
|
|
function GetRelativePathToTop(AElement: TPasElement): String; override;
|
|
property Extension: String read FExtension;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
uses fpdocstrs;
|
|
|
|
const
|
|
DefaultVisibility = [visDefault, visPublic, visPublished, visProtected];
|
|
|
|
{ TXmlFileAllocator }
|
|
|
|
constructor TFlatFileAllocator.Create(const AExtension: String);
|
|
begin
|
|
FExtension:= AExtension;
|
|
inherited Create();
|
|
end;
|
|
|
|
function TFlatFileAllocator.GetFilename(AElement: TPasElement; ASubindex: Integer
|
|
): String;
|
|
begin
|
|
Result:='';
|
|
if AElement.ClassType = TPasPackage then
|
|
Result := 'index'
|
|
else if AElement.ClassType = TPasModule then
|
|
Result := LowerCase(AElement.Name);
|
|
|
|
if ASubindex > 0 then
|
|
Result := Result + '-' + GetFilePostfix(ASubindex);
|
|
Result := Result + Extension;
|
|
end;
|
|
|
|
function TFlatFileAllocator.GetRelativePathToTop(AElement: TPasElement): String;
|
|
begin
|
|
Result:=inherited GetRelativePathToTop(AElement);
|
|
end;
|
|
|
|
function TXMLWriter.ModuleToXMLStruct(AModule: TPasModule): TXMLDocument;
|
|
|
|
var
|
|
ModuleElement: TDOMElement;
|
|
Doc: TXMLDocument absolute Result;
|
|
|
|
function VisibilityToString(vis: TPasMemberVisibility): String;
|
|
begin
|
|
case vis of
|
|
visDefault : Result := '';
|
|
visPrivate : Result := 'private';
|
|
visProtected : Result := 'protected';
|
|
visPublic : Result := 'public';
|
|
visPublished : Result := 'published';
|
|
visAutomated : Result := 'automated';
|
|
visStrictPrivate : Result := 'strictprivate';
|
|
visStrictProtected : Result := 'strictprotected';
|
|
visRequired : Result := 'required';
|
|
visOptional : Result := 'optional';
|
|
end;
|
|
end;
|
|
|
|
function Sanitize(AString: String): String;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := AString;
|
|
for i := 1 to length(Result) do
|
|
if Result[i] in [' '] then
|
|
Result[i] := '_';
|
|
end;
|
|
|
|
procedure AddSourceInfo(ADecl: TPasElement; AElement: TDOMElement);
|
|
var
|
|
SourceNode: TDOMElement;
|
|
begin
|
|
if not FShowSourceInfo then
|
|
Exit;
|
|
SourceNode := Doc.CreateElement('source');
|
|
SourceNode['line'] := UTF8Decode(IntToStr(ADecl.SourceLinenumber));
|
|
SourceNode['file'] := UTF8Decode(ADecl.SourceFilename);
|
|
AElement.AppendChild(SourceNode);
|
|
end;
|
|
|
|
procedure AddProcedureModifiers(ADecl: TPasProcedure; Node: TDOMElement);
|
|
begin
|
|
{pmVirtual , pmDynamic, pmAbstract, pmOverride,
|
|
pmExport, pmOverload, pmMessage, pmReintroduce,
|
|
pmStatic,pmInline,pmAssembler,pmVarargs, pmPublic,
|
|
pmCompilerProc,pmExternal,pmForward}
|
|
|
|
if (pmVirtual in ADecl.Modifiers) or (pmDynamic in ADecl.Modifiers) then
|
|
Node['virtual'] := 'true';
|
|
if pmAbstract in ADecl.Modifiers then
|
|
Node['abstract'] := 'true';
|
|
if assigned(ADecl.ProcType) and (ptmStatic in ADecl.ProcType.Modifiers) then
|
|
Node['static'] := 'true';
|
|
if pmReintroduce in ADecl.Modifiers then
|
|
Node['reintroduce'] := 'true';
|
|
if pmOverload in ADecl.Modifiers then
|
|
Node['overload'] := 'true';
|
|
if pmForward in ADecl.Modifiers then
|
|
Node['forward'] := 'true';
|
|
if pmOverride in ADecl.Modifiers then
|
|
Node['override'] := 'true';
|
|
end;
|
|
|
|
procedure AddTypeNode(ToNode: TDOMElement; AType: String);
|
|
begin
|
|
ToNode.AttribStrings['type'] := UTF8Decode(AType);
|
|
end;
|
|
|
|
function AddTypeNode(ToNode: TDOMElement; AType: TPasType): Boolean;
|
|
//var
|
|
// TypeNode: TDOMElement;
|
|
begin
|
|
Result := False;
|
|
if not Assigned(AType) then
|
|
Exit;
|
|
//TypeNode := Doc.CreateElement('type');
|
|
//TypeNode.TextContent:=AType.Name;
|
|
//ToNode.AppendChild(TypeNode);
|
|
AddTypeNode(ToNode, AType.Name);
|
|
Result := True;
|
|
end;
|
|
|
|
procedure ProcessArgs(Args: TFPList; ProcNode: TDomElement);
|
|
var
|
|
i: Integer;
|
|
ArgNode: TDOMElement;
|
|
Arg: TPasArgument;
|
|
begin
|
|
for i := 0 to Args.Count-1 do
|
|
begin
|
|
Arg := TPasArgument(Args.Items[i]);
|
|
ArgNode := Doc.CreateElement('argument');
|
|
ArgNode.AttribStrings['name'] := UTF8Decode(Arg.Name);
|
|
AddTypeNode(ArgNode, Arg.ArgType);
|
|
ProcNode.AppendChild(ArgNode);
|
|
end;
|
|
end;
|
|
|
|
procedure DoVisibility(PasEl: TPasElement; Element: TDOMElement);
|
|
begin
|
|
if PasEl.Visibility <> visDefault then
|
|
Element['visibility'] := UTF8Decode(VisibilityToString(PasEl.Visibility));
|
|
end;
|
|
|
|
function ProcessProcedure(Proc: TPasProcedure; Element: TDOMElement): TDOMElement;
|
|
var
|
|
ProcEl: TDOMElement;
|
|
ReturnEl: TDOMElement;
|
|
begin
|
|
Result := nil;
|
|
ProcEl := Doc.CreateElement(UTF8Decode(Sanitize(Proc.TypeName)));
|
|
Element.AppendChild(ProcEl);
|
|
ProcEl['name'] := UTF8Decode(Proc.Name);
|
|
|
|
DoVisibility(Proc, ProcEl);
|
|
|
|
AddProcedureModifiers(Proc, ProcEl);
|
|
AddSourceInfo(Proc,ProcEl);
|
|
|
|
if Proc.InheritsFrom(TPasFunction) then
|
|
begin
|
|
ReturnEl := Doc.CreateElement('return');
|
|
ProcEl.AppendChild(ReturnEl);
|
|
AddTypeNode(ReturnEl, TPasFunction(Proc).FuncType.ResultEl.ResultType);
|
|
end;
|
|
|
|
ProcessArgs(Proc.ProcType.Args, ProcEl);
|
|
|
|
Result := ProcEl;
|
|
end;
|
|
|
|
procedure ProcessArrayType(AType: TPasArrayType; Element: TDOMElement);
|
|
var
|
|
TypeEl: TDOMElement;
|
|
begin
|
|
TypeEl := Doc.CreateElement('array');
|
|
TypeEl['name'] := UTF8Decode(AType.Name);
|
|
if not AddTypeNode(TypeEl, AType.ElType) then
|
|
TypeEl['const'] := 'true';
|
|
TypeEl['range'] := UTF8Decode(AType.IndexRange);
|
|
DoVisibility(AType, Element);
|
|
AddSourceInfo(AType,Element);
|
|
Element.AppendChild(TypeEl);
|
|
end;
|
|
|
|
procedure ProcessPointerType(AType: TPasPointerType; Element: TDOMElement);
|
|
var
|
|
TypeEl: TDOMElement;
|
|
begin
|
|
TypeEl := Doc.CreateElement('pointer');
|
|
TypeEl['name'] := UTF8Decode(AType.Name);
|
|
AddTypeNode(TypeEl, AType.DestType);
|
|
DoVisibility(AType, Element);
|
|
AddSourceInfo(AType,Element);
|
|
|
|
Element.AppendChild(TypeEl);
|
|
end;
|
|
|
|
procedure ProcessAliasType(AType: TPasAliasType; Element: TDOMElement);
|
|
var
|
|
TypeEl: TDOMElement;
|
|
begin
|
|
TypeEl := Doc.CreateElement('alias');
|
|
TypeEl['name'] := UTF8Decode(AType.Name);
|
|
AddTypeNode(TypeEl, AType.DestType);
|
|
DoVisibility(AType, Element);
|
|
AddSourceInfo(AType,Element);
|
|
Element.AppendChild(TypeEl);
|
|
end;
|
|
|
|
procedure ProcessVariable(AVar: TPasVariable; Element: TDOMElement);
|
|
var
|
|
VarEl: TDOMElement;
|
|
begin
|
|
VarEl := Result.CreateElement('var');
|
|
Element.AppendChild(VarEl);
|
|
VarEl['name'] := UTF8Decode(AVar.Name);
|
|
if not AVar.VarType.InheritsFrom(TPasArrayType) then
|
|
AddTypeNode(VarEl, AVar.VarType)
|
|
else
|
|
begin
|
|
VarEl['array'] := 'true';
|
|
ProcessArrayType(TPasArrayType(AVar.VarType), VarEl);
|
|
end;
|
|
DoVisibility(Avar, VarEl);
|
|
AddSourceInfo(AVar,VarEl);
|
|
end;
|
|
|
|
procedure ProcessProperty(AProp: TPasProperty; Element: TDOMElement);
|
|
var
|
|
PropEl: TDOMElement;
|
|
begin
|
|
PropEl := Doc.CreateElement('property');
|
|
Element.AppendChild(PropEl);
|
|
|
|
PropEl.AttribStrings['name'] := UTF8Decode(AProp.Name);
|
|
AddTypeNode(PropEL, AProp.ResolvedType);
|
|
|
|
if AProp.IndexValue <> '' then
|
|
PropEl['index'] := UTF8Decode(AProp.IndexValue);
|
|
|
|
if AProp.DefaultValue <> '' then
|
|
PropEl['default'] := UTF8Decode(AProp.DefaultValue);
|
|
|
|
|
|
if AProp.WriteAccessorName <> '' then
|
|
PropEl.AttribStrings['writable'] := 'true';
|
|
|
|
ProcessArgs(AProp.Args, PropEl);
|
|
DoVisibility(AProp, Element);
|
|
AddSourceInfo(AProp,PropEl);
|
|
|
|
// this isn't quite right
|
|
//if AProp.ReadAccessorName = '' then
|
|
// PropEl.AttribStrings['inherited'] := 'true';
|
|
end;
|
|
|
|
procedure ProcessOverloadedProcedure(AOverload: TPasOverloadedProc; Element: TDOMElement);
|
|
var
|
|
OverEl: TDOMElement;
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to AOverload.Overloads.Count-1 do
|
|
begin
|
|
OverEl := ProcessProcedure(TPasProcedure(AOverload.Overloads.Items[i]), Element);
|
|
OverEl['overload'] := 'true';
|
|
end;
|
|
end;
|
|
|
|
procedure ProcessConst(AConst: TPasConst; Element: TDOMElement);
|
|
var
|
|
ConstEl: TDOMElement;
|
|
begin
|
|
ConstEl := Doc.CreateElement('const');
|
|
ConstEl['name'] := UTF8Decode(AConst.name);
|
|
ConstEl['value'] := UTF8Decode(AConst.Value);
|
|
Element.AppendChild(ConstEl);
|
|
AddSourceInfo(AConst,ConstEl);
|
|
end;
|
|
|
|
procedure ProcessEnumType(AType: TPasEnumType; Element: TDOMElement);
|
|
var
|
|
TypeEl: TDOMElement;
|
|
ValEl: TDOMELement;
|
|
i: Integer;
|
|
begin
|
|
TypeEl := Doc.CreateElement('enum');
|
|
TypeEl['name'] := UTF8Decode(AType.name);
|
|
AddSourceInfo(AType,TypeEl);
|
|
//ConstEl['value'] := AConst.Value;
|
|
for i := 0 to AType.Values.Count-1 do
|
|
begin
|
|
ValEl := Doc.CreateElement('enumvalue');
|
|
ValEl['name'] := UTF8Decode(TPasEnumValue(AType.Values.Items[i]).Name);
|
|
AddSourceInfo(TPasEnumValue(AType.Values.Items[i]),ValEl);
|
|
TypeEl.AppendChild(ValEl);
|
|
|
|
end;
|
|
Element.AppendChild(TypeEl);
|
|
end;
|
|
|
|
procedure ProcessSetType(AType: TPasSetType; Element: TDOMElement);
|
|
var
|
|
SetEl: TDOMElement;
|
|
begin
|
|
SetEl := Doc.CreateElement('set');
|
|
SetEl['name'] := UTF8Decode(AType.name);
|
|
AddTypeNode(SetEl, AType.EnumType);
|
|
AddSourceInfo(AType,SetEl);
|
|
Element.AppendChild(SetEl);
|
|
end;
|
|
|
|
procedure ProcessProcedureType(AType: TPasProcedureType; Element: TDOMElement);
|
|
var
|
|
TypeEl: TDOMElement;
|
|
begin
|
|
TypeEl := Doc.CreateElement(UTF8Decode(AType.TypeName));
|
|
TypeEl['name'] := UTF8Decode(AType.name);
|
|
TypeEl['istype'] := 'true';
|
|
if AType.IsOfObject then
|
|
TypeEl['object'] := 'true';
|
|
ProcessArgs(AType.Args, TypeEl);
|
|
AddSourceInfo(AType,TypeEl);
|
|
Element.AppendChild(TypeEl);
|
|
end;
|
|
|
|
procedure ProcessRecordType(AType: TPasRecordType; Element: TDOMElement);
|
|
var
|
|
TypeEl: TDOMElement;
|
|
Decl: TPasElement;
|
|
i: Integer;
|
|
begin
|
|
TypeEl := Doc.CreateElement('record');
|
|
TypeEl['name'] := UTF8Decode(AType.name);
|
|
|
|
Element.AppendChild(TypeEl);
|
|
AddSourceInfo(AType,TypeEl);
|
|
|
|
if Assigned(AType.Members) then
|
|
for i := 0 to AType.Members.Count - 1 do
|
|
begin
|
|
Decl := TPasElement(AType.Members[i]);
|
|
if Decl.InheritsFrom(TPasProcedure)then
|
|
ProcessProcedure(TPasProcedure(Decl), TypeEl)
|
|
else if Decl.ClassType = TPasVariable then
|
|
ProcessVariable(TPasVariable(Decl), TypeEl)
|
|
else if Decl.ClassType = TPasProperty then
|
|
ProcessProperty(TPasProperty(Decl), TypeEl)
|
|
else writeln('Unhandled record member: ', Decl.ClassName, ' ', Decl.Name);
|
|
end;
|
|
end;
|
|
|
|
procedure ProcessGenericTypes(AGenericTypes: TFPList; ANode: TDOMElement);
|
|
var
|
|
i: Integer;
|
|
Node: TDOMElement;
|
|
begin
|
|
for i := 0 to AGenericTypes.Count-1 do
|
|
begin
|
|
Node := Doc.CreateElement('t');
|
|
Node['name'] := UTF8Decode(TPasGenericTemplateType(AGenericTypes.Items[i]).Name);
|
|
ANode.AppendChild(Node);
|
|
AddSourceInfo(TPasGenericTemplateType(AGenericTypes.Items[i]),Node);
|
|
end;
|
|
end;
|
|
|
|
procedure ProcessRangeType(AType: TPasRangeType; Element: TDOMElement);
|
|
var
|
|
TypeEl: TDOMElement;
|
|
begin
|
|
TypeEl := Doc.CreateElement('range');
|
|
TypeEl['name'] := UTF8Decode(AType.Name);
|
|
TypeEl['start'] := UTF8Decode(AType.RangeStart);
|
|
TypeEl['end'] := UTF8Decode(AType.RangeEnd);
|
|
AddSourceInfo(AType,TypeEl);
|
|
|
|
Element.AppendChild(TypeEl);
|
|
|
|
end;
|
|
|
|
procedure ProcessClassType(AClass: TPasClassType; Element: TDOMElement); forward;
|
|
|
|
function ProcessType(AType: TPasElement; Element: TDOMElement): Boolean;
|
|
begin
|
|
Result := True;
|
|
if AType.ClassType = TPasVariable then
|
|
ProcessVariable(TPasVariable(AType), Element)
|
|
else if AType.ClassType = TPasProperty then
|
|
ProcessProperty(TPasProperty(AType), Element)
|
|
else if AType.InheritsFrom(TPasOverloadedProc) then
|
|
ProcessOverloadedProcedure(TPasOverloadedProc(AType), Element)
|
|
else if AType.InheritsFrom(TPasConst) then
|
|
ProcessConst(TPasConst(AType), Element)
|
|
else if AType.InheritsFrom(TPasEnumType) then
|
|
ProcessEnumType(TPasEnumType(AType), Element)
|
|
else if AType.InheritsFrom(TPasClassType) then
|
|
ProcessClassType(TPasClassType(AType), Element)
|
|
else if AType.InheritsFrom(TPasAliasType) then
|
|
ProcessAliasType(TPasAliasType(AType), Element)
|
|
else if AType.InheritsFrom(TPasSetType) then
|
|
ProcessSetType(TPasSetType(AType), Element)
|
|
else if AType.InheritsFrom(TPasProcedureType) then
|
|
ProcessProcedureType(TPasProcedureType(AType), Element)
|
|
else if AType.InheritsFrom(TPasRecordType) then
|
|
ProcessRecordType(TPasRecordType(AType), Element)
|
|
else if AType.InheritsFrom(TPasArrayType) then
|
|
ProcessArrayType(TPasArrayType(AType), Element)
|
|
else if AType.InheritsFrom(TPasPointerType) then
|
|
ProcessPointerType(TPasPointerType(AType), Element)
|
|
else if AType.InheritsFrom(TPasRangeType) then
|
|
ProcessRangeType(TPasRangeType(AType), Element)
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
procedure ProcessClassType(AClass: TPasClassType; Element: TDOMElement);
|
|
var
|
|
ClassEl: TDOMElement = nil;
|
|
i: Integer;
|
|
Decl: TPasElement;
|
|
SubNode: TDomElement;
|
|
InterfaceEl: TDomElement;
|
|
Vis: TPasMemberVisibilities = DefaultVisibility;
|
|
begin
|
|
if not Engine.HidePrivate then Include(Vis, visPrivate);
|
|
if Engine.HideProtected then Exclude(Vis, visProtected);
|
|
case AClass.ObjKind of
|
|
okClass: ClassEl := Result.CreateElement('class');
|
|
okObject: ClassEl := Result.CreateElement('object');
|
|
okInterface: ClassEl := Result.CreateElement('interface');
|
|
//okGeneric: Result.CreateElement('generic');
|
|
//okClassHelper: Result.CreateElement('classhelper');
|
|
//okRecordHelper: Result.CreateElement('recordhelper');
|
|
//okTypeHelper: Result.CreateElement('typehelper');
|
|
|
|
else
|
|
//raise Exception.Create('ProcessClass: unknown class kind');
|
|
WriteLn('Unhandled Class kind: ', AClass.ObjKind);
|
|
end;
|
|
|
|
if Assigned(ClassEl) then
|
|
begin
|
|
Element.AppendChild(ClassEl);
|
|
ClassEl['name'] := UTF8Decode(AClass.Name);
|
|
if Assigned(AClass.AncestorType) then
|
|
ClassEl['parentclass'] := UTF8Decode(AClass.AncestorType.Name);
|
|
|
|
AddSourceInfo(AClass,ClassEl);
|
|
|
|
if Assigned(AClass.Interfaces) then
|
|
for i := 0 to AClass.Interfaces.Count-1 do
|
|
begin
|
|
InterfaceEl := Doc.CreateElement('interface');
|
|
ClassEl.AppendChild(InterfaceEl);
|
|
InterfaceEl['name'] := UTF8Decode(TPasElement(AClass.Interfaces.Items[i]).Name);
|
|
end;
|
|
|
|
if Assigned(AClass.Members) then
|
|
for i := 0 to AClass.Members.Count - 1 do
|
|
begin
|
|
Decl := TPasElement(AClass.Members[i]);
|
|
if not (Decl.Visibility in Vis) then
|
|
continue;
|
|
if Decl.InheritsFrom(TPasProcedure)then
|
|
begin
|
|
SubNode := ProcessProcedure(TPasProcedure(Decl), ClassEl);
|
|
if Assigned(SubNode) then
|
|
begin
|
|
if SubNode.InheritsFrom(TPasClassConstructor) then
|
|
SubNode.SetAttribute('type', 'constructor')
|
|
else if SubNode.InheritsFrom(TPasClassDestructor) then
|
|
SubNode.SetAttribute('type', 'destructor');
|
|
end;
|
|
end
|
|
else if not ProcessType(Decl, ClassEl) then
|
|
writeln('Unhandled class member: ', Decl.ClassName, ' ', Decl.Name);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function FindInList(AName: String; AList: TFPList): Boolean;
|
|
var
|
|
El: TPasElement;
|
|
I: Integer;
|
|
begin
|
|
Result := False;
|
|
I := 0;
|
|
while not Result and (I < AList.Count) do
|
|
begin
|
|
El := TPasElement(AList[I]);
|
|
if El.Name = AName then
|
|
Result := True;
|
|
Inc(I);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure ProcessSection(ASection: TPasSection; const Name: DOMString);
|
|
var
|
|
Element, UsesElement, UnitElement: TDOMElement;
|
|
i: Integer;
|
|
Decl: TPasElement;
|
|
begin
|
|
Element := Result.CreateElement(Name);
|
|
ModuleElement.AppendChild(Element);
|
|
if ASection.UsesList.Count > 0 then
|
|
begin
|
|
UsesElement := Result.CreateElement('uses');
|
|
Element.AppendChild(UsesElement);
|
|
for i := 0 to ASection.UsesList.Count - 1 do
|
|
begin
|
|
UnitElement := Result.CreateElement('unit-ref');
|
|
UnitElement['name'] := UTF8Decode(TPasType(ASection.UsesList[i]).Name);
|
|
UsesElement.AppendChild(UnitElement);
|
|
end;
|
|
end;
|
|
|
|
for i := 0 to ASection.Classes.Count -1 do
|
|
begin
|
|
Decl := TPasElement(ASection.Classes[i]);
|
|
ProcessClassType(TPasClassType(Decl), Element);
|
|
end;
|
|
|
|
for i := 0 to ASection.Consts.Count - 1 do
|
|
begin
|
|
Decl := TPasElement(ASection.Consts[i]);
|
|
ProcessConst(TPasConst(Decl), Element)
|
|
end;
|
|
|
|
for i := 0 to ASection.Types.Count - 1 do
|
|
begin
|
|
Decl := TPasElement(ASection.Types[i]);
|
|
if not ProcessType(Decl, Element) then
|
|
WriteLn('Unhandled type: ',Decl.ClassName, ' ', Decl.Name);
|
|
end;
|
|
|
|
for i := 0 to ASection.Declarations.Count - 1 do
|
|
begin
|
|
Decl := TPasElement(ASection.Declarations[i]);
|
|
if Decl.InheritsFrom(TPasProcedure) then
|
|
ProcessProcedure(TPasProcedure(Decl), Element)
|
|
else if Decl.ClassType = TPasVariable then
|
|
ProcessVariable(TPasVariable(Decl), Element);
|
|
end;
|
|
|
|
for i := 0 to ASection.Functions.Count - 1 do
|
|
begin
|
|
// many of these (all?) seem to be in ASection.Declarations
|
|
Decl := TPasElement(ASection.Functions[i]);
|
|
if FindInList(Decl.Name, ASection.Declarations) then
|
|
WriteLn('Duplicate proc definition in declarations. Skipping: ', Decl.Name)
|
|
else
|
|
WriteLn('Unhandled function: ',Decl.ClassName, ' ', Decl.Name);
|
|
|
|
end;
|
|
|
|
for i := 0 to ASection.Properties.Count - 1 do
|
|
begin
|
|
Decl := TPasElement(ASection.Properties[i]);
|
|
ProcessProperty(TPasProperty(Decl), Element);
|
|
end;
|
|
end;
|
|
|
|
|
|
begin
|
|
Result := TXMLDocument.Create;
|
|
Result.AppendChild(Result.CreateComment(UTF8Decode(SDocGeneratedByComment)));
|
|
Result.AppendChild(Result.CreateElement('fp-refdoc'));
|
|
ModuleElement := Result.CreateElement('unit');
|
|
ModuleElement['name'] := UTF8Decode(AModule.Name);
|
|
Result.DocumentElement.AppendChild(ModuleElement);
|
|
ProcessSection(AModule.InterfaceSection, 'interface');
|
|
end;
|
|
|
|
{ TXMLWriter }
|
|
|
|
procedure TXMLWriter.DoWriteDocumentation;
|
|
begin
|
|
inherited DoWriteDocumentation;
|
|
end;
|
|
|
|
function TXMLWriter.CreateAllocator: TFileAllocator;
|
|
begin
|
|
if FUseFlatStructure then
|
|
Result:=TFlatFileAllocator.Create('.xml')
|
|
else
|
|
Result:=TLongNameFileAllocator.Create('.xml');
|
|
end;
|
|
|
|
procedure TXMLWriter.AllocatePackagePages;
|
|
begin
|
|
AddPage(Package, IdentifierIndex);
|
|
AddPage(Package, ClassHierarchySubIndex);
|
|
AddPage(Package, InterfaceHierarchySubIndex);
|
|
end;
|
|
|
|
procedure TXMLWriter.AllocateModulePages(AModule: TPasModule;
|
|
LinkList: TObjectList);
|
|
begin
|
|
if not assigned(Amodule.Interfacesection) then
|
|
exit;
|
|
AddPage(AModule, IdentifierIndex);
|
|
end;
|
|
|
|
procedure TXMLWriter.WriteDocPage(const aFileName: String;
|
|
aElement: TPasElement; aSubPageIndex: Integer);
|
|
var
|
|
doc: TXMLDocument;
|
|
begin
|
|
if (aElement is TPasModule) then
|
|
begin
|
|
doc := ModuleToXMLStruct(TPasModule(aElement));
|
|
WriteXMLFile(doc, GetFileBaseDir(Engine.Output) + aFileName);
|
|
doc.Free;
|
|
end
|
|
else if (aElement is TPasPackage) then
|
|
begin
|
|
if aSubPageIndex = ClassHierarchySubIndex then
|
|
TreeClass.SaveToXml(GetFileBaseDir(Engine.Output) + aFileName);
|
|
if aSubPageIndex = InterfaceHierarchySubIndex then
|
|
TreeInterface.SaveToXml(GetFileBaseDir(Engine.Output) + aFileName);
|
|
end;
|
|
end;
|
|
|
|
constructor TXMLWriter.Create(APackage: TPasPackage; AEngine: TFPDocEngine);
|
|
begin
|
|
FUseFlatStructure:= False;
|
|
FShowSourceInfo:= False;
|
|
inherited Create(APackage, AEngine);
|
|
end;
|
|
|
|
class procedure TXMLWriter.Usage(List: TStrings);
|
|
begin
|
|
inherited Usage(List);
|
|
List.AddStrings(['--source-info', SXMLUsageSource]);
|
|
List.AddStrings(['--flat-structure', SXMLUsageFlatStructure]);
|
|
end;
|
|
|
|
function TXMLWriter.InterPretOption(const Cmd, Arg: String): boolean;
|
|
begin
|
|
Result := True;
|
|
if Cmd = '--source-info' then
|
|
FShowSourceInfo:=True
|
|
else if Cmd = '--flat-structure' then
|
|
FUseFlatStructure:=True
|
|
else
|
|
Result:=inherited InterPretOption(Cmd, Arg);
|
|
end;
|
|
|
|
initialization
|
|
// Do not localize.
|
|
RegisterWriter(TXMLWriter,'xml','fpdoc XML output.');
|
|
finalization
|
|
UnRegisterWriter('xml');
|
|
end.
|