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

Logging options implemented, and dry run. Separated out creation and logging logic

Browse Source 
git-svn-id: trunk@19753 -
This commit is contained in:
michael 2011-12-04 18:16:51 +00:00
parent 3935cf7460
commit 2d928cbee8
7 changed files with 317 additions and 153 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -12912,6 +12912,7 @@ utils/fpdoc/intl/makeskel.de.po svneol=native#text/plain
utils/fpdoc/makeskel.lpi svneol=native#text/plain utils/fpdoc/makeskel.lpi svneol=native#text/plain
utils/fpdoc/makeskel.pp svneol=native#text/plain utils/fpdoc/makeskel.pp svneol=native#text/plain
utils/fpdoc/mgrfpdocproj.pp svneol=native#text/plain utils/fpdoc/mgrfpdocproj.pp svneol=native#text/plain
utils/fpdoc/mkfpdoc.pp svneol=native#text/plain
utils/fpdoc/mkfpdocproj.lpi svneol=native#text/plain utils/fpdoc/mkfpdocproj.lpi svneol=native#text/plain
utils/fpdoc/mkfpdocproj.pp svneol=native#text/plain utils/fpdoc/mkfpdocproj.pp svneol=native#text/plain
utils/fpdoc/sample-project.xml svneol=native#text/plain utils/fpdoc/sample-project.xml svneol=native#text/plain

66
utils/fpdoc/dglobals.pp
View File

