mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-10 22:26:00 +02:00
Logging options implemented, and dry run. Separated out creation and logging logic
git-svn-id: trunk@19753 -
This commit is contained in:
michael
parent
3935cf7460
commit
2d928cbee8
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -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.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.pp svneol=native#text/plain
|
||||
utils/fpdoc/sample-project.xml svneol=native#text/plain
|
||||
|
||||
@ -151,6 +151,8 @@ resourcestring
|
||||
SUsageOption190 = '--parse-impl (Experimental) try to parse implementation too';
|
||||
SUsageOption200 = '--dont-trim Don''t trim XML contents';
|
||||
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:';
|
||||
SUsageBackendHelp = 'Specify an output format, combined with --help to get more help for this backend.';
|
||||
@ -263,11 +265,13 @@ type
|
||||
|
||||
|
||||
// The main FPDoc engine
|
||||
TFPDocLogLevel = (dleWarnNoNode);
|
||||
TFPDocLogLevels = set of TFPDocLogLevel;
|
||||
|
||||
{ TFPDocEngine }
|
||||
|
||||
TFPDocEngine = class(TPasTreeContainer)
|
||||
private
|
||||
FDocLogLevels: TFPDocLogLevels;
|
||||
protected
|
||||
DescrDocs: TObjectList; // List of XML documents
|
||||
DescrDocNames: TStringList; // Names of the XML documents
|
||||
@ -276,6 +280,9 @@ type
|
||||
FPackages: TFPList; // List of TFPPackage objects
|
||||
CurModule: TPasModule;
|
||||
CurPackageDocNode: TDocNode;
|
||||
Function LogEvent(E : TFPDocLogLevel) : Boolean;
|
||||
Procedure DoLog(Const Msg : String);overload;
|
||||
Procedure DoLog(Const Fmt : String; Args : Array of const);overload;
|
||||
public
|
||||
Output: String;
|
||||
HasContentFile: Boolean;
|
||||
@ -315,7 +322,7 @@ type
|
||||
|
||||
property RootLinkNode: TLinkNode read FRootLinkNode;
|
||||
property RootDocNode: TDocNode read FRootDocNode;
|
||||
property Package: TPasPackage read FPackage;
|
||||
Property DocLogLevels : TFPDocLogLevels Read FDocLogLevels Write FDocLogLevels;
|
||||
end;
|
||||
|
||||
|
||||
@ -327,6 +334,7 @@ Function IsExampleNode(Example : TDomNode) : Boolean;
|
||||
// returns true is link is an absolute URI
|
||||
Function IsLinkAbsolute(ALink: String): boolean;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
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 }
|
||||
if DotPos > 0 then
|
||||
// !!!: 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);
|
||||
if Assigned(LastChild) then
|
||||
LastChild.FNextSibling := Result
|
||||
@ -547,6 +555,22 @@ end;
|
||||
|
||||
{ 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;
|
||||
begin
|
||||
inherited Create;
|
||||
@ -795,7 +819,7 @@ var
|
||||
end
|
||||
else
|
||||
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;
|
||||
|
||||
function CreateAliasType (alname,clname : string;parentclass:TPasClassType; out cl2 :TPasClassType):TPasAliasType;
|
||||
@ -855,7 +879,7 @@ end;
|
||||
begin
|
||||
// writeln('Found alias pair ',clname,' = ',alname);
|
||||
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
|
||||
else
|
||||
cls2:=ResolveAndLinkClass(clname,j=0,cls);
|
||||
@ -1106,30 +1130,20 @@ function TFPDocEngine.FindElement(const AName: String): TPasElement;
|
||||
|
||||
var
|
||||
i: Integer;
|
||||
//ModuleName, LocalName: String;
|
||||
Module: TPasElement;
|
||||
begin
|
||||
{!!!: Don't know if we ever will have to use the following:
|
||||
i := Pos('.', AName);
|
||||
if i <> 0 then
|
||||
begin
|
||||
WriteLn('Dot found in name: ', AName);
|
||||
Result := nil;
|
||||
end else
|
||||
begin}
|
||||
Result := FindInModule(CurModule, AName);
|
||||
if not Assigned(Result) then
|
||||
for i := CurModule.InterfaceSection.UsesList.Count - 1 downto 0 do
|
||||
Result := FindInModule(CurModule, AName);
|
||||
if not Assigned(Result) then
|
||||
for i := CurModule.InterfaceSection.UsesList.Count - 1 downto 0 do
|
||||
begin
|
||||
Module := TPasElement(CurModule.InterfaceSection.UsesList[i]);
|
||||
if Module.ClassType = TPasModule then
|
||||
begin
|
||||
Module := TPasElement(CurModule.InterfaceSection.UsesList[i]);
|
||||
if Module.ClassType = TPasModule then
|
||||
begin
|
||||
Result := FindInModule(TPasModule(Module), AName);
|
||||
if Assigned(Result) then
|
||||
exit;
|
||||
end;
|
||||
Result := FindInModule(TPasModule(Module), AName);
|
||||
if Assigned(Result) then
|
||||
exit;
|
||||
end;
|
||||
{end;}
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFPDocEngine.FindModule(const AName: String): TPasModule;
|
||||
@ -1416,7 +1430,7 @@ begin
|
||||
WarnNoNode and
|
||||
(Length(AElement.PathName)>0) and
|
||||
(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;
|
||||
|
||||
|
||||
@ -739,7 +739,7 @@ begin
|
||||
WriteHTMLFile(PageDoc, Filename);
|
||||
except
|
||||
on E: Exception do
|
||||
WriteLn(Format(SErrCouldNotCreateFile, [FileName, e.Message]));
|
||||
DoLog(SErrCouldNotCreateFile, [FileName, e.Message]);
|
||||
end;
|
||||
finally
|
||||
PageDoc.Free;
|
||||
@ -750,7 +750,7 @@ begin
|
||||
begin
|
||||
if not FileExists(FCSSFile) Then
|
||||
begin
|
||||
Writeln(stderr,'Can''t find CSS file "',FCSSFILE,'"');
|
||||
DoLog('Can''t find CSS file "%s"',[FCSSFILE]);
|
||||
halt(1);
|
||||
end;
|
||||
TempStream := TMemoryStream.Create;
|
||||
@ -1097,7 +1097,7 @@ begin
|
||||
if Length(s) = 0 then
|
||||
begin
|
||||
|
||||
WriteLn(Format(SErrUnknownLinkID, [a]));
|
||||
DoLog(SErrUnknownLinkID, [a]);
|
||||
PushOutputNode(CreateEl(CurOutputNode, 'b'));
|
||||
end else
|
||||
PushOutputNode(CreateLink(CurOutputNode, s));
|
||||
@ -2046,7 +2046,7 @@ begin
|
||||
s:= ResolveLinkID(l);
|
||||
if Length(s)=0 then
|
||||
begin
|
||||
WriteLn(Format(SErrUnknownLinkID, [l]));
|
||||
DoLog(SErrUnknownLinkID, [l]);
|
||||
NewEl := CreateEl(ParaEl,'b')
|
||||
end
|
||||
else
|
||||
@ -3425,7 +3425,7 @@ end;
|
||||
|
||||
procedure THTMLWriter.WriteDoc;
|
||||
begin
|
||||
WriteLn(Format(SWritingPages, [PageCount]));
|
||||
DoLog(SWritingPages, [PageCount]);
|
||||
WriteHTMLPages;
|
||||
end;
|
||||
|
||||
|
||||
@ -63,6 +63,8 @@ type
|
||||
Destructor Destroy; override;
|
||||
end;
|
||||
|
||||
TWriterLogEvent = Procedure(Sender : TObject; Const Msg : String) of object;
|
||||
|
||||
{ TFPDocWriter }
|
||||
|
||||
TFPDocWriter = class
|
||||
@ -74,6 +76,8 @@ type
|
||||
procedure ConvertURL(AContext: TPasElement; El: TDOMElement);
|
||||
|
||||
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;
|
||||
const Args: array of const);
|
||||
@ -370,7 +374,7 @@ end;
|
||||
Procedure TFPDocWriter.DescrWriteImageEl(const AFileName, ACaption,ALinkName : DOMString);
|
||||
|
||||
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;
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
@ -388,9 +392,9 @@ end;
|
||||
procedure TFPDocWriter.Warning(AContext: TPasElement; const AMsg: String);
|
||||
begin
|
||||
if (AContext<>nil) then
|
||||
WriteLn('[', AContext.PathName, '] ', AMsg)
|
||||
DoLog('[%s] %s',[AContext.PathName,AMsg])
|
||||
else
|
||||
WriteLn('[<no context>] ', AMsg);
|
||||
DoLog('[<no context>] %s', [AMsg]);
|
||||
end;
|
||||
|
||||
procedure TFPDocWriter.Warning(AContext: TPasElement; const AMsg: String;
|
||||
@ -612,6 +616,17 @@ begin
|
||||
DescrEndURL;
|
||||
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;
|
||||
Node: TDOMNode): Boolean;
|
||||
begin
|
||||
|
||||
@ -40,7 +40,7 @@
|
||||
<PackageName Value="FCL"/>
|
||||
</Item1>
|
||||
</RequiredPackages>
|
||||
<Units Count="14">
|
||||
<Units Count="15">
|
||||
<Unit0>
|
||||
<Filename Value="fpdoc.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
@ -111,6 +111,11 @@
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="fpdocxmlopts"/>
|
||||
</Unit13>
|
||||
<Unit14>
|
||||
<Filename Value="mkfpdoc.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="mkfpdoc"/>
|
||||
</Unit14>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
|
||||
@ -16,7 +16,7 @@
|
||||
program FPDoc;
|
||||
|
||||
uses
|
||||
SysUtils, Classes, Gettext, DOM, XMLWrite, PasTree, PParser, custapp,
|
||||
SysUtils, Classes, Gettext, custapp,
|
||||
dGlobals, // GLobal definitions, constants.
|
||||
dwriter, // TFPDocWriter definition.
|
||||
dwlinear, // Linear (abstract) writer
|
||||
@ -27,13 +27,8 @@ uses
|
||||
dw_ipflin, // IPF writer (new linear output)
|
||||
dw_man, // Man page 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
|
||||
|
||||
@ -41,16 +36,16 @@ Type
|
||||
|
||||
TFPDocAplication = Class(TCustomApplication)
|
||||
private
|
||||
FProject : TFPDocProject;
|
||||
FProjectFile : Boolean;
|
||||
FCreator : TFPDocCreator;
|
||||
FPackage : TFPDocPackage;
|
||||
FDryRun,
|
||||
FProjectFile : Boolean;
|
||||
FWriteProjectFile : String;
|
||||
Protected
|
||||
procedure OutputLog(Sender: TObject; const Msg: String);
|
||||
procedure ParseCommandLine;
|
||||
procedure Parseoption(const S: String);
|
||||
Procedure Usage(AnExitCode : Byte);
|
||||
Procedure CreateProjectFile(Const AFileName : String);
|
||||
procedure CreateDocumentation(APackage : TFPDocPackage; Options : TEngineOptions);
|
||||
Procedure DoRun; override;
|
||||
Public
|
||||
Constructor Create(AOwner : TComponent); override;
|
||||
@ -91,9 +86,11 @@ begin
|
||||
Writeln(SUsageOption190);
|
||||
Writeln(SUsageOption200);
|
||||
Writeln(SUsageOption210);
|
||||
Writeln(SUsageOption220);
|
||||
Writeln(SUsageOption230);
|
||||
L:=TStringList.Create;
|
||||
Try
|
||||
Backend:=FProject.OPtions.Backend;
|
||||
Backend:=FCreator.OPtions.Backend;
|
||||
If (Backend='') then
|
||||
begin
|
||||
Writeln;
|
||||
@ -126,20 +123,10 @@ begin
|
||||
Halt(AnExitCode);
|
||||
end;
|
||||
|
||||
procedure TFPDocAplication.CreateProjectFile(const AFileName: String);
|
||||
begin
|
||||
With TXMLFPDocOptions.Create(Self) do
|
||||
try
|
||||
SaveOptionsToFile(FProject,AFileName);
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TFPDocAplication.Destroy;
|
||||
|
||||
begin
|
||||
FreeAndNil(FProject);
|
||||
FreeAndNil(FCreator);
|
||||
Inherited;
|
||||
end;
|
||||
|
||||
@ -153,6 +140,10 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFPDocAplication.OutputLog(Sender: TObject; const Msg: String);
|
||||
begin
|
||||
Writeln(StdErr,Msg);
|
||||
end;
|
||||
|
||||
procedure TFPDocAplication.ParseCommandLine;
|
||||
|
||||
@ -179,14 +170,14 @@ begin
|
||||
s:=ParamStr(I);
|
||||
If ProjectOpt(S) then
|
||||
ParseOption(s);
|
||||
If (FProject.Packages.Count=1) then
|
||||
FPackage:=FProject.Packages[0]
|
||||
else if (FProject.Options.DefaultPackageName<>'') then
|
||||
Fpackage:=FProject.Packages.FindPackage(FProject.Options.DefaultPackageName);
|
||||
If (FCreator.Packages.Count=1) then
|
||||
FPackage:=FCreator.Packages[0]
|
||||
else if (FCreator.Options.DefaultPackageName<>'') then
|
||||
Fpackage:=FCreator.Packages.FindPackage(FCreator.Options.DefaultPackageName);
|
||||
end;
|
||||
If FProject.Packages.Count=0 then
|
||||
If FCreator.Project.Packages.Count=0 then
|
||||
begin
|
||||
FPackage:=FProject.Packages.Add as TFPDocPackage;
|
||||
FPackage:=FCreator.Packages.Add as TFPDocPackage;
|
||||
end;
|
||||
// Check package
|
||||
for i := 1 to ParamCount do
|
||||
@ -233,15 +224,15 @@ begin
|
||||
if (s = '-h') or (s = '--help') then
|
||||
Usage(0)
|
||||
else if s = '--hide-protected' then
|
||||
FProject.Options.HideProtected := True
|
||||
FCreator.Options.HideProtected := True
|
||||
else if s = '--warn-no-node' then
|
||||
FProject.Options.WarnNoNode := True
|
||||
FCreator.Options.WarnNoNode := True
|
||||
else if s = '--show-private' then
|
||||
FProject.Options.ShowPrivate := False
|
||||
FCreator.Options.ShowPrivate := False
|
||||
else if s = '--stop-on-parser-error' then
|
||||
FProject.Options.StopOnParseError := True
|
||||
FCreator.Options.StopOnParseError := True
|
||||
else if s = '--dont-trim' then
|
||||
FProject.Options.donttrim := True
|
||||
FCreator.Options.donttrim := True
|
||||
else
|
||||
begin
|
||||
i := Pos('=', s);
|
||||
@ -258,12 +249,7 @@ begin
|
||||
if (Cmd = '--project') or (Cmd='-p') then
|
||||
begin
|
||||
FProjectFile:=True;
|
||||
With TXMLFPDocOptions.Create(self) do
|
||||
try
|
||||
LoadOptionsFromFile(FProject,Arg);
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
FCreator.LoadProjectFile(Arg);
|
||||
end
|
||||
else if (Cmd = '--descr') then
|
||||
AddToFileList(SelectedPackage.Descriptions, Arg)
|
||||
@ -273,14 +259,18 @@ begin
|
||||
If FindWriterClass(Arg)=-1 then
|
||||
WriteLn(StdErr, Format(SCmdLineInvalidFormat, [Arg]))
|
||||
else
|
||||
FProject.Options.BackEnd:=Arg;
|
||||
FCreator.Options.BackEnd:=Arg;
|
||||
end
|
||||
else if (Cmd = '-l') or (Cmd = '--lang') then
|
||||
FProject.Options.Language := Arg
|
||||
FCreator.Options.Language := Arg
|
||||
else if (Cmd = '-i') or (Cmd = '--input') then
|
||||
AddToFileList(SelectedPackage.Inputs, Arg)
|
||||
else if (Cmd = '-o') or (Cmd = '--output') then
|
||||
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
|
||||
SelectedPackage.ContentFile := Arg
|
||||
else if Cmd = '--import' then
|
||||
@ -288,91 +278,28 @@ begin
|
||||
else if Cmd = '--package' then
|
||||
begin
|
||||
If FProjectFile then
|
||||
FPackage:=FProject.Packages.FindPackage(Arg)
|
||||
FPackage:=FCreator.Packages.FindPackage(Arg)
|
||||
else
|
||||
FPackage.Name:=Arg;
|
||||
end
|
||||
else if Cmd = '--ostarget' then
|
||||
FProject.Options.OSTarget := Arg
|
||||
FCreator.Options.OSTarget := Arg
|
||||
else if Cmd = '--cputarget' then
|
||||
FProject.Options.CPUTarget := Arg
|
||||
FCreator.Options.CPUTarget := Arg
|
||||
else if Cmd = '--mo-dir' then
|
||||
FProject.Options.modir := Arg
|
||||
FCreator.Options.modir := Arg
|
||||
else if Cmd = '--parse-impl' then
|
||||
FProject.Options.InterfaceOnly:=false
|
||||
FCreator.Options.InterfaceOnly:=false
|
||||
else if Cmd = '--write-project' then
|
||||
FWriteProjectFile:=Arg
|
||||
else
|
||||
begin
|
||||
FProject.Options.BackendOptions.Add(Cmd);
|
||||
FProject.Options.BackendOptions.Add(Arg);
|
||||
FCreator.Options.BackendOptions.Add(Cmd);
|
||||
FCreator.Options.BackendOptions.Add(Arg);
|
||||
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;
|
||||
|
||||
begin
|
||||
@ -387,9 +314,9 @@ begin
|
||||
WriteLn;
|
||||
ParseCommandLine;
|
||||
if (FWriteProjectFile<>'') then
|
||||
CreateProjectFile(FWriteProjectFile)
|
||||
FCreator.CreateProjectFile(FWriteProjectFile)
|
||||
else
|
||||
CreateDocumentation(FPackage,FProject.Options);
|
||||
FCreator.CreateDocumentation(FPackage,FDryRun);
|
||||
WriteLn(SDone);
|
||||
Terminate;
|
||||
end;
|
||||
@ -398,10 +325,8 @@ constructor TFPDocAplication.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
StopOnException:=true;
|
||||
FProject:=TFPDOCproject.Create(Nil);
|
||||
FProject.Options.StopOnParseError:=False;
|
||||
FProject.Options.CPUTarget:=DefCPUTarget;
|
||||
FProject.Options.OSTarget:=DefOSTarget;
|
||||
FCreator:=TFPDocCreator.Create(Self);
|
||||
FCreator.OnLog:=@OutputLog;
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
204
utils/fpdoc/mkfpdoc.pp
Normal file
204
utils/fpdoc/mkfpdoc.pp
Normal 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.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user