paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2026-01-04 05:50:46 +01:00
Code Issues Packages Projects Releases Wiki Activity

* Initial implementation

Browse Source 
git-svn-id: trunk@11649 -
This commit is contained in:
michael 2008-08-25 13:47:06 +00:00
parent c5007f1cad
commit f083839a76
3 changed files with 687 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -9603,6 +9603,8 @@ utils/fpdoc/dw_txt.pp svneol=native#text/plain
utils/fpdoc/dw_xml.pp svneol=native#text/plain
utils/fpdoc/dwlinear.pp svneol=native#text/plain
utils/fpdoc/dwriter.pp svneol=native#text/plain
utils/fpdoc/fpclasschart.lpi svneol=native#text/plain
utils/fpdoc/fpclasschart.pp svneol=native#text/plain
utils/fpdoc/fpde/Makefile svneol=native#text/plain
utils/fpdoc/fpde/Makefile.fpc svneol=native#text/plain
utils/fpdoc/fpde/bitmaps/bold.xpm -text

230
utils/fpdoc/fpclasschart.lpi Normal file
View File

@ -0,0 +1,230 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="/"/>
<Version Value="6"/>
<General>
<Flags>
<MainUnitHasUsesSectionForAllUnits Value="False"/>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
</Flags>
<MainUnit Value="0"/>
<TargetFileExt Value=""/>
<ActiveEditorIndexAtStart Value="0"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
<Language Value=""/>
<CharSet Value=""/>
</VersionInfo>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<Units Count="6">
<Unit0>
<Filename Value="fpclasschart.pp"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpclasschart"/>
<CursorPos X="1" Y="125"/>
<TopLine Value="113"/>
<EditorIndex Value="0"/>
<UsageCount Value="20"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
<Filename Value="../../../../fpc/packages/fcl-passrc/src/pastree.pp"/>
<UnitName Value="PasTree"/>
<CursorPos X="25" Y="272"/>
<TopLine Value="240"/>
<EditorIndex Value="5"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
<Filename Value="../../../../fpc/packages/fcl-xml/src/dom.pp"/>
<UnitName Value="DOM"/>
<CursorPos X="14" Y="462"/>
<TopLine Value="436"/>
<EditorIndex Value="4"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit2>
<Unit3>
<Filename Value="../../../../fpc/packages/fcl-xml/src/xmlread.pp"/>
<UnitName Value="XMLRead"/>
<CursorPos X="10" Y="1283"/>
<TopLine Value="1239"/>
<EditorIndex Value="3"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
<Filename Value="../../../../fpc/packages/fcl-passrc/src/pparser.pp"/>
<UnitName Value="PParser"/>
<CursorPos X="1" Y="2111"/>
<TopLine Value="2084"/>
<EditorIndex Value="2"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit4>
<Unit5>
<Filename Value="dglobals.pp"/>
<IsPartOfProject Value="True"/>
<UnitName Value="dGlobals"/>
<CursorPos X="1" Y="277"/>
<TopLine Value="277"/>
<EditorIndex Value="1"/>
<UsageCount Value="20"/>
<Loaded Value="True"/>
</Unit5>
</Units>
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="fpclasschart.pp"/>
<Caret Line="127" Column="28" TopLine="123"/>
</Position1>
<Position2>
<Filename Value="fpclasschart.pp"/>
<Caret Line="156" Column="37" TopLine="129"/>
</Position2>
<Position3>
<Filename Value="fpclasschart.pp"/>
<Caret Line="112" Column="1" TopLine="67"/>
</Position3>
<Position4>
<Filename Value="fpclasschart.pp"/>
<Caret Line="162" Column="21" TopLine="139"/>
</Position4>
<Position5>
<Filename Value="fpclasschart.pp"/>
<Caret Line="140" Column="22" TopLine="129"/>
</Position5>
<Position6>
<Filename Value="fpclasschart.pp"/>
<Caret Line="265" Column="1" TopLine="220"/>
</Position6>
<Position7>
<Filename Value="fpclasschart.pp"/>
<Caret Line="202" Column="13" TopLine="174"/>
</Position7>
<Position8>
<Filename Value="fpclasschart.pp"/>
<Caret Line="233" Column="19" TopLine="189"/>
</Position8>
<Position9>
<Filename Value="fpclasschart.pp"/>
<Caret Line="209" Column="1" TopLine="186"/>
</Position9>
<Position10>
<Filename Value="fpclasschart.pp"/>
<Caret Line="230" Column="28" TopLine="206"/>
</Position10>
<Position11>
<Filename Value="fpclasschart.pp"/>
<Caret Line="32" Column="57" TopLine="1"/>
</Position11>
<Position12>
<Filename Value="fpclasschart.pp"/>
<Caret Line="286" Column="19" TopLine="284"/>
</Position12>
<Position13>
<Filename Value="fpclasschart.pp"/>
<Caret Line="424" Column="3" TopLine="405"/>
</Position13>
<Position14>
<Filename Value="fpclasschart.pp"/>
<Caret Line="247" Column="11" TopLine="237"/>
</Position14>
<Position15>
<Filename Value="fpclasschart.pp"/>
<Caret Line="260" Column="37" TopLine="237"/>
</Position15>
<Position16>
<Filename Value="fpclasschart.pp"/>
<Caret Line="261" Column="30" TopLine="238"/>
</Position16>
<Position17>
<Filename Value="fpclasschart.pp"/>
<Caret Line="271" Column="24" TopLine="238"/>
</Position17>
<Position18>
<Filename Value="fpclasschart.pp"/>
<Caret Line="56" Column="6" TopLine="44"/>
</Position18>
<Position19>
<Filename Value="fpclasschart.pp"/>
<Caret Line="125" Column="7" TopLine="112"/>
</Position19>
<Position20>
<Filename Value="fpclasschart.pp"/>
<Caret Line="56" Column="26" TopLine="42"/>
</Position20>
<Position21>
<Filename Value="fpclasschart.pp"/>
<Caret Line="125" Column="22" TopLine="112"/>
</Position21>
<Position22>
<Filename Value="fpclasschart.pp"/>
<Caret Line="112" Column="26" TopLine="89"/>
</Position22>
<Position23>
<Filename Value="fpclasschart.pp"/>
<Caret Line="56" Column="33" TopLine="24"/>
</Position23>
<Position24>
<Filename Value="fpclasschart.pp"/>
<Caret Line="125" Column="27" TopLine="102"/>
</Position24>
<Position25>
<Filename Value="fpclasschart.pp"/>
<Caret Line="158" Column="63" TopLine="144"/>
</Position25>
<Position26>
<Filename Value="fpclasschart.pp"/>
<Caret Line="183" Column="17" TopLine="158"/>
</Position26>
<Position27>
<Filename Value="fpclasschart.pp"/>
<Caret Line="125" Column="1" TopLine="102"/>
</Position27>
<Position28>
<Filename Value="fpclasschart.pp"/>
<Caret Line="174" Column="48" TopLine="151"/>
</Position28>
<Position29>
<Filename Value="fpclasschart.pp"/>
<Caret Line="274" Column="24" TopLine="250"/>
</Position29>
<Position30>
<Filename Value="../../../../fpc/packages/fcl-passrc/src/pparser.pp"/>
<Caret Line="81" Column="10" TopLine="58"/>
</Position30>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
<Version Value="8"/>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="2">
<Item1>
<Name Value="ECodetoolError"/>
</Item1>
<Item2>
<Name Value="EFOpenError"/>
</Item2>
</Exceptions>
</Debugging>
</CONFIG>

