mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-01 12:09:48 +01:00
+ 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:
parent
d419c1078a
commit
2f0ca7d70c
@ -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.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user