@ -151,6 +151,8 @@ resourcestring
SUsageOption190 = '--parse-impl (Experimental) try to parse implementation too'; SUsageOption190 = '--parse-impl (Experimental) try to parse implementation too';
SUsageOption200 = '--dont-trim Don''t trim XML contents'; SUsageOption200 = '--dont-trim Don''t trim XML contents';
SUsageOption210 = '--write-project=file Do not write documentation, create project file instead'; SUsageOption210 = '--write-project=file Do not write documentation, create project file instead';
SUsageOption220 = '--verbose Write more information on the screen';
SUsageOption230 = '--dry-run Only parse sources and XML, do not create output';
SUsageFormats = 'The following output formats are supported by this fpdoc:'; SUsageFormats = 'The following output formats are supported by this fpdoc:';
SUsageBackendHelp = 'Specify an output format, combined with --help to get more help for this backend.'; SUsageBackendHelp = 'Specify an output format, combined with --help to get more help for this backend.';
@ -263,11 +265,13 @@ type
// The main FPDoc engine // The main FPDoc engine
TFPDocLogLevel = (dleWarnNoNode);
TFPDocLogLevels = set of TFPDocLogLevel;
{ TFPDocEngine } { TFPDocEngine }
TFPDocEngine = class(TPasTreeContainer) TFPDocEngine = class(TPasTreeContainer)
private private
FDocLogLevels: TFPDocLogLevels;
protected protected
DescrDocs: TObjectList; // List of XML documents DescrDocs: TObjectList; // List of XML documents
DescrDocNames: TStringList; // Names of the XML documents DescrDocNames: TStringList; // Names of the XML documents
@ -276,6 +280,9 @@ type
FPackages: TFPList; // List of TFPPackage objects FPackages: TFPList; // List of TFPPackage objects
CurModule: TPasModule; CurModule: TPasModule;
CurPackageDocNode: TDocNode; CurPackageDocNode: TDocNode;
Function LogEvent(E : TFPDocLogLevel) : Boolean;
Procedure DoLog(Const Msg : String);overload;
Procedure DoLog(Const Fmt : String; Args : Array of const);overload;
public public
Output: String; Output: String;
HasContentFile: Boolean; HasContentFile: Boolean;
@ -315,7 +322,7 @@ type
property RootLinkNode: TLinkNode read FRootLinkNode; property RootLinkNode: TLinkNode read FRootLinkNode;
property RootDocNode: TDocNode read FRootDocNode; property RootDocNode: TDocNode read FRootDocNode;
property Package: TPasPackage read FPackage; Property DocLogLevels : TFPDocLogLevels Read FDocLogLevels Write FDocLogLevels;
end; end;
@ -327,6 +334,7 @@ Function IsExampleNode(Example : TDomNode) : Boolean;
// returns true is link is an absolute URI // returns true is link is an absolute URI
Function IsLinkAbsolute(ALink: String): boolean; Function IsLinkAbsolute(ALink: String): boolean;
implementation implementation
uses SysUtils, Gettext, XMLRead; uses SysUtils, Gettext, XMLRead;
@ -432,7 +440,7 @@ begin
{ No child found, let's create one if we are at the end of the path } { No child found, let's create one if we are at the end of the path }
if DotPos > 0 then if DotPos > 0 then
// !!!: better throw an exception // !!!: better throw an exception
WriteLn('Link path does not exist: ', APathName); Raise Exception.CreateFmt('Link path does not exist: %s',[APathName]);
Result := TLinkNode.Create(ChildName, ALinkTo); Result := TLinkNode.Create(ChildName, ALinkTo);
if Assigned(LastChild) then if Assigned(LastChild) then
LastChild.FNextSibling := Result LastChild.FNextSibling := Result
@ -547,6 +555,22 @@ end;
{ TFPDocEngine } { TFPDocEngine }
function TFPDocEngine.LogEvent(E: TFPDocLogLevel): Boolean;
begin
Result:=E in FDocLogLevels;
end;
procedure TFPDocEngine.DoLog(const Msg: String);
begin
If Assigned(OnLog) then
OnLog(Self,Msg);
end;
procedure TFPDocEngine.DoLog(const Fmt: String; Args: array of const);
begin
DoLog(Format(Fmt,Args));
end;
constructor TFPDocEngine.Create; constructor TFPDocEngine.Create;
begin begin
inherited Create; inherited Create;
@ -795,7 +819,7 @@ var
end end
else else
if cls<>result then if cls<>result then
writeln('Warning : ancestor class ',clname,' of class ',cls.name,' could not be resolved'); DoLog('Warning : ancestor class %s of class %s could not be resolved',[clname,cls.name]);
end; end;
function CreateAliasType (alname,clname : string;parentclass:TPasClassType; out cl2 :TPasClassType):TPasAliasType; function CreateAliasType (alname,clname : string;parentclass:TPasClassType; out cl2 :TPasClassType):TPasAliasType;
@ -855,7 +879,7 @@ end;
begin begin
// writeln('Found alias pair ',clname,' = ',alname); // writeln('Found alias pair ',clname,' = ',alname);
if not assigned(CreateAliasType(alname,clname,cls,cls2)) then if not assigned(CreateAliasType(alname,clname,cls,cls2)) then
writeln('Warning: creating alias ',alname,' for ',clname,' failed!'); DoLog('Warning: creating alias %s for %s failed!',[alname,clname]);
end end
else else
cls2:=ResolveAndLinkClass(clname,j=0,cls); cls2:=ResolveAndLinkClass(clname,j=0,cls);
@ -1106,30 +1130,20 @@ function TFPDocEngine.FindElement(const AName: String): TPasElement;
var var
i: Integer; i: Integer;
//ModuleName, LocalName: String;
Module: TPasElement; Module: TPasElement;
begin begin
{!!!: Don't know if we ever will have to use the following: Result := FindInModule(CurModule, AName);
i := Pos('.', AName); if not Assigned(Result) then
if i <> 0 then for i := CurModule.InterfaceSection.UsesList.Count - 1 downto 0 do
begin begin
WriteLn('Dot found in name: ', AName); Module := TPasElement(CurModule.InterfaceSection.UsesList[i]);
Result := nil; if Module.ClassType = TPasModule then
end else
begin}
Result := FindInModule(CurModule, AName);
if not Assigned(Result) then
for i := CurModule.InterfaceSection.UsesList.Count - 1 downto 0 do
begin begin
Module := TPasElement(CurModule.InterfaceSection.UsesList[i]); Result := FindInModule(TPasModule(Module), AName);
if Module.ClassType = TPasModule then if Assigned(Result) then
begin exit;
Result := FindInModule(TPasModule(Module), AName);
if Assigned(Result) then
exit;
end;
end; end;
{end;} end;
end; end;
function TFPDocEngine.FindModule(const AName: String): TPasModule; function TFPDocEngine.FindModule(const AName: String): TPasModule;
@ -1416,7 +1430,7 @@ begin
WarnNoNode and WarnNoNode and
(Length(AElement.PathName)>0) and (Length(AElement.PathName)>0) and
(AElement.PathName[1]='#') then (AElement.PathName[1]='#') then
Writeln('No documentation node found for identifier : ',AElement.PathName); DoLog(Format('No documentation node found for identifier : %s',[AElement.PathName]));
end; end;
end; end;

