mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-04 15:39:24 +01:00
632 lines
17 KiB
ObjectPascal
632 lines
17 KiB
ObjectPascal
{
|
|
|
|
FPDoc - Free Pascal Documentation Tool
|
|
Copyright (C) 2000 - 2003 by
|
|
Areca Systems GmbH / Sebastian Guenther, sg@freepascal.org
|
|
|
|
* Skeleton XML description file generator
|
|
|
|
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.
|
|
}
|
|
|
|
|
|
program MakeSkel;
|
|
|
|
uses
|
|
SysUtils, Classes, Gettext,
|
|
dGlobals, PasTree, PParser,PScanner;
|
|
|
|
resourcestring
|
|
STitle = 'MakeSkel - FPDoc skeleton XML description file generator';
|
|
SVersion = 'Version %s [%s]';
|
|
SCopyright = '(c) 2000 - 2003 Areca Systems GmbH / Sebastian Guenther, sg@freepascal.org';
|
|
SCmdLineHelp = 'See documentation for usage.';
|
|
SCmdLineInvalidOption = 'Ignoring unknown option "%s"';
|
|
SNoPackageNameProvided = 'Please specify a package name with --package=<name>';
|
|
SOutputMustNotBeDescr = 'Output file must be different from description filenames.';
|
|
SCreatingNewNode = 'Creating documentation for new node : %s';
|
|
SNodeNotReferenced = 'Documentation node "%s" no longer used';
|
|
SDone = 'Done.';
|
|
|
|
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
|
|
CmdLineAction: TCmdLineAction = actionConvert;
|
|
OSTarget: String = {$I %FPCTARGETOS%};
|
|
CPUTarget: String = {$I %FPCTARGETCPU%};
|
|
FPCVersion: String = {$I %FPCVERSION%};
|
|
FPCDate: String = {$I %FPCDATE%};
|
|
|
|
var
|
|
WriteDeclaration,
|
|
UpdateMode,
|
|
SortNodes,
|
|
DisableOverride,
|
|
DisableErrors,
|
|
DisableSeealso,
|
|
DisableArguments,
|
|
DisableProtected,
|
|
DisablePrivate,
|
|
DisableFunctionResults: Boolean;
|
|
EmitClassSeparator: Boolean;
|
|
|
|
|
|
Constructor TNodePair.Create(AnElement : TPasElement; ADocNode : TDocNode);
|
|
|
|
begin
|
|
Fel:=Anelement;
|
|
FNode:=ADocNode;
|
|
end;
|
|
|
|
function TSkelEngine.FindModule(const AName: String): TPasModule;
|
|
|
|
Var
|
|
I : Integer;
|
|
|
|
begin
|
|
Result:=Inherited FindModule(AName);
|
|
If (Result=Nil) then
|
|
begin // Create dummy list and search in that.
|
|
If (FModules=Nil) then
|
|
begin
|
|
FModules:=TStringList.Create;
|
|
FModules.Sorted:=True;
|
|
end;
|
|
I:=FModules.IndexOf(AName);
|
|
IF (I=-1) then
|
|
begin
|
|
Result:=TPasModule.Create(AName,Nil);
|
|
FModules.AddObject(AName,Result);
|
|
end
|
|
else
|
|
Result:=FModules.Objects[i] as TPasModule;
|
|
end;
|
|
end;
|
|
|
|
Destructor TSkelEngine.Destroy;
|
|
|
|
Var
|
|
I : Integer;
|
|
|
|
begin
|
|
If Assigned(FModules) then
|
|
begin
|
|
For I:=0 to FModules.Count-1 do
|
|
FModules.Objects[i].Free;
|
|
FreeAndNil(FModules);
|
|
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;
|
|
|
|
Var
|
|
DN : TDocNode;
|
|
|
|
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;
|
|
|
|
begin
|
|
Result:=(APasElement.ClassType=TPasArgument) or
|
|
(APasElement.ClassType=TPasResultElement) or
|
|
(APasElement.ClassType=TPasEnumValue);
|
|
end;
|
|
|
|
Function IsTypeVarConst(APasElement : TPasElement) : Boolean;
|
|
|
|
begin
|
|
With APasElement do
|
|
Result:=(InheritsFrom(TPasType) and not InheritsFrom(TPasClassType)) or
|
|
(InheritsFrom(TPasResString)) or
|
|
(InheritsFrom(TPasVariable));
|
|
end;
|
|
|
|
Function NeedDeclaration(El : TPasElement) : boolean;
|
|
|
|
begin
|
|
Result:=IsTypeVarConst(El)
|
|
or WriteOnlyShort(El)
|
|
or EL.InheritsFrom(TPasProcedure)
|
|
end;
|
|
|
|
begin
|
|
// 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
|
|
WriteLn(f, '<!--');
|
|
WriteLn(f, ' ********************************************************************');
|
|
WriteLn(f, ' ', El.PathName);
|
|
WriteLn(f, ' ********************************************************************');
|
|
WriteLn(f, '-->');
|
|
WriteLn(f);
|
|
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);
|
|
|
|
begin
|
|
If (N<>Nil) then
|
|
begin
|
|
If (NodePath<>'') then
|
|
NodePath:=NodePath+'.';
|
|
DoWriteUnReferencedNodes(N.FirstChild,NodePath+N.Name);
|
|
While (N<>Nil) do
|
|
begin
|
|
if (N.RefCount=0) and (N.Node<>Nil) and (Not N.TopicNode) then
|
|
Writeln(stderr,Format(SNodeNotReferenced,[NodePath+N.Name]));
|
|
N:=N.NextSibling;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TSkelEngine.WriteUnReferencedNodes;
|
|
|
|
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;
|
|
end;
|
|
|
|
procedure FreeOptions;
|
|
|
|
begin
|
|
DescrFiles.Free;
|
|
InputFiles.Free;
|
|
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
|
|
if (s = '-h') or (s = '--help') then
|
|
CmdLineAction := actionHelp
|
|
else if s = '--update' then
|
|
UpdateMode := True
|
|
else if s = '--disable-arguments' then
|
|
DisableArguments := True
|
|
else if s = '--disable-errors' then
|
|
DisableErrors := True
|
|
else if s = '--disable-function-results' then
|
|
DisableFunctionResults := True
|
|
else if s = '--disable-seealso' then
|
|
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;
|
|
DisablePrivate :=True;
|
|
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);
|
|
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 = '--package' then
|
|
PackageName := Arg
|
|
else if Cmd = '--descr' then
|
|
begin
|
|
if FileExists(Arg) then
|
|
DescrFiles.Add(Arg);
|
|
end
|
|
else
|
|
WriteLn(StdErr, Format(SCmdLineInvalidOption, [s]));
|
|
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;
|
|
// Action is to create the XML skeleton
|
|
if (Length(PackageName) = 0) and (CmdLineAction<>ActionHelp) then
|
|
begin
|
|
WriteLn(SNoPackageNameProvided);
|
|
Result:=2;
|
|
end;
|
|
if DescrFiles.IndexOf(OutputName)<>-1 then
|
|
begin
|
|
Writeln(SOutputMustNotBeDescr);
|
|
Result:=3;
|
|
end;
|
|
end;
|
|
|
|
{ ---------------------------------------------------------------------
|
|
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
|
|
WriteLn(STitle);
|
|
WriteLn(Format(SVersion, [FPCVersion, FPCDate]));
|
|
WriteLn(SCopyright);
|
|
InitOptions;
|
|
Try
|
|
E:=ParseCommandLine;
|
|
If E<>0 then
|
|
Halt(E);
|
|
WriteLn;
|
|
if CmdLineAction = actionHelp then
|
|
Usage
|
|
else
|
|
begin
|
|
DocumentPackage(PackageName,OutputName,InputFiles,DescrFiles);
|
|
WriteLn(SDone);
|
|
end;
|
|
Finally
|
|
FreeOptions;
|
|
end;
|
|
end;
|
|
|
|
Begin
|
|
Run;
|
|
end.
|
|
|