mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-11 21:29:42 +02:00
* Partially resolved ID 38141 : better handling of class hierarchy and cross-package links
git-svn-id: trunk@47710 -
This commit is contained in:
michael
parent
a7232669ff
commit
9fc390877e
@ -36,9 +36,12 @@ Var
|
||||
resourcestring
|
||||
// Output strings
|
||||
SDocPackageTitle = 'Reference for package ''%s''';
|
||||
SDocPackageMenuTitle = 'Package ''%s''';
|
||||
SDocPackageLinkTitle = 'Package';
|
||||
SDocPrograms = 'Programs';
|
||||
SDocUnits = 'Units';
|
||||
SDocUnitTitle = 'Reference for unit ''%s''';
|
||||
SDocUnitMenuTitle = 'Unit ''%s''';
|
||||
SDocInheritanceHierarchy = 'Inheritance Hierarchy';
|
||||
SDocInterfaceSection = 'Interface section';
|
||||
SDocImplementationSection = 'Implementation section';
|
||||
@ -205,7 +208,9 @@ resourcestring
|
||||
Const
|
||||
SVisibility: array[TPasMemberVisibility] of string =
|
||||
('Default', 'Private', 'Protected', 'Public',
|
||||
'Published', 'Automated','Strict Private','Strict Protected','Required','Optional');
|
||||
'Published', 'Automated','Strict Private','Strict Protected',
|
||||
'Required', 'Optional' // ObjCClass
|
||||
);
|
||||
|
||||
type
|
||||
TBufType = Array[1..ContentBufSize-1] of byte;
|
||||
@ -319,9 +324,9 @@ type
|
||||
FAlwaysVisible : TStringList;
|
||||
DescrDocs: TObjectList; // List of XML documents
|
||||
DescrDocNames: TStringList; // Names of the XML documents
|
||||
FRootLinkNode: TLinkNode;
|
||||
FRootDocNode: TDocNode;
|
||||
FPackages: TFPList; // List of TFPPackage objects
|
||||
FRootLinkNode: TLinkNode; // Global tree of TlinkNode from the imported .xct files
|
||||
FRootDocNode: TDocNode; // Global tree of TDocNode from the .xml documentation files
|
||||
FPackages: TFPList; // Global list of TPasPackage objects and full tree of sources
|
||||
CurModule: TPasModule;
|
||||
CurPackageDocNode: TDocNode;
|
||||
function ParseUsedUnit(AName, AInputLine,AOSTarget,ACPUTarget: String): TPasModule; virtual;
|
||||
@ -338,13 +343,16 @@ type
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure SetPackageName(const APackageName: String);
|
||||
// process the import objects from external .xct file
|
||||
procedure ReadContentFile(const AFilename, ALinkPrefix: String);
|
||||
// creation of an own .xct output file
|
||||
procedure WriteContentFile(const AFilename: String);
|
||||
|
||||
function CreateElement(AClass: TPTreeElement; const AName: String;
|
||||
AParent: TPasElement; AVisibility: TPasMemberVisibility;
|
||||
const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
|
||||
override;
|
||||
function FindInModule(const AName: String ; AModule: TPasModule): TPasElement;
|
||||
function FindElement(const AName: String): TPasElement; override;
|
||||
function FindModule(const AName: String): TPasModule; override;
|
||||
Function HintsToStr(Hints : TPasMemberHints) : String;
|
||||
@ -660,7 +668,9 @@ end;
|
||||
procedure TFPDocEngine.ReadContentFile(const AFilename, ALinkPrefix: String);
|
||||
var
|
||||
f: Text;
|
||||
inheritanceinfo : TStringlist;
|
||||
inheritanceinfo : TStringlist; // contents list of TPasClass with inheritance info
|
||||
// like this #PackageName.ModuleName.ClassName
|
||||
tmpLinkPrefix : string;
|
||||
|
||||
procedure ReadLinkTree;
|
||||
var
|
||||
@ -708,8 +718,10 @@ var
|
||||
i := ThisSpaces + 1;
|
||||
while s[i] <> ' ' do
|
||||
Inc(i);
|
||||
if ALinkPrefix <> '' then
|
||||
tmpLinkPrefix := ExcludeTrailingPathDelimiter(ALinkPrefix)+'/';
|
||||
NewNode := TLinkNode.Create(Copy(s, ThisSpaces + 1, i - ThisSpaces - 1),
|
||||
ALinkPrefix + Copy(s, i + 1, Length(s)));
|
||||
tmpLinkPrefix + Copy(s, i + 1, Length(s)));
|
||||
if pos(' ',newnode.link)>0 then
|
||||
writeln(stderr,'Bad format imported node: name="',newnode.name,'" link="',newnode.link,'"');
|
||||
if Assigned(PrevSibling) then
|
||||
@ -767,6 +779,7 @@ var
|
||||
exit;
|
||||
Module := TPasExternalModule.Create(s, HPackage);
|
||||
Module.InterfaceSection := TInterfaceSection.Create('', Module);
|
||||
Module.PackageName:= HPackage.Name;
|
||||
HPackage.Modules.Add(Module);
|
||||
end;
|
||||
pkg:=hpackage;
|
||||
@ -1044,10 +1057,12 @@ var
|
||||
end;
|
||||
end;
|
||||
|
||||
function CheckImplicitInterfaceLink(const s : String):String;
|
||||
function CheckImplicitLink(const s : String):String;
|
||||
begin
|
||||
if uppercase(s)='IUNKNOWN' then
|
||||
Result:='#rtl.System.IUnknown'
|
||||
else if uppercase(s)='TOBJECT' then
|
||||
Result:='#rtl.System.TObject'
|
||||
else
|
||||
Result:=s;
|
||||
end;
|
||||
@ -1096,13 +1111,13 @@ begin
|
||||
ClassLikeDecl:=MemberDecl as TPasClassType
|
||||
else
|
||||
ClassLikeDecl:=nil;
|
||||
Write(ContentFile, CheckImplicitInterfaceLink(MemberDecl.PathName), ' ');
|
||||
Write(ContentFile, CheckImplicitLink(MemberDecl.PathName), ' ');
|
||||
if Assigned(ClassLikeDecl) then
|
||||
begin
|
||||
if Assigned(ClassLikeDecl.AncestorType) then
|
||||
begin
|
||||
// simple aliases to class types are coded as "alias(classtype)"
|
||||
Write(ContentFile, CheckImplicitInterfaceLink(ClassLikeDecl.AncestorType.PathName));
|
||||
Write(ContentFile, CheckImplicitLink(ClassLikeDecl.AncestorType.PathName));
|
||||
if ClassLikeDecl.AncestorType is TPasAliasType then
|
||||
begin
|
||||
alias:= TPasAliasType(ClassLikeDecl.AncestorType);
|
||||
@ -1118,12 +1133,12 @@ begin
|
||||
begin
|
||||
for k:=0 to ClassLikeDecl.Interfaces.count-1 do
|
||||
begin
|
||||
write(contentfile,',',CheckImplicitInterfaceLink(TPasClassType(ClassLikeDecl.Interfaces[k]).PathName));
|
||||
write(contentfile,',',CheckImplicitLink(TPasClassType(ClassLikeDecl.Interfaces[k]).PathName));
|
||||
if TPasElement(ClassLikeDecl.Interfaces[k]) is TPasAliasType then
|
||||
begin
|
||||
alias:= TPasAliasType(ClassLikeDecl.Interfaces[k]);
|
||||
if assigned(alias.desttype) and (alias.desttype is TPasClassType) then
|
||||
write(ContentFile,'(',CheckImplicitInterfaceLink(alias.desttype.PathName),')');
|
||||
write(ContentFile,'(',CheckImplicitLink(alias.desttype.PathName),')');
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -1173,41 +1188,41 @@ begin
|
||||
Result.SourceLinenumber := ASourceLinenumber;
|
||||
end;
|
||||
|
||||
function TFPDocEngine.FindElement(const AName: String): TPasElement;
|
||||
|
||||
function FindInModule(AModule: TPasModule; const LocalName: String): TPasElement;
|
||||
|
||||
function TFPDocEngine.FindInModule ( const AName: String; AModule: TPasModule
|
||||
) : TPasElement;
|
||||
var
|
||||
l: TFPList;
|
||||
i: Integer;
|
||||
|
||||
begin
|
||||
If assigned(AModule.InterfaceSection) and
|
||||
If Assigned(AModule) and Assigned(AModule.InterfaceSection) and
|
||||
Assigned(AModule.InterfaceSection.Declarations) then
|
||||
begin
|
||||
l:=AModule.InterfaceSection.Declarations;
|
||||
for i := 0 to l.Count - 1 do
|
||||
begin
|
||||
Result := TPasElement(l[i]);
|
||||
if CompareText(Result.Name, LocalName) = 0 then
|
||||
if CompareText(Result.Name, AName) = 0 then
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function TFPDocEngine.FindElement(const AName: String): TPasElement;
|
||||
|
||||
var
|
||||
i: Integer;
|
||||
Module: TPasElement;
|
||||
begin
|
||||
Result := FindInModule(CurModule, AName);
|
||||
Result := FindInModule( AName, CurModule );
|
||||
if not Assigned(Result) and assigned (CurModule.InterfaceSection) then
|
||||
for i := CurModule.InterfaceSection.UsesList.Count - 1 downto 0 do
|
||||
begin
|
||||
Module := TPasElement(CurModule.InterfaceSection.UsesList[i]);
|
||||
if Module.ClassType.InheritsFrom(TPasModule) then
|
||||
begin
|
||||
Result := FindInModule(TPasModule(Module), AName);
|
||||
Result := FindInModule(AName, TPasModule(Module));
|
||||
if Assigned(Result) then
|
||||
exit;
|
||||
end;
|
||||
|
||||
@ -15,7 +15,7 @@
|
||||
{$mode objfpc}
|
||||
{$H+}
|
||||
|
||||
unit dw_HTML;
|
||||
unit dw_html;
|
||||
{$WARN 5024 off : Parameter "$1" not used}
|
||||
interface
|
||||
|
||||
@ -75,9 +75,7 @@ type
|
||||
THTMLWriter = class(TFPDocWriter)
|
||||
private
|
||||
FImageFileList: TStrings;
|
||||
|
||||
FOnTest: TNotifyEvent;
|
||||
FPackage: TPasPackage;
|
||||
FCharSet : String;
|
||||
procedure CreateMinusImage;
|
||||
procedure CreatePlusImage;
|
||||
@ -233,7 +231,7 @@ type
|
||||
procedure CreatePackagePageBody;
|
||||
procedure CreatePackageIndex;
|
||||
procedure CreatePackageClassHierarchy;
|
||||
procedure CreateClassHierarchyPage(AList: TStringList; AddUnit : Boolean);
|
||||
procedure CreateClassHierarchyPage(AddUnit : Boolean);
|
||||
procedure AddModuleIdentifiers(AModule : TPasModule; L : TStrings);
|
||||
Procedure CreateTopicPageBody(AElement : TTopicElement);
|
||||
procedure CreateModulePageBody(AModule: TPasModule; ASubpageIndex: Integer);
|
||||
@ -244,9 +242,9 @@ type
|
||||
procedure CreateVarPageBody(AVar: TPasVariable);
|
||||
procedure CreateProcPageBody(AProc: TPasProcedureBase);
|
||||
Procedure CreateTopicLinks(Node : TDocNode; PasElement : TPasElement);
|
||||
procedure AddElementsFromList(L: TStrings; List: TFPList; UsePathName : Boolean = False);
|
||||
procedure AppendTypeDecl(AType: TPasType; TableEl, CodeEl: TDomElement);
|
||||
public
|
||||
// Creating all module hierarchy classes is here !!!!
|
||||
constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); override;
|
||||
destructor Destroy; override;
|
||||
|
||||
@ -254,7 +252,7 @@ type
|
||||
function CreateHTMLPage(AElement: TPasElement; ASubpageIndex: Integer): TXMLDocument;
|
||||
function CreateXHTMLPage(AElement: TPasElement; ASubpageIndex: Integer): TXMLDocument;
|
||||
|
||||
// For producing complete package documentation
|
||||
// Start producing html complete package documentation
|
||||
procedure WriteHTMLPages; virtual;
|
||||
procedure WriteXHTMLPages;
|
||||
function ModuleForElement(AnElement:TPasElement):TPasModule;
|
||||
@ -266,7 +264,7 @@ type
|
||||
Class procedure SplitImport(var AFilename, ALinkPrefix: String); override;
|
||||
Property SearchPage: String Read FSearchPage Write FSearchPage;
|
||||
property Allocator: TFileAllocator read FAllocator;
|
||||
property Package: TPasPackage read FPackage;
|
||||
|
||||
property PageCount: Integer read GetPageCount;
|
||||
Property IncludeDateInFooter : Boolean Read FIDF Write FIDF;
|
||||
Property DateFormat : String Read FDateFormat Write FDateFormat;
|
||||
@ -326,13 +324,20 @@ function TLongNameFileAllocator.GetFilename(AElement: TPasElement; ASubindex: In
|
||||
var
|
||||
n,s: String;
|
||||
i: Integer;
|
||||
|
||||
excl: Boolean; //search
|
||||
begin
|
||||
Result:='';
|
||||
excl := False;
|
||||
if AElement.ClassType = TPasPackage then
|
||||
Result := 'index'
|
||||
begin
|
||||
Result := 'index';
|
||||
excl := True;
|
||||
end
|
||||
else if AElement.ClassType = TPasModule then
|
||||
Result := LowerCase(AElement.Name) + PathDelim + 'index'
|
||||
begin
|
||||
Result := LowerCase(AElement.Name) + PathDelim + 'index';
|
||||
excl := True;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if AElement is TPasOperator then
|
||||
@ -361,8 +366,12 @@ begin
|
||||
if (N<>'') and (N[1]=':') then
|
||||
Delete(N,1,1);
|
||||
Result:=Result + '-'+ s + '-' + N;
|
||||
end else
|
||||
end
|
||||
else
|
||||
begin
|
||||
Result := LowerCase(AElement.PathName);
|
||||
excl := (ASubindex > 0);
|
||||
end;
|
||||
// searching for TPasModule - it is on the 2nd level
|
||||
if Assigned(AElement.Parent) then
|
||||
while Assigned(AElement.Parent.Parent) do
|
||||
@ -375,6 +384,14 @@ begin
|
||||
Inc(i);
|
||||
if (i <= Length(Result)) and (i > 0) then
|
||||
Result[i] := PathDelim;
|
||||
if excl or (Length(Result)=0) then
|
||||
begin
|
||||
// exclude the from full text search index
|
||||
s:= '.'+ExtractFileName(Result + '.');
|
||||
n:= ExtractFileDir(Result);
|
||||
Result := n + DirectorySeparator + s;
|
||||
Result := Copy(Result, 1, Length(Result)-1);
|
||||
end;
|
||||
end;
|
||||
|
||||
if ASubindex > 0 then
|
||||
@ -632,7 +649,7 @@ var
|
||||
H : Boolean;
|
||||
|
||||
begin
|
||||
inherited ;
|
||||
inherited Create(APackage, AEngine);
|
||||
|
||||
// should default to true since this is the old behavior
|
||||
UseMenuBrackets:=True;
|
||||
@ -640,7 +657,6 @@ begin
|
||||
IndexColCount:=3;
|
||||
Charset:='iso-8859-1';
|
||||
CreateAllocator;
|
||||
FPackage := APackage;
|
||||
OutputNodeStack := TList.Create;
|
||||
|
||||
PageInfos := TObjectList.Create;
|
||||
@ -716,6 +732,7 @@ begin
|
||||
HTMLEl.AppendChild(BodyElement);
|
||||
|
||||
CreatePageBody(AElement, ASubpageIndex);
|
||||
|
||||
AppendFooter;
|
||||
|
||||
HeadEl.AppendChild(El);
|
||||
@ -771,6 +788,7 @@ begin
|
||||
Filename := Engine.Output + Allocator.GetFilename(Element, SubpageIndex);
|
||||
try
|
||||
CreatePath(Filename);
|
||||
//writeln('Element: ',Element.PathName, ' FileName: ', Filename);
|
||||
WriteHTMLFile(PageDoc, Filename);
|
||||
except
|
||||
on E: Exception do
|
||||
@ -1534,7 +1552,8 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure THTMLWriter.AppendShortDescr(AContext: TPasElement; Parent: TDOMNode; DocNode : TDocNode);
|
||||
procedure THTMLWriter.AppendShortDescr ( AContext: TPasElement;
|
||||
Parent: TDOMNode; DocNode: TDocNode ) ;
|
||||
|
||||
Var
|
||||
N : TDocNode;
|
||||
@ -2093,7 +2112,7 @@ end;
|
||||
procedure THTMLWriter.AppendMenuBar(ASubpageIndex: Integer);
|
||||
|
||||
var
|
||||
TableEl, TREl, ParaEl, TitleEl: TDOMElement;
|
||||
TableEl, TREl, TRE2, ParaEl, TitleEl: TDOMElement;
|
||||
|
||||
procedure AddLink(ALinkSubpageIndex: Integer; const AName: String);
|
||||
begin
|
||||
@ -2132,8 +2151,34 @@ begin
|
||||
TableEl['border'] := '0';
|
||||
TableEl['width'] := '100%';
|
||||
TableEl['class'] := 'bar';
|
||||
// Title Row
|
||||
TREl := CreateTR(TableEl);
|
||||
ParaEl := CreateEl(CreateTD(TREl), 'b');
|
||||
// Menu title
|
||||
ParaEl := CreateTD(TREl);
|
||||
ParaEl['align'] := 'left';
|
||||
TitleEl := CreateEl(ParaEl, 'span');
|
||||
TitleEl['class'] := 'bartitle';
|
||||
if Assigned(Module) then
|
||||
AppendText(TitleEl, Format(SDocUnitMenuTitle, [Module.Name]))
|
||||
else
|
||||
AppendText(TitleEl, Format(SDocPackageMenuTitle, [Package.Name]));
|
||||
|
||||
// Package link title
|
||||
ParaEl := CreateTD(TREl);
|
||||
ParaEl['align'] := 'right';
|
||||
TitleEl := CreateEl(ParaEl, 'span');
|
||||
TitleEl['class'] := 'bartitle';
|
||||
if Assigned(Module) and Assigned(Package) then // Displays a Package page
|
||||
begin
|
||||
AppendText(TitleEl, SDocPackageLinkTitle);
|
||||
end;
|
||||
|
||||
// Links Row
|
||||
TRE2 := CreateTR(TableEl);
|
||||
ParaEl := CreateTD(TRE2);
|
||||
ParaEl['align'] := 'left';
|
||||
ParaEl := CreateEl(ParaEl, 'span');
|
||||
ParaEl['class']:= 'bartitle';
|
||||
|
||||
if Assigned(Module) then
|
||||
begin
|
||||
@ -2155,7 +2200,13 @@ begin
|
||||
end
|
||||
else
|
||||
begin
|
||||
// Overview
|
||||
AppendText(ParaEl, '[');
|
||||
AppendHyperlink(ParaEl, Package).TextContent:= UTF8Decode(SDocOverview);
|
||||
AppendText(ParaEl, ']');
|
||||
//Index
|
||||
AddPackageLink(IndexSubIndex, SDocIdentifierIndex);
|
||||
// Class TObject tree
|
||||
AddPackageLink(ClassHierarchySubIndex, SDocPackageClassHierarchy);
|
||||
AppendFragment(ParaEl, NavigatorHTML)
|
||||
end;
|
||||
@ -2168,17 +2219,16 @@ begin
|
||||
if FUseMenuBrackets then
|
||||
AppendText(ParaEl, ']');
|
||||
end;
|
||||
ParaEl := CreateTD(TREl);
|
||||
|
||||
ParaEl := CreateTD(TRE2);
|
||||
ParaEl['align'] := 'right';
|
||||
TitleEl := CreateEl(ParaEl, 'span');
|
||||
TitleEl['class'] := 'bartitle';
|
||||
if Assigned(Module) then
|
||||
AppendText(TitleEl, Format(SDocUnitTitle, [Module.Name]));
|
||||
if Assigned(Package) then
|
||||
ParaEl := CreateEl(ParaEl, 'span');
|
||||
ParaEl['class']:= 'bartitle';
|
||||
if Assigned(Module) and Assigned(Package) then // Displays a Package page
|
||||
begin
|
||||
AppendText(TitleEl, ' (');
|
||||
AppendHyperlink(TitleEl, Package);
|
||||
AppendText(TitleEl, ')');
|
||||
AppendText(ParaEl, '[');
|
||||
AppendHyperlink(ParaEl, Package);
|
||||
AppendText(ParaEl, ']');
|
||||
end;
|
||||
AppendFragment(BodyElement,HeaderHTML);
|
||||
end;
|
||||
@ -2189,7 +2239,8 @@ begin
|
||||
[ExtractFileName(AElement.SourceFilename), AElement.SourceLinenumber]));
|
||||
end;
|
||||
|
||||
Procedure THTMLWriter.AppendSeeAlsoSection(AElement : TPasElement;DocNode : TDocNode);
|
||||
procedure THTMLWriter.AppendSeeAlsoSection ( AElement: TPasElement;
|
||||
DocNode: TDocNode ) ;
|
||||
|
||||
var
|
||||
Node: TDOMNode;
|
||||
@ -2263,7 +2314,8 @@ begin
|
||||
end; // While
|
||||
end;
|
||||
|
||||
Procedure THTMLWriter.AppendExampleSection(AElement : TPasElement;DocNode : TDocNode);
|
||||
procedure THTMLWriter.AppendExampleSection ( AElement: TPasElement;
|
||||
DocNode: TDocNode ) ;
|
||||
|
||||
var
|
||||
Node: TDOMNode;
|
||||
@ -2384,10 +2436,11 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure THTMLWriter.CreateClassHierarchyPage(AList : TStringList; AddUnit : Boolean);
|
||||
procedure THTMLWriter.CreateClassHierarchyPage(AddUnit : Boolean);
|
||||
type
|
||||
TypeEN = (NPackage, NModule, NName);
|
||||
|
||||
Procedure PushClassElement;
|
||||
|
||||
Var
|
||||
H : THTMLElement;
|
||||
begin
|
||||
@ -2403,7 +2456,6 @@ procedure THTMLWriter.CreateClassHierarchyPage(AList : TStringList; AddUnit : Bo
|
||||
end;
|
||||
|
||||
Procedure PushClassList;
|
||||
|
||||
Var
|
||||
H : THTMLElement;
|
||||
begin
|
||||
@ -2412,32 +2464,39 @@ procedure THTMLWriter.CreateClassHierarchyPage(AList : TStringList; AddUnit : Bo
|
||||
PushOutputNode(h);
|
||||
end;
|
||||
|
||||
Procedure AppendClass(E : TPasElementNode);
|
||||
function ExtractName(APathName: String; Tp: TypeEN):String;
|
||||
var
|
||||
l:TStringList;
|
||||
begin
|
||||
Result:= Trim(APathName);
|
||||
if Result = '' then exit;
|
||||
l:=TStringList.Create;
|
||||
try
|
||||
l.AddDelimitedText(Result, '.', True);
|
||||
if l.Count=3 then
|
||||
Result:= l.Strings[Integer(Tp)]
|
||||
else
|
||||
Result:='';
|
||||
finally
|
||||
l.free;
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure AppendClass(EN : TPasElementNode);
|
||||
|
||||
Var
|
||||
N : TDomNode;
|
||||
P,PM,M : TPasElement;
|
||||
EN : String;
|
||||
LL : TstringList;
|
||||
I,J : Integer;
|
||||
PE,PM : TPasElement;
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
M:=E.Element.GetModule;
|
||||
if (M<>Nil) then
|
||||
EN:=Package.Name+'.'+UTF8Encode(M.Name)+'.'+UTF8Encode(E.Element.Name)
|
||||
else
|
||||
EN:=UTF8Encode(E.Element.Name);
|
||||
J:=AList.IndexOf(EN);
|
||||
If J<>-1 then
|
||||
P:=AList.Objects[J] as TPasElement
|
||||
else
|
||||
P:=Engine.FindElement(EN);
|
||||
if not Assigned(EN) then exit;
|
||||
PE:=EN.Element;
|
||||
PushClassElement;
|
||||
try
|
||||
if (P<>Nil) then
|
||||
if (PE<>Nil) then
|
||||
begin
|
||||
AppendHyperLink(CurOutputNode,P);
|
||||
PM:=ModuleForElement(P);
|
||||
AppendHyperLink(CurOutputNode,PE);
|
||||
PM:=ModuleForElement(PE);
|
||||
if (PM<>Nil) then
|
||||
begin
|
||||
AppendText(CurOutputNode,' (');
|
||||
@ -2446,13 +2505,13 @@ procedure THTMLWriter.CreateClassHierarchyPage(AList : TStringList; AddUnit : Bo
|
||||
end
|
||||
end
|
||||
else
|
||||
AppendText(CurOutputNode,E.Element.Name);
|
||||
if E.ChildCount>0 then
|
||||
AppendText(CurOutputNode,EN.Element.Name);
|
||||
if EN.ChildCount>0 then
|
||||
begin
|
||||
PushClassList;
|
||||
try
|
||||
For I:=0 to E.ChildCount-1 do
|
||||
AppendClass(E.Children[i] as TPasElementNode);
|
||||
For I:=0 to EN.ChildCount-1 do
|
||||
AppendClass(EN.Children[i] as TPasElementNode);
|
||||
finally
|
||||
PopOutputNode;
|
||||
end;
|
||||
@ -2462,29 +2521,12 @@ procedure THTMLWriter.CreateClassHierarchyPage(AList : TStringList; AddUnit : Bo
|
||||
end;
|
||||
end;
|
||||
|
||||
Var
|
||||
B : TClassTreeBuilder;
|
||||
E : TPasElementNode;
|
||||
|
||||
begin
|
||||
PushOutputNode(BodyElement);
|
||||
try
|
||||
B:=TClassTreeBuilder.Create(Package,okClass);
|
||||
try
|
||||
B.BuildTree(AList);
|
||||
// Classes
|
||||
// WriteXMLFile(B.ClassTree,'tree.xml');
|
||||
// Dummy TObject
|
||||
E:=B.RootNode;
|
||||
PushClassList;
|
||||
try
|
||||
AppendClass(E);
|
||||
finally
|
||||
PopOutputNode;
|
||||
end;
|
||||
finally
|
||||
B.Free;
|
||||
end;
|
||||
AppendClass(TreeClass.RootNode);
|
||||
//PopOutputNode;
|
||||
finally
|
||||
PopOutputNode;
|
||||
end;
|
||||
@ -2500,9 +2542,6 @@ Const
|
||||
'}';
|
||||
|
||||
Var
|
||||
L : TStringList;
|
||||
I : Integer;
|
||||
M : TPasModule;
|
||||
S : String;
|
||||
SE : THTMLElement;
|
||||
|
||||
@ -2510,24 +2549,12 @@ begin
|
||||
SE := Doc.CreateElement('script');
|
||||
AppendText(SE,SFunc);
|
||||
HeadElement.AppendChild(SE);
|
||||
L:=TStringList.Create;
|
||||
try
|
||||
L.Capacity:=PageInfos.Count; // Too much, but that doesn't hurt.
|
||||
For I:=0 to Package.Modules.Count-1 do
|
||||
begin
|
||||
M:=TPasModule(Package.Modules[i]);
|
||||
if Not (M is TPasExternalModule) and assigned(M.InterfaceSection) then
|
||||
Self.AddElementsFromList(L,M.InterfaceSection.Classes,True)
|
||||
end;
|
||||
AppendMenuBar(ClassHierarchySubIndex);
|
||||
S:=Package.Name;
|
||||
If Length(S)>0 then
|
||||
Delete(S,1,1);
|
||||
AppendTitle(UTF8Decode(Format(SDocPackageClassHierarchy, [S])));
|
||||
CreateClassHierarchyPage(L,True);
|
||||
Finally
|
||||
L.Free;
|
||||
end;
|
||||
CreateClassHierarchyPage(True);
|
||||
end;
|
||||
|
||||
procedure THTMLWriter.CreatePageBody(AElement: TPasElement;
|
||||
@ -2673,29 +2700,6 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure THTMLWriter.AddElementsFromList(L : TStrings; List : TFPList; UsePathName : Boolean = False);
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
El : TPasElement;
|
||||
N : TDocNode;
|
||||
|
||||
begin
|
||||
For I:=0 to List.Count-1 do
|
||||
begin
|
||||
El:=TPasElement(List[I]);
|
||||
N:=Engine.FindDocNode(El);
|
||||
if (N=Nil) or (not N.IsSkipped) then
|
||||
begin
|
||||
if UsePathName then
|
||||
L.AddObject(El.PathName,El)
|
||||
else
|
||||
L.AddObject(El.Name,El);
|
||||
If el is TPasEnumType then
|
||||
AddElementsFromList(L,TPasEnumType(el).Values);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure THTMLWriter.AddModuleIdentifiers(AModule : TPasModule; L : TStrings);
|
||||
|
||||
@ -2783,7 +2787,8 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure THTMLWriter.CreateTopicLinks(Node : TDocNode; PasElement : TPasElement);
|
||||
procedure THTMLWriter.CreateTopicLinks ( Node: TDocNode;
|
||||
PasElement: TPasElement ) ;
|
||||
|
||||
var
|
||||
DocNode: TDocNode;
|
||||
@ -3351,10 +3356,9 @@ var
|
||||
i: Integer;
|
||||
ThisInterface,
|
||||
ThisClass: TPasClassType;
|
||||
HaveSeenTObject: Boolean;
|
||||
LName : String;
|
||||
ThisNode : TPasUnresolvedTypeRef;
|
||||
ThisTreeNode: TPasElementNode;
|
||||
begin
|
||||
//WriteLn('@ClassPageBody.CreateMainPage Class=', AClass.Name);
|
||||
AppendMenuBar(-1);
|
||||
AppendTitle(UTF8Decode(AClass.Name),AClass.Hints);
|
||||
|
||||
@ -3398,28 +3402,29 @@ var
|
||||
end;
|
||||
CreateMemberDeclarations(AClass, AClass.Members,TableEl, not AClass.IsShortDefinition);
|
||||
|
||||
|
||||
|
||||
AppendText(CreateH2(BodyElement), UTF8Decode(SDocInheritance));
|
||||
TableEl := CreateTable(BodyElement);
|
||||
HaveSeenTObject := AClass.ObjKind <> okClass;
|
||||
// we try to track classes. But imported classes
|
||||
// are TLinkNode's not the TPasClassType generated by the parser.
|
||||
ThisClass := AClass; ThisNode := Nil;
|
||||
|
||||
// Now we are using only TreeClass for show inheritance
|
||||
|
||||
ThisClass := AClass; ThisTreeNode := Nil;
|
||||
if AClass.ObjKind = okInterface then
|
||||
ThisTreeNode := TreeInterface.GetPasElNode(AClass)
|
||||
else
|
||||
ThisTreeNode := TreeClass.GetPasElNode(AClass);
|
||||
while True do
|
||||
begin
|
||||
TREl := CreateTR(TableEl);
|
||||
TDEl := CreateTD_vtop(TREl);
|
||||
TDEl['align'] := 'center';
|
||||
CodeEl := CreateCode(CreatePara(TDEl));
|
||||
if Assigned(ThisClass) then
|
||||
LName:=ThisClass.Name
|
||||
Else
|
||||
LName:=ThisNode.Name;
|
||||
|
||||
// Show class item
|
||||
if Assigned(ThisClass) Then
|
||||
AppendHyperlink(CodeEl, ThisClass)
|
||||
else
|
||||
AppendHyperlink(CodeEl, ThisNode);
|
||||
AppendHyperlink(CodeEl, ThisClass);
|
||||
//else
|
||||
// AppendHyperlink(CodeEl, ThisTreeNode);
|
||||
// Show links to class interfaces
|
||||
if Assigned(ThisClass) and (ThisClass.Interfaces.count>0) then
|
||||
begin
|
||||
for i:=0 to ThisClass.interfaces.count-1 do
|
||||
@ -3429,48 +3434,28 @@ var
|
||||
AppendHyperlink(CodeEl, ThisInterface);
|
||||
end;
|
||||
end;
|
||||
// short class description
|
||||
if Assigned(ThisClass) then
|
||||
AppendShortDescrCell(TREl, ThisClass);
|
||||
if HaveSeenTObject or (CompareText(LName, 'TObject') = 0) then
|
||||
HaveSeenTObject := True
|
||||
else
|
||||
|
||||
if Assigned(ThisTreeNode) then
|
||||
if Assigned(ThisTreeNode.ParentNode) then
|
||||
begin
|
||||
TDEl := CreateTD(CreateTR(TableEl));
|
||||
TDEl['align'] := 'center';
|
||||
AppendText(TDEl, '|');
|
||||
end;
|
||||
|
||||
if Assigned(ThisClass.AncestorType) then
|
||||
begin
|
||||
if ThisClass.AncestorType.InheritsFrom(TPasClassType) then
|
||||
ThisClass := TPasClassType(ThisClass.AncestorType)
|
||||
ThisClass := ThisTreeNode.ParentNode.Element;
|
||||
ThisTreeNode := ThisTreeNode.ParentNode;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if thisclass.ancestortype is TPasUnresolvedTypeRef then
|
||||
thisnode:=TPasUnresolvedTypeRef(ThisClass.ancestortype);
|
||||
TDEl := CreateTD(CreateTR(TableEl));
|
||||
TDEl['align'] := 'center';
|
||||
AppendText(CreateCode(CreatePara(TDEl)), UTF8Decode(ThisClass.AncestorType.Name));
|
||||
if CompareText(ThisClass.AncestorType.Name, 'TObject') = 0 then
|
||||
HaveSeenTObject := True
|
||||
else
|
||||
begin
|
||||
TDEl := CreateTD(CreateTR(TableEl));
|
||||
TDEl['align'] := 'center';
|
||||
AppendText(TDEl, '?');
|
||||
end;
|
||||
ThisClass := nil;
|
||||
ThisTreeNode:= nil;
|
||||
break;
|
||||
end
|
||||
end else
|
||||
else
|
||||
break;
|
||||
end;
|
||||
|
||||
if not HaveSeenTObject then
|
||||
begin
|
||||
TDEl := CreateTD(CreateTR(TableEl));
|
||||
TDEl['align'] := 'center';
|
||||
AppendText(CreateCode(CreatePara(TDEl)), 'TObject');
|
||||
end;
|
||||
|
||||
FinishElementPage(AClass);
|
||||
end;
|
||||
|
||||
@ -3847,11 +3832,12 @@ begin
|
||||
FinishElementPage(AProc);
|
||||
end;
|
||||
|
||||
Function THTMLWriter.InterPretOption(Const Cmd,Arg : String) : boolean;
|
||||
function THTMLWriter.InterPretOption ( const Cmd, Arg: String ) : boolean;
|
||||
|
||||
Function ReadFile(aFileName : string) : TstringStream;
|
||||
|
||||
begin
|
||||
aFileName:= SetDirSeparators(aFileName);
|
||||
try
|
||||
if copy(aFileName,1,1)<>'@' then
|
||||
Result:=TStringStream.Create(aFileName)
|
||||
@ -3942,7 +3928,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
Class Function THTMLWriter.FileNameExtension : String;
|
||||
class function THTMLWriter.FileNameExtension: String;
|
||||
begin
|
||||
result:='';
|
||||
end;
|
||||
|
||||
@ -158,18 +158,19 @@ Function FindSpace(Const S : String; P : Integer) : Integer;
|
||||
|
||||
Var
|
||||
I,L : Integer;
|
||||
|
||||
SP: set of char;
|
||||
begin
|
||||
Result:=0;
|
||||
SP := [#10,#13,' ',#9];
|
||||
I:=P;
|
||||
L:=Length(S);
|
||||
While (I>0) and (I<=L) and not (S[i] in [#10,#13,' ',#9]) do
|
||||
Dec(i);
|
||||
While (I>0) and (I<=L) and not (S[i] in SP) do
|
||||
Dec(I);
|
||||
If (I=0) then
|
||||
begin
|
||||
I:=P;
|
||||
While (I<=L) and not (S[i] in [#10,#13,' ',#9]) do
|
||||
Inc(i);
|
||||
Inc(I);
|
||||
While (I<=L) and not (S[I] in SP) do
|
||||
Inc(I);
|
||||
end;
|
||||
Result:=I;
|
||||
end;
|
||||
@ -186,7 +187,7 @@ begin
|
||||
exit;
|
||||
N:=S;
|
||||
Repeat
|
||||
If ((FCurrentPos+Length(N))>LineWidth) then
|
||||
If ((FCurrentPos+Length(N)+1)>LineWidth) then
|
||||
begin
|
||||
L:=FindSpace(N,LineWidth-FCurrentPos+1);
|
||||
inherited Write(Copy(N,1,L-1));
|
||||
@ -195,8 +196,8 @@ begin
|
||||
end
|
||||
else
|
||||
begin
|
||||
L:=Length(N)+1;
|
||||
inherited Write(Copy(N,1,L-1));
|
||||
L:=Length(N);
|
||||
inherited Write(Copy(N,1,L));
|
||||
Inc(FCurrentPos,L);
|
||||
If FCheckEOL then
|
||||
If (L>=LEOL) then
|
||||
|
||||
@ -25,7 +25,7 @@ unit dWriter;
|
||||
{$WARN 5024 off : Parameter "$1" not used}
|
||||
interface
|
||||
|
||||
uses Classes, DOM, dGlobals, PasTree, SysUtils;
|
||||
uses Classes, DOM, dGlobals, PasTree, SysUtils, fpdocclasstree;
|
||||
|
||||
resourcestring
|
||||
SErrFileWriting = 'An error occurred during writing of file "%s": %s';
|
||||
@ -80,8 +80,12 @@ type
|
||||
FImgExt : String;
|
||||
FBeforeEmitNote : TWriterNoteEvent;
|
||||
procedure ConvertURL(AContext: TPasElement; El: TDOMElement);
|
||||
|
||||
procedure CreateClassTree;
|
||||
protected
|
||||
TreeClass: TClassTreeBuilder; // Global class tree
|
||||
TreeInterface: TClassTreeBuilder; // Global interface tree
|
||||
|
||||
procedure AddElementsFromList(L: TStrings; List: TFPList; UsePathName : Boolean = False);
|
||||
Procedure DoLog(Const Msg : String);
|
||||
Procedure DoLog(Const Fmt : String; Args : Array of const);
|
||||
procedure Warning(AContext: TPasElement; const AMsg: String);
|
||||
@ -339,7 +343,8 @@ end;
|
||||
|
||||
|
||||
}
|
||||
Constructor TFPDocWriter.Create(APackage: TPasPackage; AEngine: TFPDocEngine);
|
||||
constructor TFPDocWriter.Create ( APackage: TPasPackage; AEngine: TFPDocEngine
|
||||
) ;
|
||||
|
||||
begin
|
||||
inherited Create;
|
||||
@ -347,6 +352,9 @@ begin
|
||||
FPackage := APackage;
|
||||
FTopics:=Tlist.Create;
|
||||
FImgExt:='.png';
|
||||
TreeClass:= TClassTreeBuilder.Create(FEngine, FPackage, okClass);
|
||||
TreeInterface:= TClassTreeBuilder.Create(FEngine, FPackage, okInterface);
|
||||
CreateClassTree;
|
||||
end;
|
||||
|
||||
destructor TFPDocWriter.Destroy;
|
||||
@ -358,6 +366,8 @@ begin
|
||||
For I:=0 to FTopics.Count-1 do
|
||||
TTopicElement(FTopics[i]).Free;
|
||||
FTopics.Free;
|
||||
TreeClass.free;
|
||||
TreeInterface.Free;
|
||||
Inherited;
|
||||
end;
|
||||
|
||||
@ -390,7 +400,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
Function TFPDocWriter.FindTopicElement(Node : TDocNode): TTopicElement;
|
||||
function TFPDocWriter.FindTopicElement ( Node: TDocNode ) : TTopicElement;
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
@ -713,6 +723,55 @@ begin
|
||||
DescrEndURL;
|
||||
end;
|
||||
|
||||
procedure TFPDocWriter.AddElementsFromList ( L: TStrings; List: TFPList;
|
||||
UsePathName: Boolean ) ;
|
||||
Var
|
||||
I : Integer;
|
||||
El : TPasElement;
|
||||
N : TDocNode;
|
||||
|
||||
begin
|
||||
For I:=0 to List.Count-1 do
|
||||
begin
|
||||
El:=TPasElement(List[I]);
|
||||
N:=Engine.FindDocNode(El);
|
||||
if (N=Nil) or (not N.IsSkipped) then
|
||||
begin
|
||||
if UsePathName then
|
||||
L.AddObject(El.PathName,El)
|
||||
else
|
||||
L.AddObject(El.Name,El);
|
||||
If el is TPasEnumType then
|
||||
AddElementsFromList(L,TPasEnumType(el).Values);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFPDocWriter.CreateClassTree;
|
||||
var
|
||||
L: TStringList;
|
||||
M: TPasModule;
|
||||
I:Integer;
|
||||
begin
|
||||
L:=TStringList.Create;
|
||||
try
|
||||
For I:=0 to Package.Modules.Count-1 do
|
||||
begin
|
||||
M:=TPasModule(Package.Modules[i]);
|
||||
if Not (M is TPasExternalModule) and assigned(M.InterfaceSection) then
|
||||
Self.AddElementsFromList(L,M.InterfaceSection.Classes,True)
|
||||
end;
|
||||
TreeClass.BuildTree(L);
|
||||
TreeInterface.BuildTree(L);
|
||||
{$IFDEF TREE_TEST}
|
||||
TreeClass.SaveToXml('TreeClass.xml');
|
||||
TreeInterface.SaveToXml('TreeInterface.xml');
|
||||
{$ENDIF}
|
||||
Finally
|
||||
L.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFPDocWriter.DoLog(const Msg: String);
|
||||
begin
|
||||
If Assigned(FEngine.OnLog) then
|
||||
@ -1126,7 +1185,7 @@ begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
Procedure TFPDocWriter.ConvertImage(El : TDomElement);
|
||||
procedure TFPDocWriter.ConvertImage ( El: TDomElement ) ;
|
||||
|
||||
Var
|
||||
FN,Cap,LinkName : DOMString;
|
||||
@ -1169,7 +1228,7 @@ begin
|
||||
Inherited;
|
||||
end;
|
||||
|
||||
Function TFPDocWriter.WriteDescr(Element: TPasElement) : TDocNode;
|
||||
function TFPDocWriter.WriteDescr ( Element: TPasElement ) : TDocNode;
|
||||
|
||||
begin
|
||||
Result:=Engine.FindDocNode(Element);
|
||||
@ -1211,7 +1270,8 @@ begin
|
||||
Result:=Not ((M.Visibility=visProtected) and Engine.HideProtected)
|
||||
end;
|
||||
|
||||
Procedure TFPDocWriter.GetMethodList(ClassDecl: TPasClassType; List : TStringList);
|
||||
procedure TFPDocWriter.GetMethodList ( ClassDecl: TPasClassType;
|
||||
List: TStringList ) ;
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
|
||||
@ -447,7 +447,7 @@ Constructor TClassTreeEngine.Create(AClassTree : TXMLDocument; AObjectKind : TPa
|
||||
|
||||
begin
|
||||
FPackage:=TPasPackage.Create('dummy',Nil);
|
||||
FTree:=TClassTreeBuilder.Create(FPackage,AObjectKind);
|
||||
FTree:=TClassTreeBuilder.Create(Self,FPackage,AObjectKind);
|
||||
FObjects:=TStringList.Create;
|
||||
Inherited Create;
|
||||
end;
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="11"/>
|
||||
<Version Value="12"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<SaveClosedFiles Value="False"/>
|
||||
@ -10,9 +10,9 @@
|
||||
<MainUnitHasTitleStatement Value="False"/>
|
||||
<SaveJumpHistory Value="False"/>
|
||||
<SaveFoldState Value="False"/>
|
||||
<CompatibilityMode Value="True"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="FPDoc Documentation generator"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
@ -65,7 +65,6 @@
|
||||
<Unit3>
|
||||
<Filename Value="dw_html.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="dw_HTML"/>
|
||||
</Unit3>
|
||||
<Unit4>
|
||||
<Filename Value="dw_ipflin.pas"/>
|
||||
|
||||
@ -428,6 +428,8 @@ begin
|
||||
end;
|
||||
|
||||
begin
|
||||
//AssignFile(Output, 'fpdoc.log');
|
||||
//rewrite(Output);
|
||||
With TFPDocApplication.Create(Nil) do
|
||||
try
|
||||
Run;
|
||||
|
||||
@ -5,7 +5,7 @@ unit fpdocclasstree;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, DOM, pastree, contnrs;
|
||||
Classes, SysUtils, dGlobals, pastree, contnrs, DOM ,XMLWrite;
|
||||
|
||||
Type
|
||||
|
||||
@ -13,16 +13,18 @@ Type
|
||||
|
||||
TPasElementNode = Class
|
||||
Private
|
||||
FElement : TPasElement;
|
||||
FElement : TPasClassType;
|
||||
FParentNode: TPasElementNode;
|
||||
FChildren : TFPObjectList;
|
||||
function GetChild(aIndex : Integer): TPasElementNode;
|
||||
function GetChildCount: Integer;
|
||||
Public
|
||||
Constructor Create (aElement : TPaselement);
|
||||
Constructor Create (aElement : TPasClassType);
|
||||
Destructor Destroy; override;
|
||||
Procedure AddChild(C : TPasElementNode);
|
||||
Procedure SortChildren;
|
||||
Property Element : TPasElement Read FElement;
|
||||
Property Element : TPasClassType Read FElement;
|
||||
Property ParentNode : TPasElementNode read FParentNode;
|
||||
Property Children [aIndex : Integer] : TPasElementNode Read GetChild;
|
||||
Property ChildCount : Integer Read GetChildCount;
|
||||
end;
|
||||
@ -31,20 +33,27 @@ Type
|
||||
|
||||
TClassTreeBuilder = Class
|
||||
Private
|
||||
// Full name -> TDomElement;
|
||||
FEngine:TFPDocEngine;
|
||||
FElementList : TFPObjectHashTable;
|
||||
FObjectKind : TPasObjKind;
|
||||
FPackage: TPasPackage;
|
||||
FParentObject : TPasClassType;
|
||||
FRootNode : TPasElementNode;
|
||||
FRootObjectName : string;
|
||||
FRootObjectPathName : string;
|
||||
Protected
|
||||
function AddToList(aElement: TPasClassType): TPasElementNode;
|
||||
Public
|
||||
Constructor Create(APackage : TPasPackage; AObjectKind : TPasObjKind = okClass);
|
||||
Constructor Create(AEngine:TFPDocEngine; APackage : TPasPackage;
|
||||
AObjectKind : TPasObjKind = okClass);
|
||||
Destructor Destroy; override;
|
||||
Function BuildTree(AObjects : TStringList) : Integer;
|
||||
{$IFDEF TREE_TEST}
|
||||
Procedure SaveToXml(AFileName: String);
|
||||
{$ENDIF}
|
||||
Property RootNode : TPasElementNode Read FRootNode;
|
||||
Property PasElToNodes: TFPObjectHashTable read FElementList;
|
||||
function GetPasElNode (APasEl: TPasElement) : TPasElementNode;
|
||||
end;
|
||||
|
||||
implementation
|
||||
@ -72,7 +81,7 @@ begin
|
||||
Result:=0
|
||||
end;
|
||||
|
||||
constructor TPasElementNode.Create(aElement: TPaselement);
|
||||
constructor TPasElementNode.Create(aElement: TPasClassType);
|
||||
begin
|
||||
FElement:=aElement;
|
||||
end;
|
||||
@ -96,24 +105,38 @@ begin
|
||||
FChildren.Sort(@SortOnElementName);
|
||||
end;
|
||||
|
||||
constructor TClassTreeBuilder.Create(APackage : TPasPackage;
|
||||
constructor TClassTreeBuilder.Create(AEngine:TFPDocEngine; APackage : TPasPackage;
|
||||
AObjectKind: TPasObjKind);
|
||||
|
||||
begin
|
||||
FEngine:= AEngine;
|
||||
FPackage:= APAckage;
|
||||
FObjectKind:=AObjectKind;
|
||||
Case FObjectkind of
|
||||
okInterface : FRootObjectName:='#rtl.System.IInterface';
|
||||
okObject,
|
||||
okClass : FRootObjectName:='#rtl.System.TObject';
|
||||
else
|
||||
FRootObjectName:='#rtl.System.TObject';
|
||||
okInterface :
|
||||
begin
|
||||
FRootObjectPathName:='#rtl.System.IInterface';
|
||||
FRootObjectName:= 'IInterface';
|
||||
end;
|
||||
okObject, okClass :
|
||||
begin
|
||||
FRootObjectPathName:='#rtl.System.TObject';
|
||||
FRootObjectName:= 'TObject';
|
||||
end
|
||||
else
|
||||
begin
|
||||
FRootObjectPathName:='#rtl.System.TObject';
|
||||
FRootObjectName:= 'TObject';
|
||||
end;
|
||||
end;
|
||||
FParentObject:=TPasClassType.Create(FRootObjectName,FEngine.FindModule('System'));
|
||||
if not Assigned(FParentObject) then
|
||||
FParentObject:=TPasClassType.Create(FRootObjectName,FPackage);
|
||||
FParentObject.ObjKind:=FObjectKind;
|
||||
FRootNode:=TPasElementNode.Create(FParentObject);
|
||||
FRootNode.FParentNode := nil;
|
||||
FElementList:=TFPObjectHashTable.Create(False);
|
||||
FElementList.Add(FRootObjectName,FRootNode);
|
||||
FElementList.Add(FRootObjectPathName,FRootNode);
|
||||
end;
|
||||
|
||||
destructor TClassTreeBuilder.Destroy;
|
||||
@ -124,34 +147,37 @@ begin
|
||||
Inherited;
|
||||
end;
|
||||
|
||||
Function TClassTreeBuilder.AddToList(aElement : TPasClassType) : TPasElementNode;
|
||||
function TClassTreeBuilder.AddToList ( aElement: TPasClassType
|
||||
) : TPasElementNode;
|
||||
|
||||
Var
|
||||
aParentNode : TPasElementNode;
|
||||
aName : String;
|
||||
|
||||
begin
|
||||
Result:= nil;
|
||||
if (aElement.ObjKind <> FObjectKind) then exit;
|
||||
aParentNode:= nil;
|
||||
if aElement=Nil then
|
||||
aName:=FRootObjectName
|
||||
else
|
||||
begin
|
||||
aName:=aElement.PathName;
|
||||
end;
|
||||
Result:=TPasElementNode(FElementList.Items[aName]);
|
||||
if (Result=Nil) then
|
||||
begin
|
||||
if aElement.AncestorType is TPasClassType then
|
||||
aParentNode:=AddToList(aElement.AncestorType as TPasClassType)
|
||||
else
|
||||
aParentNode:=AddToList(aElement.AncestorType as TPasClassType);
|
||||
if not Assigned(aParentNode) then
|
||||
aParentNode:=FRootNode;
|
||||
Result:=TPasElementNode.Create(aElement);
|
||||
aParentNode.AddChild(Result);
|
||||
Result.FParentNode := aParentNode;
|
||||
FElementList.Add(aName,Result);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
Function TClassTreeBuilder.BuildTree(AObjects : TStringList) : Integer;
|
||||
function TClassTreeBuilder.BuildTree ( AObjects: TStringList ) : Integer;
|
||||
|
||||
(*
|
||||
Procedure DumpNode(Prefix : String; N : TPasElementNode);
|
||||
@ -182,7 +208,64 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TClassTreeBuilder.GetPasElNode ( APasEl: TPasElement
|
||||
) : TPasElementNode;
|
||||
begin
|
||||
Result:= TPasElementNode(FElementList.Items[APasEl.PathName]);
|
||||
end;
|
||||
|
||||
{$IFDEF TREE_TEST}
|
||||
procedure TClassTreeBuilder.SaveToXml ( AFileName: String ) ;
|
||||
|
||||
procedure AddPasElChildsToXml (ParentxmlEl : TDOMElement ; ParentPasEl: TPasElementNode ) ;
|
||||
var
|
||||
CounterVar: Integer;
|
||||
PasElNode: TPasElementNode;
|
||||
AXmlDoc: TDOMDocument;
|
||||
xmlEl: TDOMElement;
|
||||
M: TPasModule;
|
||||
begin
|
||||
if not Assigned(ParentPasEl) or (ParentPasEl.ChildCount = 0) then exit;
|
||||
AXmlDoc:= ParentxmlEl.OwnerDocument;
|
||||
for CounterVar := 0 to ParentPasEl.ChildCount-1 do
|
||||
begin
|
||||
PasElNode:= ParentPasEl.Children[CounterVar];
|
||||
xmlEl:= AXmlDoc.CreateElement(UnicodeString(PasElNode.Element.Name));
|
||||
M:= PasElNode.Element.GetModule;
|
||||
xmlEl['unit'] := UnicodeString(M.Name);
|
||||
xmlEl['package'] := UnicodeString(M.PackageName);
|
||||
ParentxmlEl.AppendChild(xmlEl);
|
||||
AddPasElChildsToXml(xmlEl, PasElNode);
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
XmlDoc: TXMLDocument;
|
||||
XmlRootEl: TDOMElement;
|
||||
M: TPasModule;
|
||||
begin
|
||||
XmlDoc:= TXMLDocument.Create;
|
||||
try
|
||||
XmlRootEl:= XmlDoc.CreateElement(UnicodeString(FRootNode.Element.Name));
|
||||
M:= FRootNode.Element.GetModule;
|
||||
if Assigned(M) then
|
||||
begin
|
||||
XmlRootEl['unit'] := UnicodeString(M.Name);
|
||||
XmlRootEl['package'] := UnicodeString(M.PackageName);
|
||||
end
|
||||
else
|
||||
begin
|
||||
XmlRootEl['unit'] := 'system';
|
||||
XmlRootEl['package'] := 'rtl';
|
||||
end;
|
||||
XmlDoc.AppendChild(XmlRootEl);
|
||||
AddPasElChildsToXml(XmlRootEl, FRootNode);
|
||||
WriteXMLFile(XmlDoc, AFileName);
|
||||
finally
|
||||
XmlDoc.Free;
|
||||
end;
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -42,6 +42,8 @@ Type
|
||||
procedure SetVerbose(AValue: Boolean); virtual;
|
||||
Procedure DoLog(Const Msg : String);
|
||||
procedure DoLog(Const Fmt : String; Args : Array of Const);
|
||||
Procedure DoLogSender(Sender : TObject; Const Msg : String);
|
||||
// Create documetation by specified Writer class
|
||||
procedure CreateOutput(APackage: TFPDocPackage; Engine: TFPDocEngine); virtual;
|
||||
Public
|
||||
Constructor Create(AOwner : TComponent); override;
|
||||
@ -96,6 +98,14 @@ begin
|
||||
DoLog(Format(Fmt,Args));
|
||||
end;
|
||||
|
||||
procedure TFPDocCreator.DoLogSender ( Sender: TObject; const Msg: String ) ;
|
||||
begin
|
||||
if Assigned(Sender) then
|
||||
DoLog(Format('%s - Sender: %s', [Msg, Sender.ClassName]))
|
||||
else
|
||||
DoLog(Msg);
|
||||
end;
|
||||
|
||||
procedure TFPDocCreator.HandleOnParseUnit(Sender: TObject;
|
||||
const AUnitName: String; out AInputFile, OSTarget, CPUTarget: String);
|
||||
|
||||
@ -208,7 +218,9 @@ Var
|
||||
Cmd,Arg : String;
|
||||
|
||||
begin
|
||||
// Now is used the specified writer
|
||||
WriterClass:=GetWriterClass(Options.Backend);
|
||||
// ALL CONTENT CREATED HERE
|
||||
Writer:=WriterClass.Create(Engine.Package,Engine);
|
||||
With Writer do
|
||||
Try
|
||||
@ -225,10 +237,12 @@ begin
|
||||
If not InterPretOption(Cmd,Arg) then
|
||||
DoLog(SCmdLineInvalidOption,[Cmd+'='+Arg]);
|
||||
end;
|
||||
// Output created Documentation
|
||||
WriteDoc;
|
||||
Finally
|
||||
Free;
|
||||
end;
|
||||
// Output content files
|
||||
Writeln('Content file : ',APackage.ContentFile);
|
||||
if Length(APackage.ContentFile) > 0 then
|
||||
Engine.WriteContentFile(APackage.ContentFile);
|
||||
@ -247,16 +261,21 @@ begin
|
||||
Cmd:='';
|
||||
FCurPackage:=APackage;
|
||||
Engine:=TFPDocEngine.Create;
|
||||
Engine.OnLog:= @DoLogSender;
|
||||
try
|
||||
// get documentation Writer html, latex, and other
|
||||
WriterClass:=GetWriterClass(Options.Backend);
|
||||
For J:=0 to Apackage.Imports.Count-1 do
|
||||
begin
|
||||
Arg:=Apackage.Imports[j];
|
||||
// conversion import FilePathes
|
||||
WriterClass.SplitImport(Arg,Cmd);
|
||||
// create tree of imported objects
|
||||
Engine.ReadContentFile(Arg, Cmd);
|
||||
end;
|
||||
for i := 0 to APackage.Descriptions.Count - 1 do
|
||||
Engine.AddDocFile(FixDescrFile(APackage.Descriptions[i]),Options.donttrim);
|
||||
// set engine options
|
||||
Engine.SetPackageName(APackage.Name);
|
||||
Engine.Output:=APackage.Output;
|
||||
Engine.OnLog:=Self.OnLog;
|
||||
@ -268,13 +287,18 @@ begin
|
||||
Engine.WarnNoNode:=Options.WarnNoNode;
|
||||
if Length(Options.Language) > 0 then
|
||||
TranslateDocStrings(Options.Language);
|
||||
// scan the input source files
|
||||
for i := 0 to APackage.Inputs.Count - 1 do
|
||||
try
|
||||
// get options from input packages
|
||||
SplitInputFileOption(APackage.Inputs[i],Cmd,Arg);
|
||||
// make absolute filepath
|
||||
Cmd:=FixInputFile(Cmd);
|
||||
if FProcessedUnits.IndexOf(Cmd)=-1 then
|
||||
begin
|
||||
FProcessedUnits.Add(Cmd);
|
||||
// Parce sources for OS Target
|
||||
//WriteLn(Format('Parcing unit: %s', [ExtractFilenameOnly(Cmd)]));
|
||||
ParseSource(Engine,Cmd+' '+Arg, Options.OSTarget, Options.CPUTarget,[poUseStreams]);
|
||||
end;
|
||||
except
|
||||
@ -290,6 +314,7 @@ begin
|
||||
if Not ParseOnly then
|
||||
begin
|
||||
Engine.StartDocumenting;
|
||||
// Create documentation
|
||||
CreateOutput(APackage,Engine);
|
||||
end;
|
||||
finally
|
||||
|
||||
Loading…
Reference in New Issue
Block a user