455
utils/fpdoc/fpclasschart.pp Normal file
View File

@ -0,0 +1,455 @@
{
FPClass chart - Free Pascal class chart generation tool
Copyright (c) 2008 - Michael Van Canneyt, michael@freepascal.org
* Free Pascal class chart generation tool
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+}
program fpclasschart;
uses
SysUtils, Classes, Typinfo, Gettext, dom, xmlread,
dGlobals, PasTree, PParser,PScanner, xmlwrite;
resourcestring
STitle = 'fpClassTree - Create class tree from pascal sources';
SVersion = 'Version %s [%s]';
SCopyright = '(c) 2008 - Michael Van Canneyt, michael@freepascal.org';
SCmdLineHelp = 'See documentation for usage.';
SCmdLineInvalidOption = 'Ignoring unknown option "%s"';
SDone = 'Done.';
SSkipMerge = 'Cannot merge %s into %s tree.';
SErrNoSuchMergeFile = 'Merge file %s does not exist.';
SMergedFile = 'Merged %d classes from file %s.';
SClassesAdded = 'Added %d classes from %d files.';
Const
RootNames : Array[TPasObjKind] of string
= ('Objects', 'Classes', 'Interfaces');
type
{ TClassTreeEngine }
TClassTreeEngine = class(TFPDocEngine)
Private
FClassTree : TXMLDocument;
FTreeStart : TDomElement;
FObjects : TStringList;
FObjectKind : TPasObjKind;
FParentObject : TPasClassType;
function LookForElement(PE: TDomElement; AElement: TPasElement): TDomNode;
function NodeMatch(N: TDomNode; AElement: TPasElement): Boolean;
Function AddToClassTree(AElement : TPasElement; Var ACount : Integer) : TDomElement;
public
Constructor Create(AClassTree : TXMLDocument; AObjectKind : TPasObjKind);
Destructor Destroy; override;
Function BuildTree : Integer;
function CreateElement(AClass: TPTreeElement; const AName: String;
AParent: TPasElement; AVisibility :TPasMemberVisibility;
const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement; override;
end;
const
OSTarget: String = {$I %FPCTARGETOS%};
CPUTarget: String = {$I %FPCTARGETCPU%};
FPCVersion: String = {$I %FPCVERSION%};
FPCDate: String = {$I %FPCDATE%};
function TClassTreeEngine.CreateElement(AClass: TPTreeElement; const AName: String;
AParent: TPasElement; AVisibility : TPasMemberVisibility;
const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
Var
DN : TDocNode;
begin
Result := AClass.Create(AName, AParent);
Result.Visibility:=AVisibility;
if AClass.InheritsFrom(TPasModule) then
CurModule := TPasModule(Result);
If AClass.InheritsFrom(TPasClassType) then
FObjects.AddObject(AName,Result);
end;
Constructor TClassTreeEngine.Create(AClassTree : TXMLDocument; AObjectKind : TPasObjKind);
Var
N : TDomNode;
begin
FClassTree:=AClassTree;
FTreeStart:=FClassTree.DocumentElement;
FPackage:=TPasPackage.Create('dummy',Nil);
FObjectKind:=AObjectKind;
FObjects:=TStringList.Create;
Case FObjectkind of
okObject : FParentObject:=TPasClassType.Create('TObject',FPackage);
okClass : FParentObject:=TPasClassType.Create('TObject',FPackage);
okInterface : FParentObject:=TPasClassType.Create('IInterface',FPackage);
end;
FParentObject.ObjKind:=FObjectKind;
Inherited Create;
end;
destructor TClassTreeEngine.Destroy;
begin
FreeAndNil(FObjects);
inherited Destroy;
end;
Function TClassTreeEngine.BuildTree : Integer;
Var
I : Integer;
PC : TPasClassType;
begin
Result:=0;
FObjects.Sorted:=True;
For I:=0 to FObjects.Count-1 do
begin
PC:=TPasClassType(FObjects.Objects[i]);
If (PC.ObjKind=FObjectKind) and Not PC.IsForward then
AddToClassTree(PC as TPasElement,Result)
end;
end;
Function TClassTreeEngine.NodeMatch(N : TDomNode; AElement : TPasElement) : Boolean;
begin
Result:=(N.NodeType=ELEMENT_NODE) and (CompareText(N.NodeName,AElement.Name)=0)
end;
Function TClassTreeEngine.LookForElement(PE : TDomElement; AElement : TPasElement) : TDomNode;
Var
N : TDomNode;
begin
Result:=PE.FirstChild;
While (Result<>Nil) and Not NodeMatch(Result,AElement) do
Result:=Result.NextSibling;
If (Result=Nil) then
begin
N:=PE.FirstChild;
While (Result=Nil) and (N<>Nil) do
begin
if (N.NodeType=ELEMENT_NODE) then
begin
Result:=LookForElement(N as TDomElement,AElement);
end;
N:=N.NextSibling;
end;
end
end;
Function TClassTreeEngine.AddToClassTree(AElement : TPasElement; Var ACount : Integer) : TDomElement;
Var
PC : TPasClassType;
PE : TDomElement;
M : TPasModule;
N : TDomNode;
begin
PE:=Nil;
If (AElement is TPasClassType) then
begin
PC:=AElement as TPasClassType;
If not Assigned(PC.AncestorType) and (CompareText(PC.Name,FParentObject.Name)<>0) then
PC.AncestorType:=FParentObject;
If Assigned(PC.AncestorType) then
PE:=AddToClassTree(PC.AncestorType,ACount);
end;
If (PE=Nil) then
PE:=FTreeStart;
N:=LookForElement(PE,AElement);
If (N<>Nil) then
Result:=N as TDomElement
else
begin
Inc(ACount);
Result:=FClassTree.CreateElement(AElement.Name);
If Not (AElement is TPasUnresolvedTypeRef) then
begin
M:=AElement.GetModule;
if Assigned(M) then
Result['unit']:=M.Name;
end;
PE.AppendChild(Result);
end;
end;
{ ---------------------------------------------------------------------
Main program. Document all units.
---------------------------------------------------------------------}
Function MergeNodes(Doc : TXMLDocument;Dest,Source : TDomElement) : Integer;
Var
N : TDomNode;
S,E : TDomElement;
begin
N:=Source.FirstChild;
While (N<>Nil) do
begin
if (N.NodeType=ELEMENT_NODE) then
begin
S:=N as TDomElement;
E:=Dest.FindNode(N.NodeName) as TDomElement;
If (E=Nil) then
begin
E:=Doc.CreateElement(N.NodeName);
If S['unit']<>'' then
E['Unit']:=S['unit'];
Dest.AppendChild(E);
Inc(Result);
end;
Result:=Result+MergeNodes(Doc,E,S);
end;
N:=N.NextSibling;
end;
end;
Function MergeTrees (Dest,Source : TXMLDocument) : Integer;
Var
S,D : TDomElement;
Count : Integer;
begin
Result:=0;
D:=Dest.DocumentElement;
S:=Source.DocumentElement;
If (S.NodeName=D.NodeName) then
Result:=MergeNodes(Dest,D,S)
else
Writeln(StdErr,Format(SSkipMerge,[S.NodeName,D.NodeName]));
end;
Function AnalyseFiles(Const AOutputName : String; InputFiles,MergeFiles : TStrings; AObjectKind : TPasObjKind) : String;
Var
XML,XML2 : TXMLDocument;
I,ACount : Integer;
Engine: TClassTreeEngine;
begin
XML:=TXMLDocument.Create;
Try
//XML.
XML.AppendChild(XML.CreateElement(RootNames[AObjectKind]));
For I:=0 to MergeFiles.Count-1 do
begin
XMl2:=TXMLDocument.Create;
ReadXMLFile(XML2,MergeFiles[i]);
try
ACount:=MergeTrees(XML,XML2);
WriteLn(StdErr,Format(SMergedFile,[ACount,MergeFiles[i]]));
Finally
FreeAndNil(XML2);
end;
end;
ACount:=0;
For I:=0 to InputFiles.Count-1 do
begin
Engine := TClassTreeEngine.Create(XML,AObjectKind);
Try
ParseSource(Engine,InputFiles[I],OSTarget,CPUTarget);
ACount:=ACount+Engine.BuildTree;
Finally
Engine.Free;
end;
end;
WriteXMlFile(XML,AOutputName);
Writeln(StdErr,Format(SClassesAdded,[ACount,InputFiles.Count]));
Finally
XML.Free;
end;
end;
{ ---------------------------------------------------------------------
Option management
---------------------------------------------------------------------}
var
cmdObjectKind : TPasObjKind;
InputFiles,
MergeFiles : TStringList;
DocLang : String;
PackageName,
OutputName: String;
procedure InitOptions;
begin
InputFiles := TStringList.Create;
MergeFiles := TStringList.Create;
end;
procedure FreeOptions;
begin
MergeFiles.Free;
InputFiles.Free;
end;
{ ---------------------------------------------------------------------
Usage
---------------------------------------------------------------------}
Procedure Usage;
begin
Writeln('Usage : ',ExtractFileName(Paramstr(0)),' [options]');
Writeln('Where [options] is one or more of :');
Writeln(' --merge=filename Filename with object tree to merge.');
Writeln(' --help Emit help.');
Writeln(' --input=cmdline Input file to create skeleton for.');
Writeln(' Use options are as for compiler.');
Writeln(' --kind=objectkind Specify object kind. One of object, class, interface.');
Writeln(' --lang=language Use selected language.');
Writeln(' --output=filename Send output to file.');
end;
procedure ParseOption(const s: String);
procedure AddToFileList(List: TStringList; const FileName: String);
var
f: Text;
s: String;
begin
if Copy(FileName, 1, 1) = '@' then
begin
Assign(f, Copy(FileName, 2, Length(FileName)));
Reset(f);
while not EOF(f) do
begin
ReadLn(f, s);
List.Add(s);
end;
Close(f);
end else
List.Add(FileName);
end;
var
i: Integer;
Cmd, Arg: String;
begin
cmdObjectKind:=okClass;
if (s = '-h') or (s = '--help') then
begin
Usage;
Halt(0);
end;
i := Pos('=', s);
if i > 0 then
begin
Cmd := Copy(s, 1, i - 1);
Arg := Copy(s, i + 1, Length(s));
end else
begin
Cmd := s;
SetLength(Arg, 0);
end;
if (Cmd = '-i') or (Cmd = '--input') then
AddToFileList(InputFiles, Arg)
else if (Cmd = '-l') or (Cmd = '--lang') then
DocLang := Arg
else if (Cmd = '-o') or (Cmd = '--output') then
OutputName := Arg
else if (Cmd = '-k') or (Cmd = '--kind') then
cmdObjectKind:=TPasObjKind(GetEnumValue(TypeInfo(TPasObjKind),'ok'+Arg))
else if Cmd = '--merge' then
begin
if FileExists(Arg) then
MergeFiles.Add(Arg)
else
Writeln(StdErr,Format(SErrNoSuchMergeFile,[arg]));
end
else
begin
WriteLn(StdErr, Format(SCmdLineInvalidOption, [s]));
Usage;
Halt(1);
end;
end;
Function ParseCommandLine : Integer;
Const
{$IFDEF Unix}
MoFileTemplate = '/usr/local/share/locale/%s/LC_MESSAGES/makeskel.mo';
{$ELSE}
MoFileTemplate ='intl/makeskel.%s.mo';
{$ENDIF}
var
MOFilename: string;
i: Integer;
begin
Result:=0;
DocLang:='';
for i := 1 to ParamCount do
ParseOption(ParamStr(i));
If (DocLang<>'') then
begin
MOFilename:=Format(MOFileTemplate,[DocLang]);
if FileExists(MOFilename) then
gettext.TranslateResourceStrings(MoFileName)
else
writeln('NOTE: unable to find tranlation file ',MOFilename);
// Translate internal documentation strings
TranslateDocStrings(DocLang);
end;
end;
{ ---------------------------------------------------------------------
Main Program
---------------------------------------------------------------------}
Procedure Run;
var
E: Integer;
begin
WriteLn(STitle);
WriteLn(Format(SVersion, [FPCVersion, FPCDate]));
WriteLn(SCopyright);
InitOptions;
Try
E:=ParseCommandLine;
If E<>0 then
Halt(E);
WriteLn;
AnalyseFiles(OutputName,InputFiles,MergeFiles,cmdObjectKind);
WriteLn(StdErr,SDone);
Finally
FreeOptions;
end;
end;
Begin
Run;
end.