paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-07 10:06:00 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Print short description of linked node in class overview

Browse Source 
git-svn-id: trunk@11668 -
This commit is contained in:
michael 2008-08-30 21:05:52 +00:00
parent 2637f29ec4
commit 10511e99ed
4 changed files with 382 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
utils/fpdoc/dglobals.pp
View File

@ -248,7 +248,10 @@ type
// The main FPDoc engine
{ TFPDocEngine }
TFPDocEngine = class(TPasTreeContainer)
private
protected
DescrDocs: TObjectList; // List of XML documents
DescrDocNames: TStringList; // Names of the XML documents
@ -275,6 +278,7 @@ type
procedure AddLink(const APathName, ALinkTo: String);
function FindAbsoluteLink(const AName: String): String;
function ResolveLink(AModule: TPasModule; const ALinkDest: String): String;
function FindLinkedNode(ANode: TDocNode): TDocNode;
// Documentation file support
procedure AddDocFile(const AFilename: String);
@ -1195,24 +1199,51 @@ begin
end;
function TFPDocEngine.FindShortDescr(AElement: TPasElement): TDOMElement;
var
DocNode: TDocNode;
DocNode,N: TDocNode;
begin
DocNode := FindDocNode(AElement);
if Assigned(DocNode) then
Result := DocNode.ShortDescr
begin
N:=FindLinkedNode(DocNode);
If (N<>Nil) then
DocNode:=N;
Result := DocNode.ShortDescr;
end
else
Result := nil;
end;
function TFPDocEngine.FindLinkedNode(ANode : TDocNode) : TDocNode;
Var
S: String;
begin
If (ANode.Link='') then
Result:=Nil
else
Result:=FindDocNode(CurModule,ANode.Link);
end;
function TFPDocEngine.FindShortDescr(ARefModule: TPasModule;
const AName: String): TDOMElement;
var
DocNode: TDocNode;
N,DocNode: TDocNode;
begin
DocNode := FindDocNode(ARefModule, AName);
if Assigned(DocNode) then
Result := DocNode.ShortDescr
begin
N:=FindLinkedNode(DocNode);
If (N<>Nil) then
DocNode:=N;
Result := DocNode.ShortDescr;
end
else
Result := nil;
end;

59
utils/fpdoc/dw_html.pp
View File