10
utils/fpdoc/dw_html.pp
View File

@ -739,7 +739,7 @@ begin
WriteHTMLFile(PageDoc, Filename); WriteHTMLFile(PageDoc, Filename);
except except
on E: Exception do on E: Exception do
WriteLn(Format(SErrCouldNotCreateFile, [FileName, e.Message])); DoLog(SErrCouldNotCreateFile, [FileName, e.Message]);
end; end;
finally finally
PageDoc.Free; PageDoc.Free;
@ -750,7 +750,7 @@ begin
begin begin
if not FileExists(FCSSFile) Then if not FileExists(FCSSFile) Then
begin begin
Writeln(stderr,'Can''t find CSS file "',FCSSFILE,'"'); DoLog('Can''t find CSS file "%s"',[FCSSFILE]);
halt(1); halt(1);
end; end;
TempStream := TMemoryStream.Create; TempStream := TMemoryStream.Create;
@ -1097,7 +1097,7 @@ begin
if Length(s) = 0 then if Length(s) = 0 then
begin begin
WriteLn(Format(SErrUnknownLinkID, [a])); DoLog(SErrUnknownLinkID, [a]);
PushOutputNode(CreateEl(CurOutputNode, 'b')); PushOutputNode(CreateEl(CurOutputNode, 'b'));
end else end else
PushOutputNode(CreateLink(CurOutputNode, s)); PushOutputNode(CreateLink(CurOutputNode, s));
@ -2046,7 +2046,7 @@ begin
s:= ResolveLinkID(l); s:= ResolveLinkID(l);
if Length(s)=0 then if Length(s)=0 then
begin begin
WriteLn(Format(SErrUnknownLinkID, [l])); DoLog(SErrUnknownLinkID, [l]);
NewEl := CreateEl(ParaEl,'b') NewEl := CreateEl(ParaEl,'b')
end end
else else
@ -3425,7 +3425,7 @@ end;
procedure THTMLWriter.WriteDoc; procedure THTMLWriter.WriteDoc;
begin begin
WriteLn(Format(SWritingPages, [PageCount])); DoLog(SWritingPages, [PageCount]);
WriteHTMLPages; WriteHTMLPages;
end; end;

21
utils/fpdoc/dwriter.pp
View File

