+ Option to sort nodes (in module)

+ Option to omit overridden methods
+ Option to emit declaration for certain declarations.

git-svn-id: trunk@11127 -
This commit is contained in:
michael 2008-05-29 18:31:36 +00:00
parent d419c1078a
commit 2f0ca7d70c

View File

@ -36,16 +36,35 @@ resourcestring
type
TCmdLineAction = (actionHelp, actionConvert);
TNodePair = Class(TObject)
Private
FEl : TPasElement;
FNode : TDocNode;
Public
Constructor Create(AnElement : TPasElement; ADocNode : TDocNode);
Property Element : TPasElement Read FEl;
Property DocNode : TDocNode Read FNode;
end;
TSkelEngine = class(TFPDocEngine)
Private
FEmittedList,
FNodeList,
FModules : TStringList;
Procedure DoWriteUnReferencedNodes(N : TDocNode; NodePath : String);
public
Destructor Destroy; override;
Function MustWriteElement(El : TPasElement; Full : Boolean) : Boolean;
Function WriteElement(Var F : Text; El : TPasElement; ADocNode : TDocNode) : Boolean;
function FindModule(const AName: String): TPasModule; override;
function CreateElement(AClass: TPTreeElement; const AName: String;
AParent: TPasElement; AVisibility :TPasMemberVisibility;
const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement; override;
procedure WriteUnReferencedNodes;
Procedure WriteNodes(Var F : Text; AModule : TPasModule; List : TStrings);
Procedure DocumentFile(Var F : Text; Const AFileName,ATarget,ACPU : String);
Property NodeList : TStringList Read FNodeList;
Property EmittedList : TStringList Read FEmittedList;
end;
const
@ -56,20 +75,25 @@ const
FPCDate: String = {$I %FPCDATE%};
var
EmittedList, InputFiles, DescrFiles: TStringList;
DocLang: String;
Engine: TSkelEngine;
WriteDeclaration,
UpdateMode,
SortNodes,
DisableOverride,
DisableErrors,
DisableSeealso,
DisableArguments,
DisableProtected,
DisablePrivate,
DisableFunctionResults: Boolean;
EmitClassSeparator: Boolean;
PackageName, OutputName: String;
f: Text;
Constructor TNodePair.Create(AnElement : TPasElement; ADocNode : TDocNode);
begin
Fel:=Anelement;
FNode:=ADocNode;
end;
function TSkelEngine.FindModule(const AName: String): TPasModule;
@ -110,50 +134,73 @@ begin
end;
end;
Function TSkelEngine.MustWriteElement(El : TPasElement; Full : Boolean) : Boolean;
Var
ParentVisible:Boolean;
PT,PP : TPasElement;
begin
ParentVisible:=True;
If (El is TPasArgument) or (El is TPasResultElement) then
begin
PT:=El.Parent;
// Skip ProcedureType or PasFunctionType
If (PT<>Nil) then
begin
if (PT is TPasProcedureType) or (PT is TPasFunctionType) then
PT:=PT.Parent;
If (PT<>Nil) and ((PT is TPasProcedure) or (PT is TPasProcedure)) then
PP:=PT.Parent
else
PP:=Nil;
If (PP<>Nil) and (PP is TPasClassType) then
begin
ParentVisible:=((not DisablePrivate or (PT.Visibility<>visPrivate)) and
(not DisableProtected or (PT.Visibility<>visProtected)));
end;
end;
end;
Result:=Assigned(El.Parent) and (Length(El.Name) > 0) and
(ParentVisible and (not DisableArguments or (El.ClassType <> TPasArgument))) and
(ParentVisible and (not DisableFunctionResults or (El.ClassType <> TPasResultElement))) and
(not DisablePrivate or (el.Visibility<>visPrivate)) and
(not DisableProtected or (el.Visibility<>visProtected));
If Result and Full then
begin
Result:=(Not Assigned(FEmittedList) or (FEmittedList.IndexOf(El.FullName)=-1));
If DisableOverride and (El is TPasProcedure) then
Result:=Not TPasProcedure(El).IsOverride;
end;
end;
function TSkelEngine.CreateElement(AClass: TPTreeElement; const AName: String;
AParent: TPasElement; AVisibility : TPasMemberVisibility;
const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
Function WriteThisNode(APasElement : TPasElement; DocNode : TDocNode) : Boolean;
Var
DN : TDocNode;
Var
ParentVisible:Boolean;
PT,PP : TPasElement;
begin
ParentVisible:=True;
If (APasElement is TPasArgument) or (APasElement is TPasResultElement) then
begin
PT:=AParent;
// Skip ProcedureType or PasFunctionType
If (PT<>Nil) then
begin
if (PT is TPasProcedureType) or (PT is TPasFunctionType) then
PT:=PT.Parent;
If (PT<>Nil) and ((PT is TPasProcedure) or (PT is TPasProcedure)) then
PP:=PT.Parent
else
PP:=Nil;
If (PP<>Nil) and (PP is TPasClassType) then
begin
ParentVisible:=((not DisablePrivate or (PT.Visibility<>visPrivate)) and
(not DisableProtected or (PT.Visibility<>visProtected)));
end;
end;
end;
Result:=Assigned(AParent) and (Length(AName) > 0) and
(ParentVisible and (not DisableArguments or (APasElement.ClassType <> TPasArgument))) and
(ParentVisible and (not DisableFunctionResults or (APasElement.ClassType <> TPasResultElement))) and
(not DisablePrivate or (AVisibility<>visPrivate)) and
(not DisableProtected or (AVisibility<>visProtected)) and
(Not Assigned(EmittedList) or (EmittedList.IndexOf(APasElement.FullName)=-1));
If Result and updateMode then
begin
Result:=DocNode=Nil;
If Result then
Writeln(stderr,Format(ScreatingNewNode,[APasElement.PathName]));
end;
end;
begin
Result := AClass.Create(AName, AParent);
Result.Visibility:=AVisibility;
if AClass.InheritsFrom(TPasModule) then
CurModule := TPasModule(Result);
// Track this element
If UpdateMode then
begin
DN:=FindDocNode(Result);
If Assigned(DN) then
DN.IncRefCount;
end
else
DN:=Nil;
// See if we need to write documentation for it
If MustWriteElement(Result,False) then
FNodeList.AddObject(Result.PathName,TNodePair.Create(Result,DN));
end;
Function TSkelEngine.WriteElement(Var F : Text;El : TPasElement; ADocNode : TDocNode) : Boolean;
Function WriteOnlyShort(APasElement : TPasElement) : Boolean;
@ -170,75 +217,61 @@ function TSkelEngine.CreateElement(AClass: TPTreeElement; const AName: String;
Result:=(InheritsFrom(TPasType) and not InheritsFrom(TPasClassType)) or
(InheritsFrom(TPasResString)) or
(InheritsFrom(TPasVariable));
end;
Var
DN : TDocNode;
Function NeedDeclaration(El : TPasElement) : boolean;
begin
Result:=IsTypeVarConst(El)
or WriteOnlyShort(El)
or EL.InheritsFrom(TPasProcedure)
end;
begin
Result := AClass.Create(AName, AParent);
// Check again, this time with full declaration.
Result:=MustWriteElement(El,True);
If Result and UpdateMode then
Result:=(ADocNode=Nil);
If Not Result Then
Exit;
If UpdateMode then
Writeln(stderr,Format(ScreatingNewNode,[el.PathName]));
FEmittedList.Add(El.FullName); // So we don't emit again.
WriteLn(f);
if EmitClassSeparator and (El.ClassType = TPasClassType) then
begin
DN:=FindDocNode(Result);
If Assigned(DN) then
DN.IncRefCount;
end
else
DN:=Nil;
Result.Visibility:=AVisibility;
if AClass.InheritsFrom(TPasModule) then
CurModule := TPasModule(Result);
if Result.ClassType = TPasModule then
begin
WriteLn(f);
WriteLn(f, '<!--');
WriteLn(f, ' ====================================================================');
WriteLn(f, ' ', Result.Name);
WriteLn(f, ' ====================================================================');
WriteLn(f, ' ********************************************************************');
WriteLn(f, ' ', El.PathName);
WriteLn(f, ' ********************************************************************');
WriteLn(f, '-->');
WriteLn(f);
WriteLn(f, '<module name="', Result.Name, '">');
if not UpdateMode then
begin
WriteLn(f, '<short></short>');
WriteLn(f, '<descr>');
WriteLn(f, '</descr>');
end;
end
else if WriteThisNode(Result,DN) then
begin
EmittedList.Add(Result.FullName); // So we don't emit again.
WriteLn(f);
if EmitClassSeparator and (Result.ClassType = TPasClassType) then
begin
WriteLn(f, '<!--');
WriteLn(f, ' ********************************************************************');
WriteLn(f, ' ', Result.PathName);
WriteLn(f, ' ********************************************************************');
WriteLn(f, '-->');
WriteLn(f);
end;
Writeln(F,'<!-- ', Result.ElementTypeName,' Visibility: ',VisibilityNames[AVisibility], ' -->');
WriteLn(f,'<element name="', Result.FullName, '">');
WriteLn(f, '<short></short>');
if Not WriteOnlyShort(Result) then
begin
WriteLn(f, '<descr>');
WriteLn(f, '</descr>');
if not (DisableErrors or IsTypeVarConst(Result)) then
begin
WriteLn(f, '<errors>');
WriteLn(f, '</errors>');
end;
if not DisableSeealso then
begin
WriteLn(f, '<seealso>');
WriteLn(f, '</seealso>');
end;
end;
WriteLn(f, '</element>');
end;
If Not (WriteDeclaration and NeedDeclaration(El)) then
Writeln(F,'<!-- ', El.ElementTypeName,' Visibility: ',VisibilityNames[El.Visibility], ' -->')
else
begin
Writeln(F,'<!-- ',El.ElementTypeName,' Visibility: ',VisibilityNames[El.Visibility]);
Writeln(F,' Declaration: ',El.GetDeclaration(True),' -->');
end;
WriteLn(f,'<element name="', El.FullName, '">');
WriteLn(f, '<short></short>');
if Not WriteOnlyShort(El) then
begin
WriteLn(f, '<descr>');
WriteLn(f, '</descr>');
if not (DisableErrors or IsTypeVarConst(El)) then
begin
WriteLn(f, '<errors>');
WriteLn(f, '</errors>');
end;
if not DisableSeealso then
begin
WriteLn(f, '<seealso>');
WriteLn(f, '</seealso>');
end;
end;
WriteLn(f, '</element>');
end;
Procedure TSkelEngine.DoWriteUnReferencedNodes(N : TDocNode; NodePath : String);
@ -264,43 +297,147 @@ begin
DoWriteUnReferencedNodes(RootDocNode,'');
end;
Procedure TSkelEngine.WriteNodes(Var F : Text; AModule : TPasModule; List : TStrings);
Var
P : TNodePair;
I : integer;
begin
WriteLn(f);
WriteLn(f, '<!--');
WriteLn(f, ' ====================================================================');
WriteLn(f, ' ', Amodule.Name);
WriteLn(f, ' ====================================================================');
WriteLn(f, '-->');
WriteLn(f);
WriteLn(f, '<module name="', AModule.Name, '">');
if not UpdateMode then
begin
WriteLn(f, '<short></short>');
WriteLn(f, '<descr>');
WriteLn(f, '</descr>');
end;
Try
For I:=0 to List.Count-1 do
begin
P:=List.Objects[i] as TNodePair;
If (P.Element<>AModule) then
WriteElement(F,P.Element,P.DocNode);
end;
Finally
WriteLn(f, '');
WriteLn(f, '</module> <!-- ', AModule.Name, ' -->');
WriteLn(f, '');
end;
end;
Procedure TSkelEngine.DocumentFile(Var F : Text; Const AFileName,ATarget,ACPU : String);
Var
Module : TPasModule;
I : Integer;
N : TDocNode;
begin
FNodeList:=TStringList.Create;
Try
FEmittedList:=TStringList.Create;
FEmittedList.Sorted:=True;
try
Module:=ParseSource(Self,AFileName,ATarget,ACPU);
If UpdateMode then
begin
N:=FindDocNode(Module);
If Assigned(N) then
N.IncRefCount;
end;
If SortNodes then
FNodelist.Sorted:=True;
WriteNodes(F,Module,FNodeList);
If UpdateMode then
WriteUnReferencedNodes;
Finally
FEmittedList.Free;
end;
Finally
For I:=0 to FNodeList.Count-1 do
FNodeList.Objects[i].Free;
FNodeList.Free;
end;
end;
{ ---------------------------------------------------------------------
Main program. Document all units.
---------------------------------------------------------------------}
Function DocumentPackage(Const APackageName,AOutputName : String; InputFiles,DescrFiles : TStrings) : String;
Var
F : Text;
I,J : Integer;
Engine: TSkelEngine;
begin
Assign(f, AOutputName);
Rewrite(f);
Try
WriteLn(f, '<?xml version="1.0" encoding="ISO-8859-1"?>');
WriteLn(f, '<fpdoc-descriptions>');
WriteLn(f, '<package name="', APackageName, '">');
Try
I:=0;
While (Result='') And (I<InputFiles.Count) do
begin
Engine := TSkelEngine.Create;
Try
Engine.SetPackageName(APackageName);
if UpdateMode then
For J:=0 to DescrFiles.Count-1 do
Engine.AddDocFile(DescrFiles[J]);
Try
Engine.DocumentFile(F,InputFiles[I],OSTarget,CPUTarget);
except
on E:Exception do
Result:='Error while documenting: '+E.message;
end;
Finally
Engine.Free;
end;
Inc(I);
end;
Finally
WriteLn(f, '</package>');
WriteLn(f, '</fpdoc-descriptions>');
end;
finally
Close(f);
end;
end;
{ ---------------------------------------------------------------------
Option management
---------------------------------------------------------------------}
var
InputFiles,
DescrFiles : TStringList;
DocLang : String;
PackageName,
OutputName: String;
procedure InitOptions;
begin
InputFiles := TStringList.Create;
DescrFiles := TStringList.Create;
EmittedList:=TStringList.Create;
EmittedList.Sorted:=True;
end;
procedure FreeOptions;
begin
DescrFiles.Free;
InputFiles.Free;
EmittedList.Free;
end;
Procedure Usage;
begin
Writeln('Usage : ',ExtractFileName(Paramstr(0)),' [options]');
Writeln('Where [options] is one or more of :');
Writeln(' --descr=filename Filename for update.');
Writeln(' --disable-arguments Do not create nodes for function arguments.');
Writeln(' --disable-errors Do not create errors node.');
Writeln(' --disable-function-results');
Writeln(' Do not create nodes for function arguments.');
Writeln(' --disable-private Do not create nodes for class private fields.');
Writeln(' --disable-protected Do not create nodes for class protected fields.');
Writeln(' --disable-seealso Do not create seealso node.');
Writeln(' --emit-class-separator');
Writeln(' Emit descriptive comment between classes.');
Writeln(' --help Emit help.');
Writeln(' --input=cmdline Input file to create skeleton for.');
Writeln(' Use options are as for compiler.');
Writeln(' --lang=language Use selected language.');
Writeln(' --output=filename Send output to file.');
Writeln(' --package=name Specify package name (mandatory).');
Writeln(' --update Update mode. Output only missing nodes.');
end;
procedure ParseOption(const s: String);
@ -342,6 +479,8 @@ begin
DisableSeealso := True
else if s = '--disable-private' then
DisablePrivate := True
else if s = '--disable-override' then
DisableOverride := True
else if s = '--disable-protected' then
begin
DisableProtected := True;
@ -349,6 +488,10 @@ begin
end
else if (s = '--emitclassseparator') or (s='--emit-class-separator') then
EmitClassSeparator := True
else if (s = '--emit-declaration') then
WriteDeclaration := True
else if (s = '--sort-nodes') then
SortNodes := True
else
begin
i := Pos('=', s);
@ -379,7 +522,7 @@ begin
end;
end;
procedure ParseCommandLine;
Function ParseCommandLine : Integer;
Const
{$IFDEF Unix}
@ -391,7 +534,9 @@ Const
var
MOFilename: string;
i: Integer;
begin
Result:=0;
DocLang:='';
for i := 1 to ParamCount do
ParseOption(ParamStr(i));
@ -405,95 +550,82 @@ begin
// Translate internal documentation strings
TranslateDocStrings(DocLang);
end;
// Action is to create the XML skeleton
if Length(PackageName) = 0 then
begin
WriteLn(SNoPackageNameProvided);
Result:=2;
end;
if DescrFiles.IndexOf(OutputName)<>-1 then
begin
Writeln(SOutputMustNotBeDescr);
Result:=3;
end;
end;
var
i,j: Integer;
Module: TPasModule;
N : TDocNode;
{ ---------------------------------------------------------------------
Usage
---------------------------------------------------------------------}
Procedure Usage;
begin
Writeln('Usage : ',ExtractFileName(Paramstr(0)),' [options]');
Writeln('Where [options] is one or more of :');
Writeln(' --descr=filename Filename for update.');
Writeln(' --disable-arguments Do not create nodes for function arguments.');
Writeln(' --disable-errors Do not create errors node.');
Writeln(' --disable-function-results');
Writeln(' Do not create nodes for function arguments.');
Writeln(' --disable-override Do not create nodes for override methods.');
Writeln(' --disable-private Do not create nodes for class private fields.');
Writeln(' --disable-protected Do not create nodes for class protected fields.');
Writeln(' --disable-seealso Do not create seealso node.');
Writeln(' --emit-class-separator');
Writeln(' Emit descriptive comment between classes.');
Writeln(' --emit-declaration Emit declaration for elements.');
Writeln(' --help Emit help.');
Writeln(' --input=cmdline Input file to create skeleton for.');
Writeln(' Use options are as for compiler.');
Writeln(' --lang=language Use selected language.');
Writeln(' --output=filename Send output to file.');
Writeln(' --package=name Specify package name (mandatory).');
Writeln(' --sort-nodes Sort element nodes (not modules)');
Writeln(' --update Update mode. Output only missing nodes.');
end;
{ ---------------------------------------------------------------------
Main Program
---------------------------------------------------------------------}
Procedure Run;
var
E: Integer;
begin
InitOptions;
ParseCommandLine;
WriteLn(STitle);
WriteLn(Format(SVersion, [FPCVersion, FPCDate]));
WriteLn(SCopyright);
WriteLn;
if CmdLineAction = actionHelp then
Usage
else
begin
// Action is to create the XML skeleton
if Length(PackageName) = 0 then
InitOptions;
Try
E:=ParseCommandLine;
If E<>0 then
Halt(E);
WriteLn;
if CmdLineAction = actionHelp then
Usage
else
begin
WriteLn(SNoPackageNameProvided);
Halt(2);
DocumentPackage(PackageName,OutputName,InputFiles,DescrFiles);
WriteLn(SDone);
end;
Finally
FreeOptions;
end;
end;
if DescrFiles.IndexOf(OutputName)<>-1 then
begin
Writeln(SOutputMustNotBeDescr);
Halt(3)
end;
Assign(f, OutputName);
Rewrite(f);
WriteLn(f, '<?xml version="1.0" encoding="ISO-8859-1"?>');
WriteLn(f, '<fpdoc-descriptions>');
WriteLn(f, '<package name="', PackageName, '">');
// Process all source files
for i := 0 to InputFiles.Count - 1 do
begin
Engine := TSkelEngine.Create;
try
try
Engine.SetPackageName(PackageName);
if UpdateMode then
For J:=0 to DescrFiles.Count-1 do
Engine.AddDocFile(DescrFiles[J]);
Module := ParseSource(Engine, InputFiles[i], OSTarget, CPUTarget);
If UpdateMode then
begin
N:=Engine.FindDocNode(Module);
If Assigned(N) then
N.IncRefCount;
end;
WriteLn(f, '');
WriteLn(f, '</module> <!-- ', Module.Name, ' -->');
WriteLn(f, '');
except
on e:EFileNotFoundError do
begin
Writeln(StdErr,' file ', e.message, ' not found');
close(f);
Halt(1);
end;
on e:EParserError do
begin
Writeln(StdErr,'', e.filename,'(',e.row,',',e.column,') Fatal: ',e.message);
close(f);
Halt(1);
end;
end;
If UpdateMode then
Engine.WriteUnReferencedNodes;
finally
Engine.Free;
end;
end;
WriteLn(f, '</package>');
WriteLn(f, '</fpdoc-descriptions>');
Close(f);
WriteLn(SDone);
end;
FreeOptions;
Begin
Run;
end.