@ -191,11 +191,11 @@ type
AShFlags: Byte): Byte;
Procedure AppendShortDescr(AContext : TPasElement;Parent: TDOMNode; DocNode : TDocNode);
procedure AppendShortDescr(Parent: TDOMNode; Element: TPasElement);
procedure AppendShortDescrCell(Parent: TDOMNode; Element: TPasElement);
procedure AppendDescr(AContext: TPasElement; Parent: TDOMNode;
DescrNode: TDOMElement; AutoInsertBlock: Boolean);
procedure AppendDescrSection(AContext: TPasElement; Parent: TDOMNode;
DescrNode: TDOMElement; const ATitle: DOMString);
procedure AppendShortDescrCell(Parent: TDOMNode; Element: TPasElement);
function AppendHyperlink(Parent: TDOMNode; Element: TPasElement): TDOMElement;
function AppendType(CodeEl, TableEl: TDOMElement;
Element: TPasType; Expanded: Boolean;
@ -1364,16 +1364,28 @@ end;
Procedure THTMLWriter.AppendShortDescr(AContext: TPasElement; Parent: TDOMNode; DocNode : TDocNode);
Var
N : TDocNode;
begin
if Assigned(DocNode) and Assigned(DocNode.ShortDescr) then
if Assigned(DocNode) then
begin
PushOutputNode(Parent);
try
if not ConvertShort(AContext,TDomElement(DocNode.ShortDescr)) then
Warning(AContext, SErrInvalidShortDescr)
finally
PopOutputNode;
end;
If (DocNode.Link<>'') then
begin
N:=Engine.FindLinkedNode(DocNode);
If (N<>Nil) then
DocNode:=N;
end;
If Assigned(DocNode.ShortDescr) then
begin
PushOutputNode(Parent);
try
if not ConvertShort(AContext,TDomElement(DocNode.ShortDescr)) then
Warning(AContext, SErrInvalidShortDescr)
finally
PopOutputNode;
end;
end;
end;
end;
@ -1383,6 +1395,22 @@ begin
AppendShortDescr(Element,Parent,Engine.FindDocNode(Element));
end;
procedure THTMLWriter.AppendShortDescrCell(Parent: TDOMNode;
Element: TPasElement);
var
ParaEl: TDOMElement;
begin
if Assigned(Engine.FindShortDescr(Element)) then
begin
AppendNbSp(CreatePara(CreateTD(Parent)), 2);
ParaEl := CreatePara(CreateTD(Parent));
ParaEl['class'] := 'cmt';
AppendShortDescr(ParaEl, Element);
end;
end;
procedure THTMLWriter.AppendDescr(AContext: TPasElement; Parent: TDOMNode;
DescrNode: TDOMElement; AutoInsertBlock: Boolean);
begin
@ -1409,19 +1437,6 @@ begin
end;
procedure THTMLWriter.AppendShortDescrCell(Parent: TDOMNode;
Element: TPasElement);
var
ParaEl: TDOMElement;
begin
if Assigned(Engine.FindShortDescr(Element)) then
begin
AppendNbSp(CreatePara(CreateTD(Parent)), 2);
ParaEl := CreatePara(CreateTD(Parent));
ParaEl['class'] := 'cmt';
AppendShortDescr(ParaEl, Element);
end;
end;
function THTMLWriter.AppendHyperlink(Parent: TDOMNode;
Element: TPasElement): TDOMElement;

310
utils/fpdoc/fpclasschart.pp
View File

@ -60,6 +60,301 @@ type
const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement; override;
end;
{ TClassChartFormatter }
TClassMode = (cmNormal,cmSubClass,cmheadClass,cmFirstClass);
TClassChartFormatter = Class (TObject)
private
FClassMode: TClassMode;
FClassTree: TXMLDocument;
FCurrentColCount: Integer;
FCurrentRowCount: Integer;
FFileName: String;
FLargeHeadClassObjects: TStrings;
FLevel: Integer;
FMaxObjectsPerColumn: Integer;
FStartColumnObjects: TStrings;
Protected
procedure FirstClass(E : TDomElement); virtual;
procedure DoEmitClass(E : TDomElement); virtual;
procedure DoHeadClass(E: TDomElement); virtual;
procedure DoNextColumn(E: TDomElement); virtual;
procedure EndSubClass(E: TDomElement; HasSiblings : Boolean); virtual;
procedure StartSubClass(E: TDomElement); virtual;
Procedure StartChart; virtual;
Procedure EndChart; virtual;
procedure EmitClass(E : TDomElement; HasSiblings : Boolean);
Public
Constructor Create (AXML : TXMLDocument); virtual;
Destructor Destroy; override;
Procedure CreateChart;
Property CurrentColCount : Integer Read FCurrentColCount;
Property CurrentRowCount : Integer Read FCurrentRowCount;
Property ClassTree : TXMLDocument Read FClassTree;
Property Level : Integer Read FLevel Write FLevel;
Property ClassMode : TClassMode Read FClassMode;
Published
Property FileName : String Read FFileName Write FFilename;
Property StartColumnObjects : TStrings Read FStartColumnObjects;
Property LargeHeadClassObjects : TStrings Read FLargeHeadClassObjects;
Property MaxObjectsPerColumn : Integer Read FMaxObjectsPerColumn Write FMaxObjectsPerColumn;
end;
{ TChartFormatter }
constructor TClassChartFormatter.Create(AXML: TXMLDocument);
begin
FClassTree:=AXML;
MaxObjectsPerColumn:=60;
FStartColumnObjects:=TStringList.Create;
FLargeHeadClassObjects:=TStringList.Create;
FLargeHeadClassObjects.Add('TPersistent');
FLargeHeadClassObjects.Add('TComponent');
end;
destructor TClassChartFormatter.Destroy;
begin
FreeAndNil(FStartColumnObjects);
FreeAndNil(FLargeHeadClassObjects);
Inherited;
end;
procedure TClassChartFormatter.CreateChart;
Var
N : TDomNode;
E : TDomElement;
I : Integer;
L : TFPList;
begin
(FStartColumnObjects as TStringList).Sorted:=False;
(FLargeHeadClassObjects as TStringList).Sorted:=False;
StartChart;
try
N:=FClassTree.DocumentElement.FirstChild;
FCurrentColCount:=0;
FCurrentRowCount:=0;
FLevel:=0;
L:=TFPList.Create;
try
While (N<>nil) do
begin
If (N.NodeType=ELEMENT_NODE) then
L.Add(N);
N:=N.NextSibling;
end;
If (L.Count>0) then
begin
FirstClass(TDomElement(L[0]));
For I:=0 to L.Count-1 do
EmitClass(TDomElement(L[i]),I<L.Count-1);
end;
finally
L.Free;
end;
L:=TFPList.Create;
try
For I:=0 to FLargeHeadClassObjects.Count-1 do
If Assigned(FLargeHeadClassObjects.Objects[i]) then
L.Add(FLargeHeadClassObjects.Objects[i]);
FLargeHeadClassObjects.Clear;
For I:=0 to L.Count-1 do
begin
E:= TDomElement(L[i]);
DoHeadClass(E);
EmitClass(E,I<L.Count-1);
end;
finally
L.Free;
end;
finally
EndChart;
end;
end;
procedure TClassChartFormatter.FirstClass(E : TDomElement);
begin
FClassMode:=cmFirstClass;
end;
procedure TClassChartFormatter.DoEmitClass(E : TDomElement);
begin
//Reset
FClassMode:=cmNormal;
end;
procedure TClassChartFormatter.DoHeadClass(E : TDomElement);
begin
DoNextColumn(E);
FClassMode:=cmHeadClass;
// Do nothing
end;
procedure TClassChartFormatter.StartSubClass(E : TDomElement);
begin
FClassMode:=cmSubClass;
end;
procedure TClassChartFormatter.EndSubClass(E : TDomElement; HasSiblings : Boolean);
begin
FClassMode:=cmNormal;
end;
procedure TClassChartFormatter.DoNextColumn(E : TDomElement);
begin
Inc(FCurrentColCount);
FCurrentRowCount:=0;
end;
procedure TClassChartFormatter.StartChart;
begin
// Do nothing
end;
procedure TClassChartFormatter.EndChart;
begin
// Do nothing
end;
procedure TClassChartFormatter.EmitClass(E : TDomElement; HasSiblings: Boolean);
Var
DidSub : Boolean;
N : TDomNode;
I : Integer;
L : TFPList;
begin
Inc(Flevel);
try
I:=FStartColumnObjects.IndexOf(E.NodeName);
if (-1<>I) or ((FCurrentRowCount>MaxObjectsPerColumn) and (FLevel=2)) then
DoNextColumn(E)
else
begin
I:=FLargeHeadClassObjects.IndexOf(E.NodeName);
if (-1<>I) then
begin
FLargeHeadClassObjects.Objects[i]:=E;
Exit; // Must be picked up later.
end;
end;
DoEmitClass(E);
N:=E.FirstChild;
DidSub:=False;
L:=TFPList.Create;
try
While (N<>Nil) do
begin
if (N.NodeType=ELEMENT_NODE) then
L.Add(N);
N:=N.NextSibling;
end;
If L.Count>0 then
begin
StartSubClass(TDomElement(L[0]));
For I:=0 to L.Count-1 do
begin
EmitClass(TDomElement(L[i]),I<L.Count-1);
FClassMode:=cmNormal;
end;
EndSubClass(E,HasSiblings);
end;
Finally
L.Free;
end;
Inc(FCurrentRowCount);
finally
Dec(Flevel);
end;
end;
Type
{ TPostScriptClassChartFormatter }
TPostScriptClassChartFormatter = Class(TClassChartFormatter)
FFile : Text;
FMode : TClassMode;
FIndent : Integer;
Procedure EmitLine(S : String);
Protected
procedure DoEmitClass(E : TDomElement); override;
procedure DoNextColumn(E: TDomElement); override;
procedure DoHeadClass(E: TDomElement); override;
procedure StartSubClass(E: TDomElement); override;
procedure EndSubClass(E: TDomElement; HasSiblings : Boolean); override;
Procedure StartChart; override;
Procedure EndChart; override;
end;
{ TPostScriptClassChartFormatter }
procedure TPostScriptClassChartFormatter.EmitLine(S: String);
begin
Writeln(FFile,StringofChar(' ',Findent*2),S);
end;
procedure TPostScriptClassChartFormatter.DoEmitClass(E: TDomElement);
begin
Case ClassMode of
cmFirstClass : EmitLine(Format('(%s) Ready drawlargebox',[E.NodeName]));
cmNormal : EmitLine(Format('(%s) Ready newclass',[E.NodeName]));
cmSubClass : EmitLine(Format('(%s) Ready newchildclass',[E.NodeName]));
cmHeadClass : EmitLine(Format('(%s) Ready newlargeheadclass',[E.NodeName]));
end;
end;
procedure TPostScriptClassChartFormatter.DoNextColumn(E: TDomElement);
begin
Inherited;
FIndent:=0;
EmitLine('newcolumn');
end;
procedure TPostScriptClassChartFormatter.DoHeadClass(E: TDomElement);
begin
// DoNextColumn(E);
inherited DoHeadClass(E);
end;
procedure TPostScriptClassChartFormatter.EndSubClass(E: TDomElement; HasSiblings : Boolean);
begin
if HasSiblings then
EmitLine('onelevelback')
else
EmitLine('onelevelbackempty');
If FIndent>0 then
Dec(Findent);
end;
procedure TPostScriptClassChartFormatter.StartSubClass(E: TDomElement);
begin
inherited StartSubClass(E);
Inc(Findent);
end;
procedure TPostScriptClassChartFormatter.StartChart;
begin
Assign(FFile,FileName);
Rewrite(FFile);
end;
procedure TPostScriptClassChartFormatter.EndChart;
begin
Close(FFile);
end;
Type
TOutputFormat = (ofxml,ofPostscript);
Var
OutputFormat : TOutputFormat = ofXML;
const
OSTarget: String = {$I %FPCTARGETOS%};
CPUTarget: String = {$I %FPCTARGETCPU%};
@ -277,7 +572,18 @@ begin
Engine.Free;
end;
end;
WriteXMlFile(XML,AOutputName);
Case OutputFormat of
ofXML :
WriteXMlFile(XML,AOutputName);
ofPostScript :
With TPostScriptClassChartFormatter.Create(XML) do
try
FileName:=AOutputName;
CreateChart;
finally
Free;
end;
end;
Writeln(StdErr,Format(SClassesAdded,[ACount,InputFiles.Count]));
Finally
XML.Free;
@ -377,6 +683,8 @@ begin
OutputName := Arg
else if (Cmd = '-k') or (Cmd = '--kind') then
cmdObjectKind:=TPasObjKind(GetEnumValue(TypeInfo(TPasObjKind),'ok'+Arg))
else if (Cmd = '-f') or (Cmd = '--format') then
OutputFormat:=TOutputFormat(GetEnumValue(TypeInfo(TOutputFormat),'of'+Arg))
else if Cmd = '--merge' then
begin
if FileExists(Arg) then

1
utils/fpdoc/fpdoc.lpi
View File

@ -12,6 +12,7 @@
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=""/>
</General>
<VersionInfo>