@ -63,6 +63,8 @@ type
Destructor Destroy; override; Destructor Destroy; override;
end; end;
TWriterLogEvent = Procedure(Sender : TObject; Const Msg : String) of object;
{ TFPDocWriter } { TFPDocWriter }
TFPDocWriter = class TFPDocWriter = class
@ -74,6 +76,8 @@ type
procedure ConvertURL(AContext: TPasElement; El: TDOMElement); procedure ConvertURL(AContext: TPasElement; El: TDOMElement);
protected protected
Procedure DoLog(Const Msg : String);
Procedure DoLog(Const Fmt : String; Args : Array of const);
procedure Warning(AContext: TPasElement; const AMsg: String); procedure Warning(AContext: TPasElement; const AMsg: String);
procedure Warning(AContext: TPasElement; const AMsg: String; procedure Warning(AContext: TPasElement; const AMsg: String;
const Args: array of const); const Args: array of const);
@ -370,7 +374,7 @@ end;
Procedure TFPDocWriter.DescrWriteImageEl(const AFileName, ACaption,ALinkName : DOMString); Procedure TFPDocWriter.DescrWriteImageEl(const AFileName, ACaption,ALinkName : DOMString);
begin begin
system.writeln(ClassName,': No support for images yet: ',AFileName,' (caption: "',ACaption,'")'); DoLog('%s : No support for images yet: %s (caption: "%s")',[ClassName,AFileName,ACaption]);
end; end;
{ --------------------------------------------------------------------- { ---------------------------------------------------------------------
@ -388,9 +392,9 @@ end;
procedure TFPDocWriter.Warning(AContext: TPasElement; const AMsg: String); procedure TFPDocWriter.Warning(AContext: TPasElement; const AMsg: String);
begin begin
if (AContext<>nil) then if (AContext<>nil) then
WriteLn('[', AContext.PathName, '] ', AMsg) DoLog('[%s] %s',[AContext.PathName,AMsg])
else else
WriteLn('[<no context>] ', AMsg); DoLog('[<no context>] %s', [AMsg]);
end; end;
procedure TFPDocWriter.Warning(AContext: TPasElement; const AMsg: String; procedure TFPDocWriter.Warning(AContext: TPasElement; const AMsg: String;
@ -612,6 +616,17 @@ begin
DescrEndURL; DescrEndURL;
end; end;
procedure TFPDocWriter.DoLog(const Msg: String);
begin
If Assigned(FEngine.OnLog) then
FEngine.OnLog(Self,Msg);
end;
procedure TFPDocWriter.DoLog(const Fmt: String; Args: array of const);
begin
DoLog(Format(Fmt,Args));
end;
function TFPDocWriter.ConvertExtShort(AContext: TPasElement; function TFPDocWriter.ConvertExtShort(AContext: TPasElement;
Node: TDOMNode): Boolean; Node: TDOMNode): Boolean;
begin begin

7
utils/fpdoc/fpdoc.lpi
View File

@ -40,7 +40,7 @@
<PackageName Value="FCL"/> <PackageName Value="FCL"/>
</Item1> </Item1>
</RequiredPackages> </RequiredPackages>
<Units Count="14"> <Units Count="15">
<Unit0> <Unit0>
<Filename Value="fpdoc.pp"/> <Filename Value="fpdoc.pp"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
@ -111,6 +111,11 @@
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="fpdocxmlopts"/> <UnitName Value="fpdocxmlopts"/>
</Unit13> </Unit13>
<Unit14>
<Filename Value="mkfpdoc.pp"/>
<IsPartOfProject Value="True"/>
<UnitName Value="mkfpdoc"/>
</Unit14>
</Units> </Units>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>

161
utils/fpdoc/fpdoc.pp
View File

@ -16,7 +16,7 @@
program FPDoc; program FPDoc;
uses uses
SysUtils, Classes, Gettext, DOM, XMLWrite, PasTree, PParser, custapp, SysUtils, Classes, Gettext, custapp,
dGlobals, // GLobal definitions, constants. dGlobals, // GLobal definitions, constants.
dwriter, // TFPDocWriter definition. dwriter, // TFPDocWriter definition.
dwlinear, // Linear (abstract) writer dwlinear, // Linear (abstract) writer
@ -27,13 +27,8 @@ uses
dw_ipflin, // IPF writer (new linear output) dw_ipflin, // IPF writer (new linear output)
dw_man, // Man page writer dw_man, // Man page writer
dw_linrtf, // linear RTF writer dw_linrtf, // linear RTF writer
dw_txt, fpdocproj, fpdocxmlopts; // TXT writer dw_txt, fpdocproj, mkfpdoc; // TXT writer
const
DefOSTarget = {$I %FPCTARGETOS%};
DefCPUTarget = {$I %FPCTARGETCPU%};
DefFPCVersion = {$I %FPCVERSION%};
DefFPCDate = {$I %FPCDATE%};
Type Type
@ -41,16 +36,16 @@ Type
TFPDocAplication = Class(TCustomApplication) TFPDocAplication = Class(TCustomApplication)
private private
FProject : TFPDocProject; FCreator : TFPDocCreator;
FProjectFile : Boolean;
FPackage : TFPDocPackage; FPackage : TFPDocPackage;
FDryRun,
FProjectFile : Boolean;
FWriteProjectFile : String; FWriteProjectFile : String;
Protected Protected
procedure OutputLog(Sender: TObject; const Msg: String);
procedure ParseCommandLine; procedure ParseCommandLine;
procedure Parseoption(const S: String); procedure Parseoption(const S: String);
Procedure Usage(AnExitCode : Byte); Procedure Usage(AnExitCode : Byte);
Procedure CreateProjectFile(Const AFileName : String);
procedure CreateDocumentation(APackage : TFPDocPackage; Options : TEngineOptions);
Procedure DoRun; override; Procedure DoRun; override;
Public Public
Constructor Create(AOwner : TComponent); override; Constructor Create(AOwner : TComponent); override;
@ -91,9 +86,11 @@ begin
Writeln(SUsageOption190); Writeln(SUsageOption190);
Writeln(SUsageOption200); Writeln(SUsageOption200);
Writeln(SUsageOption210); Writeln(SUsageOption210);
Writeln(SUsageOption220);
Writeln(SUsageOption230);
L:=TStringList.Create; L:=TStringList.Create;
Try Try
Backend:=FProject.OPtions.Backend; Backend:=FCreator.OPtions.Backend;
If (Backend='') then If (Backend='') then
begin begin
Writeln; Writeln;
@ -126,20 +123,10 @@ begin
Halt(AnExitCode); Halt(AnExitCode);
end; end;
procedure TFPDocAplication.CreateProjectFile(const AFileName: String);
begin
With TXMLFPDocOptions.Create(Self) do
try
SaveOptionsToFile(FProject,AFileName);
finally
Free;
end;
end;
destructor TFPDocAplication.Destroy; destructor TFPDocAplication.Destroy;
begin begin
FreeAndNil(FProject); FreeAndNil(FCreator);
Inherited; Inherited;
end; end;
@ -153,6 +140,10 @@ begin
end; end;
end; end;
procedure TFPDocAplication.OutputLog(Sender: TObject; const Msg: String);
begin
Writeln(StdErr,Msg);
end;
procedure TFPDocAplication.ParseCommandLine; procedure TFPDocAplication.ParseCommandLine;
@ -179,14 +170,14 @@ begin
s:=ParamStr(I); s:=ParamStr(I);
If ProjectOpt(S) then If ProjectOpt(S) then
ParseOption(s); ParseOption(s);
If (FProject.Packages.Count=1) then If (FCreator.Packages.Count=1) then
FPackage:=FProject.Packages[0] FPackage:=FCreator.Packages[0]
else if (FProject.Options.DefaultPackageName<>'') then else if (FCreator.Options.DefaultPackageName<>'') then
Fpackage:=FProject.Packages.FindPackage(FProject.Options.DefaultPackageName); Fpackage:=FCreator.Packages.FindPackage(FCreator.Options.DefaultPackageName);
end; end;
If FProject.Packages.Count=0 then If FCreator.Project.Packages.Count=0 then
begin begin
FPackage:=FProject.Packages.Add as TFPDocPackage; FPackage:=FCreator.Packages.Add as TFPDocPackage;
end; end;
// Check package // Check package
for i := 1 to ParamCount do for i := 1 to ParamCount do
@ -233,15 +224,15 @@ begin
if (s = '-h') or (s = '--help') then if (s = '-h') or (s = '--help') then
Usage(0) Usage(0)
else if s = '--hide-protected' then else if s = '--hide-protected' then
FProject.Options.HideProtected := True FCreator.Options.HideProtected := True
else if s = '--warn-no-node' then else if s = '--warn-no-node' then
FProject.Options.WarnNoNode := True FCreator.Options.WarnNoNode := True
else if s = '--show-private' then else if s = '--show-private' then
FProject.Options.ShowPrivate := False FCreator.Options.ShowPrivate := False
else if s = '--stop-on-parser-error' then else if s = '--stop-on-parser-error' then
FProject.Options.StopOnParseError := True FCreator.Options.StopOnParseError := True
else if s = '--dont-trim' then else if s = '--dont-trim' then
FProject.Options.donttrim := True FCreator.Options.donttrim := True
else else
begin begin
i := Pos('=', s); i := Pos('=', s);
@ -258,12 +249,7 @@ begin
if (Cmd = '--project') or (Cmd='-p') then if (Cmd = '--project') or (Cmd='-p') then
begin begin
FProjectFile:=True; FProjectFile:=True;
With TXMLFPDocOptions.Create(self) do FCreator.LoadProjectFile(Arg);
try
LoadOptionsFromFile(FProject,Arg);
finally
Free;
end;
end end
else if (Cmd = '--descr') then else if (Cmd = '--descr') then
AddToFileList(SelectedPackage.Descriptions, Arg) AddToFileList(SelectedPackage.Descriptions, Arg)
@ -273,14 +259,18 @@ begin
If FindWriterClass(Arg)=-1 then If FindWriterClass(Arg)=-1 then
WriteLn(StdErr, Format(SCmdLineInvalidFormat, [Arg])) WriteLn(StdErr, Format(SCmdLineInvalidFormat, [Arg]))
else else
FProject.Options.BackEnd:=Arg; FCreator.Options.BackEnd:=Arg;
end end
else if (Cmd = '-l') or (Cmd = '--lang') then else if (Cmd = '-l') or (Cmd = '--lang') then
FProject.Options.Language := Arg FCreator.Options.Language := Arg
else if (Cmd = '-i') or (Cmd = '--input') then else if (Cmd = '-i') or (Cmd = '--input') then
AddToFileList(SelectedPackage.Inputs, Arg) AddToFileList(SelectedPackage.Inputs, Arg)
else if (Cmd = '-o') or (Cmd = '--output') then else if (Cmd = '-o') or (Cmd = '--output') then
SelectedPackage.Output := Arg SelectedPackage.Output := Arg
else if (Cmd = '-v') or (Cmd = '--verbose') then
FCreator.Verbose:=true
else if (Cmd = '-n') or (Cmd = '--dry-run') then
FDryRun:=True
else if Cmd = '--content' then else if Cmd = '--content' then
SelectedPackage.ContentFile := Arg SelectedPackage.ContentFile := Arg
else if Cmd = '--import' then else if Cmd = '--import' then
@ -288,91 +278,28 @@ begin
else if Cmd = '--package' then else if Cmd = '--package' then
begin begin
If FProjectFile then If FProjectFile then
FPackage:=FProject.Packages.FindPackage(Arg) FPackage:=FCreator.Packages.FindPackage(Arg)
else else
FPackage.Name:=Arg; FPackage.Name:=Arg;
end end
else if Cmd = '--ostarget' then else if Cmd = '--ostarget' then
FProject.Options.OSTarget := Arg FCreator.Options.OSTarget := Arg
else if Cmd = '--cputarget' then else if Cmd = '--cputarget' then
FProject.Options.CPUTarget := Arg FCreator.Options.CPUTarget := Arg
else if Cmd = '--mo-dir' then else if Cmd = '--mo-dir' then
FProject.Options.modir := Arg FCreator.Options.modir := Arg
else if Cmd = '--parse-impl' then else if Cmd = '--parse-impl' then
FProject.Options.InterfaceOnly:=false FCreator.Options.InterfaceOnly:=false
else if Cmd = '--write-project' then else if Cmd = '--write-project' then
FWriteProjectFile:=Arg FWriteProjectFile:=Arg
else else
begin begin
FProject.Options.BackendOptions.Add(Cmd); FCreator.Options.BackendOptions.Add(Cmd);
FProject.Options.BackendOptions.Add(Arg); FCreator.Options.BackendOptions.Add(Arg);
end; end;
end; end;
end; end;
procedure TFPDocAplication.CreateDocumentation(APackage : TFPDocPackage; Options : TEngineOptions);
var
i,j: Integer;
WriterClass : TFPDocWriterClass;
Writer : TFPDocWriter;
Engine : TFPDocEngine;
Cmd,Arg : String;
begin
Engine:=TFPDocEngine.Create;
try
For J:=0 to Apackage.Imports.Count-1 do
begin
Arg:=Apackage.Imports[j];
i := Pos(',', Arg);
Engine.ReadContentFile(Copy(Arg,1,i-1),Copy(Arg,i+1,Length(Arg)));
end;
for i := 0 to APackage.Descriptions.Count - 1 do
Engine.AddDocFile(APackage.Descriptions[i],Options.donttrim);
Engine.SetPackageName(APackage.Name);
Engine.Output:=APackage.Output;
Engine.HideProtected:=Options.HideProtected;
Engine.HidePrivate:=Not Options.ShowPrivate;
if Length(Options.Language) > 0 then
TranslateDocStrings(Options.Language);
for i := 0 to Fpackage.Inputs.Count - 1 do
try
ParseSource(Engine, APackage.Inputs[i], Options.OSTarget, Options.CPUTarget);
except
on e: EParserError do
If Options.StopOnParseError then
Raise
else
WriteLn(StdErr, Format('%s(%d,%d): %s',
[e.Filename, e.Row, e.Column, e.Message]));
end;
WriterClass:=GetWriterClass(Options.Backend);
Writer:=WriterClass.Create(Engine.Package,Engine);
Writeln('Writing doc');
With Writer do
Try
If Options.BackendOptions.Count>0 then
for I:=0 to ((Options.BackendOptions.Count-1) div 2) do
begin
Cmd:=Options.BackendOptions[I*2];
Arg:=Options.BackendOptions[I*2+1];
If not InterPretOption(Cmd,Arg) then
WriteLn(StdErr, Format(SCmdLineInvalidOption,[Cmd+'='+Arg]));
end;
WriteDoc;
Finally
Free;
end;
if Length(FPackage.ContentFile) > 0 then
Engine.WriteContentFile(FPackage.ContentFile);
finally
FreeAndNil(Engine);
end;
end;
Procedure TFPDocAplication.DoRun; Procedure TFPDocAplication.DoRun;
begin begin
@ -387,9 +314,9 @@ begin
WriteLn; WriteLn;
ParseCommandLine; ParseCommandLine;
if (FWriteProjectFile<>'') then if (FWriteProjectFile<>'') then
CreateProjectFile(FWriteProjectFile) FCreator.CreateProjectFile(FWriteProjectFile)
else else
CreateDocumentation(FPackage,FProject.Options); FCreator.CreateDocumentation(FPackage,FDryRun);
WriteLn(SDone); WriteLn(SDone);
Terminate; Terminate;
end; end;
@ -398,10 +325,8 @@ constructor TFPDocAplication.Create(AOwner: TComponent);
begin begin
inherited Create(AOwner); inherited Create(AOwner);
StopOnException:=true; StopOnException:=true;
FProject:=TFPDOCproject.Create(Nil); FCreator:=TFPDocCreator.Create(Self);
FProject.Options.StopOnParseError:=False; FCreator.OnLog:=@OutputLog;
FProject.Options.CPUTarget:=DefCPUTarget;
FProject.Options.OSTarget:=DefOSTarget;
end; end;
begin begin

204
utils/fpdoc/mkfpdoc.pp Normal file
View File

@ -0,0 +1,204 @@
unit mkfpdoc;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, dglobals, fpdocxmlopts, dwriter, pscanner, pparser, fpdocproj;
const
DefOSTarget = {$I %FPCTARGETOS%};
DefCPUTarget = {$I %FPCTARGETCPU%};
DefFPCVersion = {$I %FPCVERSION%};
DefFPCDate = {$I %FPCDATE%};
Type
{ TFPDocCreator }
TFPDocCreator = Class(TComponent)
Private
FOnLog: TPasParserLogHandler;
FPParserLogEvents: TPParserLogEvents;
FProject : TFPDocProject;
FScannerLogEvents: TPScannerLogEvents;
FVerbose: Boolean;
function GetOptions: TEngineOptions;
function GetPackages: TFPDocPackages;
Protected
procedure SetVerbose(AValue: Boolean); virtual;
Procedure DoLog(Const Msg : String);
procedure DoLog(Const Fmt : String; Args : Array of Const);
procedure CreateOutput(APackage: TFPDocPackage; Engine: TFPDocEngine); virtual;
Public
Constructor Create(AOwner : TComponent); override;
Destructor Destroy; override;
Procedure CreateDocumentation(APackage : TFPDocPackage; ParseOnly : Boolean); virtual;
Procedure CreateProjectFile(Const AFileName : string);
Procedure LoadProjectFile(Const AFileName: string);
Property Project : TFPDocProject Read FProject;
Property ScannerLogEvents : TPScannerLogEvents Read FScannerLogEvents Write FScannerLogEvents;
Property ParserLogEvents : TPParserLogEvents Read FPParserLogEvents Write FPParserLogEvents;
Property Verbose : Boolean Read FVerbose Write SetVerbose;
Property OnLog : TPasParserLogHandler Read FOnLog Write FOnLog;
// Easy access
Property Options : TEngineOptions Read GetOptions;
Property Packages : TFPDocPackages Read GetPackages;
end;
implementation
{ TFPDocCreator }
procedure TFPDocCreator.SetVerbose(AValue: Boolean);
begin
if FVerbose=AValue then Exit;
FVerbose:=AValue;
if FVerbose then
begin
ScannerLogEvents:=[sleFile];
ParserLogEvents:=[];
end
else
begin
ScannerLogEvents:=[];
ParserLogEvents:=[];
end;
end;
procedure TFPDocCreator.DoLog(const Msg: String);
begin
If Assigned(OnLog) then
OnLog(Self,Msg);
end;
procedure TFPDocCreator.DoLog(const Fmt: String; Args: array of const);
begin
DoLog(Format(Fmt,Args));
end;
function TFPDocCreator.GetOptions: TEngineOptions;
begin
Result:=FProject.Options;
end;
function TFPDocCreator.GetPackages: TFPDocPackages;
begin
Result:=FProject.Packages;
end;
constructor TFPDocCreator.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FProject:=TFPDocProject.Create(Self);
FProject.Options.StopOnParseError:=False;
FProject.Options.CPUTarget:=DefCPUTarget;
FProject.Options.OSTarget:=DefOSTarget;
end;
destructor TFPDocCreator.Destroy;
begin
FreeAndNil(FProject);
inherited Destroy;
end;
procedure TFPDocCreator.CreateOutput(APackage: TFPDocPackage;Engine : TFPDocEngine);
Var
WriterClass : TFPDocWriterClass;
Writer : TFPDocWriter;
I : Integer;
Cmd,Arg : String;
begin
WriterClass:=GetWriterClass(Options.Backend);
Writer:=WriterClass.Create(Engine.Package,Engine);
With Writer do
Try
If FVerbose then
DoLog('Writing documentation');
OnLog:=Self.OnLog;
If Options.BackendOptions.Count>0 then
for I:=0 to ((Options.BackendOptions.Count-1) div 2) do
begin
Cmd:=Options.BackendOptions[I*2];
Arg:=Options.BackendOptions[I*2+1];
If not InterPretOption(Cmd,Arg) then
DoLog(SCmdLineInvalidOption,[Cmd+'='+Arg]);
end;
WriteDoc;
Finally
Free;
end;
if Length(APackage.ContentFile) > 0 then
Engine.WriteContentFile(APackage.ContentFile);
end;
procedure TFPDocCreator.CreateDocumentation(APackage: TFPDocPackage; ParseOnly : Boolean);
var
i,j: Integer;
Engine : TFPDocEngine;
Cmd,Arg : String;
begin
Engine:=TFPDocEngine.Create;
try
For J:=0 to Apackage.Imports.Count-1 do
begin
Arg:=Apackage.Imports[j];
i := Pos(',', Arg);
Engine.ReadContentFile(Copy(Arg,1,i-1),Copy(Arg,i+1,Length(Arg)));
end;
for i := 0 to APackage.Descriptions.Count - 1 do
Engine.AddDocFile(APackage.Descriptions[i],Options.donttrim);
Engine.SetPackageName(APackage.Name);
Engine.Output:=APackage.Output;
Engine.OnLog:=Self.OnLog;
Engine.ScannerLogEvents:=Self.ScannerLogEvents;
Engine.ParserLogEvents:=Self.ParserLogEvents;
Engine.HideProtected:=Options.HideProtected;
Engine.HidePrivate:=Not Options.ShowPrivate;
if Length(Options.Language) > 0 then
TranslateDocStrings(Options.Language);
for i := 0 to APackage.Inputs.Count - 1 do
try
ParseSource(Engine, APackage.Inputs[i], Options.OSTarget, Options.CPUTarget);
except
on e: EParserError do
If Options.StopOnParseError then
Raise
else
DoLog('%s(%d,%d): %s',[e.Filename, e.Row, e.Column, e.Message]);
end;
if Not ParseOnly then
CreateOutput(APackage,Engine);
finally
FreeAndNil(Engine);
end;
end;
procedure TFPDocCreator.CreateProjectFile(Const AFileName: string);
begin
With TXMLFPDocOptions.Create(Self) do
try
SaveOptionsToFile(FProject,AFileName);
finally
Free;
end;
end;
procedure TFPDocCreator.LoadProjectFile(const AFileName: string);
begin
With TXMLFPDocOptions.Create(self) do
try
LoadOptionsFromFile(FProject,AFileName);
finally
Free;
end;
end;
end.