mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-07-23 20:46:20 +02:00
7cf2b7390c
* Depends on5e581ce9,2f595455,b0d263f1. * LazUtils was never built with external links to LCL (See Also and source declarations) because lcl.xct could not be imported. The file does not exist when LazUtils is built. To solve this problem, the output format for LazUtils is built twice. It is the smaller of the two packages. Building LazUtils twice ensures that the "chicken or the egg" problem with inter-file links is avoided. * Build LazUtils WITHOUT any external links (faster). * Build LCL with links to RTL, FCL, LazUtils. * Build LazUtils with links to RTL, FCL, LCL.
673 lines
21 KiB
ObjectPascal
673 lines
21 KiB
ObjectPascal
program update_lcl_docs;
|
|
|
|
{ Runs the FPC fpdoc document generator to generate LCL and LazUtils
|
|
documentation in CHM or HTML format }
|
|
|
|
{$mode objfpc}{$H+}
|
|
{$IFDEF MSWINDOWS}
|
|
{$APPTYPE console}
|
|
{$ENDIF}
|
|
|
|
uses
|
|
Classes, Sysutils, GetOpts, LazFileUtils, FileUtil, UTF8Process,
|
|
LazStringUtils, Process;
|
|
|
|
var
|
|
DefaultFPDocExe: string = 'fpdoc';
|
|
DefaultCSSFile: string = 'fpdoc.css';
|
|
WarningsCount: Integer;
|
|
Verbosity: integer;
|
|
ShowCmd: Boolean;
|
|
EnvParams: String;
|
|
DefaultXCTDir: String;
|
|
DefaultFPDocParams: string = '';
|
|
DefaultOutFormat: string = 'html';
|
|
DefaultFooterFilename: string = ''; // default is no footer(s)
|
|
|
|
type
|
|
TFPDocRunStep = (
|
|
frsCreated,
|
|
frsVarsInitialized,
|
|
frsFilesGathered,
|
|
frsOutDirCreated,
|
|
frsFPDocExecuted,
|
|
frsCopiedToXCTDir,
|
|
frsComplete
|
|
);
|
|
TFPDocRunOption = (
|
|
foCopyToXCTDir // copy the created chm and xct file to the xct directory
|
|
);
|
|
TFPDocRunOptions = set of TFPDocRunOption;
|
|
const
|
|
DefaultFPDocRunOptions = [foCopyToXCTDir];
|
|
|
|
type
|
|
|
|
{ TFPDocRun }
|
|
|
|
TFPDocRun = class
|
|
private
|
|
FCSSFile: String;
|
|
FFooterFilename: String;
|
|
FFPDocExe: String;
|
|
FIncludePath: string;
|
|
FInputFile: string;
|
|
FOptions: TFPDocRunOptions;
|
|
FOutDir: string;
|
|
FOutFormat: String;
|
|
FPackageName: string;
|
|
FPasSrcDir: string;
|
|
FStep: TFPDocRunStep;
|
|
FUsedPkgs: TStringList;
|
|
FXCTDir: string;
|
|
FXCTFile: string;
|
|
FXMLSrcDir: string;
|
|
FExtraOptions : String;
|
|
procedure SetCSSFile(AValue: String);
|
|
procedure SetFooterFilename(AValue: String);
|
|
procedure SetIncludePath(AValue: string);
|
|
procedure SetInputFile(AValue: string);
|
|
procedure SetOutDir(AValue: string);
|
|
procedure SetPasSrcDir(AValue: string);
|
|
procedure SetXCTDir(AValue: string);
|
|
procedure SetXMLSrcDir(AValue: string);
|
|
public
|
|
Params: TStringList;
|
|
ParseParams: string;
|
|
constructor Create(aPackageName: string);
|
|
destructor Destroy; override;
|
|
procedure InitVars;
|
|
procedure AddFilesToList(Dir: String; List: TStrings);
|
|
procedure FindSourceFiles;
|
|
procedure CreateOutputDir;
|
|
procedure RunFPDoc;
|
|
procedure CopyToXCTDir;
|
|
procedure Execute;
|
|
property Options: TFPDocRunOptions read FOptions write FOptions default DefaultFPDocRunOptions;
|
|
property CSSFile: String read FCSSFile write SetCSSFile;
|
|
property FooterFilename: String read FFooterFilename write SetFooterFilename;
|
|
property FPDocExe: String read FFPDocExe write FFPDocExe;
|
|
property IncludePath: string read FIncludePath write SetIncludePath;// semicolon separated search path
|
|
property InputFile: string read FInputFile write SetInputFile; // relative to OutDir, automatically created
|
|
property OutDir: string read FOutDir write SetOutDir;
|
|
property OutFormat: String read FOutFormat write FOutFormat;
|
|
property PackageName: string read FPackageName;
|
|
property PasSrcDir: string read FPasSrcDir write SetPasSrcDir;
|
|
property Step: TFPDocRunStep read FStep;
|
|
property UsedPkgs: TStringList read FUsedPkgs; // e.g. 'rtl','fcl', 'lcl', 'lazutils'
|
|
property XCTDir: string read FXCTDir write SetXCTDir;
|
|
property XMLSrcDir: string read FXMLSrcDir write SetXMLSrcDir;
|
|
property XCTFile: string read FXCTFile;
|
|
property ExtraOptions : string read FExtraOptions write FExtraOptions;
|
|
end;
|
|
|
|
procedure GetEnvDef(var S: String; DefaultValue: String; EnvName: String);
|
|
begin
|
|
S := GetEnvironmentVariable(EnvName);
|
|
if S = '' then
|
|
S := DefaultValue;
|
|
end;
|
|
|
|
function FileInEnvPATH(FileName: String): Boolean;
|
|
var
|
|
FullFilename: String;
|
|
begin
|
|
FullFilename:=FindDefaultExecutablePath(Filename);
|
|
Result:=(FullFilename<>'') and not DirectoryExistsUTF8(FullFilename);
|
|
end;
|
|
|
|
procedure PrintHelp;
|
|
begin
|
|
WriteLn('Usage for '+ ExtractFileName(ParamStr(0)), ':');
|
|
WriteLn;
|
|
Writeln(' --css-file <value> (CHM format only) CSS file to be used by fpdoc');
|
|
Writeln(' for the layout of the help pages. Default is "',DefaultCSSFile,'"');
|
|
WriteLn(' --fpdoc <value> The full path to fpdoc to use. Default is "',DefaultFPDocExe,'"');
|
|
WriteLn(' --fpcdocs <value> The directory that contains the required .xct files.');
|
|
WriteLn(' Use this to make help that contains links to rtl and fcl');
|
|
WriteLn(' --footer <value> Filename of a file to use a footer used in the generated pages.');
|
|
WriteLn(' Default is "'+DefaultFooterFilename+'"');
|
|
WriteLn(' --help Show this message');
|
|
WriteLn(' --arg <value> Passes value to fpdoc as an arg. Use this option as');
|
|
WriteLn(' many times as needed.');
|
|
WriteLn(' --outfmt html|chm Use value as the format fpdoc will use. Default is "'+DefaultOutFormat+'"');
|
|
WriteLn(' --showcmd Print the command that would be run instead if running it.');
|
|
WriteLn(' --warnings Show warnings while working.');
|
|
WriteLn(' --verbose be more verbose');
|
|
WriteLn;
|
|
WriteLn('The following are environment variables that will override the above params if set:');
|
|
WriteLn(' FPDOCFORMAT, FPDOCPARAMS, FPDOC, FPDOCFOOTER, FPCDOCS, RTLLINKPREFIX, FCLLINKPREFIX, <Pkg>LINKPREFIX, ...');
|
|
WriteLn;
|
|
Halt(0);
|
|
end;
|
|
|
|
procedure ReadOptions;
|
|
var
|
|
c: char;
|
|
Options: array of TOption;
|
|
OptIndex: Longint;
|
|
begin
|
|
ShowCmd := False;
|
|
WarningsCount:=-1;
|
|
SetLength(Options, 10);
|
|
|
|
Options[0].Name:='help';
|
|
Options[1].Name:='arg';
|
|
Options[1].Has_arg:=1;
|
|
Options[2].Name:='fpdoc';
|
|
Options[2].Has_arg:=1;
|
|
Options[3].Name:='outfmt';
|
|
Options[3].Has_arg:=1;
|
|
Options[4].Name:='showcmd';
|
|
Options[5].Name:='fpcdocs';
|
|
Options[5].Has_arg:=1;
|
|
Options[6].Name:='footer';
|
|
Options[6].Has_arg:=1;
|
|
Options[7].Name:='warnings';
|
|
Options[8].Name:='css-file';
|
|
Options[8].Has_arg:=1;
|
|
Options[9].Name:='verbose';
|
|
OptIndex:=0;
|
|
repeat
|
|
c := GetLongOpts('help arg: fpdoc: outfmt: showcmd fpcdocs: footer: warnings css-file verbose', @Options[0], OptIndex);
|
|
case c of
|
|
#0:
|
|
begin
|
|
//WriteLn(Options[OptIndex-1].Name, ' = ', OptArg);
|
|
case OptIndex-1 of
|
|
0: PrintHelp;
|
|
1: DefaultFPDocParams := DefaultFPDocParams + ' ' + OptArg;
|
|
2: DefaultFPDocExe := OptArg;
|
|
3: DefaultOutFormat := OptArg;
|
|
4: ShowCmd := True;
|
|
5: DefaultXCTDir := OptArg;
|
|
6: DefaultFooterFilename := OptArg;
|
|
7: WarningsCount:=0;
|
|
8: DefaultCssFile := OptArg;
|
|
9: inc(Verbosity);
|
|
else
|
|
WriteLn('Unknown Value: ', OptIndex);
|
|
end;
|
|
end;
|
|
'?': PrintHelp;
|
|
EndOfOptions: Break;
|
|
else
|
|
WriteLn('Unknown option -',c,' ',OptArg);
|
|
PrintHelp;
|
|
end;
|
|
until c = EndOfOptions;
|
|
|
|
GetEnvDef(DefaultOutFormat, DefaultOutFormat, 'FPDOCFORMAT');
|
|
GetEnvDef(EnvParams, '', 'FPDOCPARAMS');
|
|
GetEnvDef(DefaultFPDocExe, DefaultFPDocExe, 'FPDOC');
|
|
GetEnvDef(DefaultFooterFilename, DefaultFooterFilename, 'FPDOCFOOTER');
|
|
GetEnvDef(DefaultXCTDir, DefaultXCTDir, 'FPCDOCS');
|
|
|
|
if DefaultOutFormat = '' then
|
|
begin
|
|
writeln('Error: Parameter outfmt is missing');
|
|
PrintHelp;
|
|
end;
|
|
end;
|
|
|
|
{ TFPDocRun }
|
|
|
|
procedure TFPDocRun.SetInputFile(AValue: string);
|
|
begin
|
|
AValue:=TrimFilename(AValue);
|
|
if FInputFile=AValue then Exit;
|
|
FInputFile:=AValue;
|
|
end;
|
|
|
|
procedure TFPDocRun.SetOutDir(AValue: string);
|
|
begin
|
|
AValue:=TrimAndExpandFilename(AValue);
|
|
if FOutDir=AValue then Exit;
|
|
FOutDir:=AValue;
|
|
end;
|
|
|
|
procedure TFPDocRun.SetIncludePath(AValue: string);
|
|
begin
|
|
if FIncludePath=AValue then Exit;
|
|
FIncludePath:=AValue;
|
|
end;
|
|
|
|
procedure TFPDocRun.SetCSSFile(AValue: String);
|
|
begin
|
|
AValue:=TrimAndExpandFilename(AValue);
|
|
if FCSSFile=AValue then Exit;
|
|
FCSSFile:=AValue;
|
|
end;
|
|
|
|
{ Handles fpdoc 3.3.1 changed usage of the --footer argument. It can be
|
|
either a string with the content for the footer, or a file name when
|
|
prefixed with @. Handles both old and new syntax.
|
|
@ cannot be included in the call to TrimAndExpandFilename.
|
|
All file name validation occurs here. }
|
|
procedure TFPDocRun.SetFooterFilename(AValue: String);
|
|
var
|
|
vFilename: String;
|
|
begin
|
|
vFileName := '';
|
|
if (AValue <> '') then
|
|
begin
|
|
// check for fpdoc 3.3.1 file name with @ prefix
|
|
if (AValue[1] = '@') then
|
|
begin
|
|
vFilename := TrimAndExpandFilename(Copy(AValue, 2, Length(AValue)-1));
|
|
if not FileExistsUTF8(vFileName) then
|
|
AValue := '"Footer file not found: @' + vFileName + '"'
|
|
else
|
|
AValue := '@' + vFilename;
|
|
end
|
|
// wrap anything with spaces in Quote characters when needed
|
|
else if (Pos(' ', AValue) <> 0) and (aValue[1] <> '"') then
|
|
begin
|
|
AValue :='"' + AValue + '"';
|
|
end
|
|
// expand and validate file name without the @ prefix
|
|
else
|
|
begin
|
|
vFilename := TrimAndExpandFilename(AValue);
|
|
if FileExistsUTF8(vFileName) then AValue := vFilename;
|
|
end;
|
|
end;
|
|
if FFooterFilename = AValue then Exit;
|
|
FFooterFilename := AValue;
|
|
end;
|
|
|
|
procedure TFPDocRun.SetPasSrcDir(AValue: string);
|
|
begin
|
|
AValue:=TrimAndExpandFilename(AValue);
|
|
if FPasSrcDir=AValue then Exit;
|
|
FPasSrcDir:=AValue;
|
|
end;
|
|
|
|
procedure TFPDocRun.SetXCTDir(AValue: string);
|
|
begin
|
|
AValue:=TrimAndExpandFilename(AValue);
|
|
if FXCTDir=AValue then Exit;
|
|
FXCTDir:=AValue;
|
|
end;
|
|
|
|
procedure TFPDocRun.SetXMLSrcDir(AValue: string);
|
|
begin
|
|
AValue:=TrimAndExpandFilename(AValue);
|
|
if FXMLSrcDir=AValue then Exit;
|
|
FXMLSrcDir:=AValue;
|
|
end;
|
|
|
|
constructor TFPDocRun.Create(aPackageName: string);
|
|
begin
|
|
FPackageName:=aPackageName;
|
|
FOptions:=DefaultFPDocRunOptions;
|
|
fUsedPkgs:=TStringList.Create;
|
|
InputFile := 'inputfile.txt';
|
|
OutDir:=PackageName;
|
|
FPDocExe:=TrimFilename(DefaultFPDocExe);
|
|
CSSFile:=DefaultCSSFile;
|
|
Params:=TStringList.Create;
|
|
SplitCmdLineParams(DefaultFPDocParams,Params);
|
|
OutFormat:=DefaultOutFormat;
|
|
FooterFilename:=DefaultFooterFilename;
|
|
XCTDir:=DefaultXCTDir;
|
|
|
|
FStep:=frsCreated;
|
|
end;
|
|
|
|
destructor TFPDocRun.Destroy;
|
|
begin
|
|
FreeAndNil(fUsedPkgs);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TFPDocRun.InitVars;
|
|
var
|
|
Pkg, Prefix, IncludeDir, Param: String;
|
|
p: Integer;
|
|
begin
|
|
if ord(Step)>=ord(frsVarsInitialized) then
|
|
raise Exception.Create('TFPDocRun.InitVars not again');
|
|
|
|
// add IncludePath to ParseParams
|
|
p:=1;
|
|
while p<=length(IncludePath) do begin
|
|
IncludeDir:=GetNextDelimitedItem(IncludePath,';',p);
|
|
if IncludeDir='' then continue;
|
|
IncludeDir:=TrimAndExpandFilename(ChompPathDelim(IncludeDir));
|
|
ParseParams+=' -Fi'+CreateRelativePath(IncludeDir,OutDir);
|
|
end;
|
|
|
|
FXCTFile:=AppendPathDelim(OutDir)+PackageName+'.xct';
|
|
|
|
Params.Add('--content='+CreateRelativePath(XCTFile,OutDir));
|
|
Params.Add('--package='+PackageName);
|
|
Params.Add('--descr='+CreateRelativePath(AppendPathDelim(XMLSrcDir)+PackageName+'.xml',OutDir));
|
|
Params.Add('--format='+OutFormat);
|
|
if FilenameIsAbsolute(InputFile) then
|
|
Params.Add('--input=@'+CreateRelativePath(InputFile,OutDir))
|
|
else
|
|
Params.Add('--input=@'+InputFile);
|
|
|
|
if XCTDir <> '' then
|
|
begin
|
|
for Pkg in UsedPkgs do
|
|
begin
|
|
Prefix:='';
|
|
if OutFormat = 'html' then
|
|
Prefix:='../'+Lowercase(Pkg)+'/'
|
|
else if OutFormat = 'chm' then
|
|
Prefix:='ms-its:'+LowerCase(Pkg)+'.chm::/'
|
|
else
|
|
Prefix:='';
|
|
GetEnvDef(Prefix, Prefix, UpperCase(Pkg)+'LINKPREFIX');
|
|
|
|
Param:='--import='+CreateRelativePath(AppendPathDelim(XCTDir)+LowerCase(Pkg)+'.xct',OutDir);
|
|
if Prefix<>'' then
|
|
Param+=','+Prefix;
|
|
Params.Add(Param);
|
|
end;
|
|
end;
|
|
|
|
if OutFormat='chm' then
|
|
begin
|
|
Params.Add('--output='+ ChangeFileExt(PackageName, '.chm'));
|
|
Params.Add('--auto-toc');
|
|
Params.Add('--auto-index');
|
|
Params.Add('--make-searchable');
|
|
|
|
// set an explicit title used in the LHelp TOC navigation tree
|
|
if (LowerCase(PackageName) = 'lcl') then
|
|
Params.Add('--chm-title="(LCL) Lazarus Component Library"')
|
|
else
|
|
Params.Add('--chm-title="(LazUtils) Lazarus Utilities"');
|
|
|
|
if CSSFile<>'' then
|
|
Params.Add('--css-file='+ExtractFileName(CSSFile)); // the css file is copied to the OutDir
|
|
end;
|
|
|
|
{ In fpdoc 3.3.1 footerfilename is no longer just a file name. It can be the
|
|
footer text or a file name when prefixed with @.
|
|
Validation and quoting handled in the property setter. }
|
|
if (FooterFilename<>'') then // and FileExistsUTF8(FooterFilename) then
|
|
Params.Add('--footer='+FooterFilename);
|
|
|
|
if EnvParams<>'' then
|
|
SplitCmdLineParams(EnvParams,Params);
|
|
|
|
if Verbosity>0 then
|
|
begin
|
|
writeln('Verbose Params: ------------------');
|
|
writeln('FPDocExe=',FPDocExe);
|
|
writeln('OutFormat=',OutFormat);
|
|
writeln('CSSFile=',CSSFile);
|
|
writeln('FooterFilename=',FooterFilename);
|
|
writeln('InputFile=',InputFile);
|
|
writeln('OutDir=',OutDir);
|
|
writeln('ParseParams=');
|
|
writeln(ParseParams);
|
|
writeln('FPDocParams=');
|
|
writeln(Params.Text);
|
|
writeln('----------------------------------');
|
|
end;
|
|
|
|
FStep:=frsVarsInitialized;
|
|
end;
|
|
|
|
procedure TFPDocRun.AddFilesToList(Dir: String; List: TStrings);
|
|
var
|
|
FRec: TSearchRec;
|
|
begin
|
|
Dir:=AppendPathDelim(TrimFilename(Dir));
|
|
if FindFirstUTF8(Dir+AllFilesMask, faAnyFile, FRec)=0 then
|
|
repeat
|
|
//WriteLn('Checking file ' +FRec.Name);
|
|
if (FRec.Name='') or (FRec.Name='.') or (FRec.Name='..') then continue;
|
|
if (FRec.Name='fpmake.pp') then continue;
|
|
if ((FRec.Attr and faDirectory) <> 0) then
|
|
begin
|
|
AddFilesToList(Dir+FRec.Name, List);
|
|
//WriteLn('Checking Subfolder ',Dir+ FRec.Name);
|
|
end
|
|
else if FilenameHasPascalExt(FRec.Name) then
|
|
begin
|
|
List.Add(Dir+FRec.Name);
|
|
end;
|
|
until FindNextUTF8(FRec)<>0;
|
|
FindCloseUTF8(FRec);
|
|
end;
|
|
|
|
procedure TFPDocRun.FindSourceFiles;
|
|
var
|
|
FileList: TStringList;
|
|
InputList: TStringList;
|
|
I: Integer;
|
|
XMLFile, Filename: String;
|
|
begin
|
|
if ord(Step)>=ord(frsFilesGathered) then
|
|
raise Exception.Create('TFPDocRun.FindSourceFiles already called');
|
|
if ord(Step)<ord(frsVarsInitialized) then
|
|
InitVars;
|
|
|
|
if Verbosity>0 then
|
|
writeln('PasSrcDir="',PasSrcDir,'"');
|
|
FileList := TStringList.Create;
|
|
InputList := TStringList.Create;
|
|
AddFilesToList(PasSrcDir, FileList);
|
|
|
|
FileList.Sort;
|
|
for I := 0 to FileList.Count-1 do
|
|
begin
|
|
XMLFile := AppendPathDelim(XMLSrcDir)+ExtractFileNameOnly(FileList[I])+'.xml';
|
|
if FileExistsUTF8(XMLFile) then
|
|
begin
|
|
InputList.Add(CreateRelativePath(FileList[I],OutDir) + ParseParams);
|
|
Params.Add('--descr='+CreateRelativePath(XMLFile,OutDir));
|
|
end
|
|
else
|
|
begin
|
|
if WarningsCount >= 0 then
|
|
WriteLn('Warning! No corresponding xml file for unit ' + FileList[I])
|
|
else
|
|
Dec(WarningsCount);
|
|
end;
|
|
end;
|
|
FileList.Free;
|
|
|
|
Filename:=InputFile;
|
|
if not FilenameIsAbsolute(Filename) then
|
|
Filename:=TrimFilename(AppendPathDelim(OutDir)+Filename);
|
|
if ExtraOptions<>'' then
|
|
for i:=0 to InputList.count-1 do
|
|
InputList[i]:=ExtraOptions+' '+InputList[i];
|
|
InputList.SaveToFile(Filename);
|
|
InputList.Free;
|
|
|
|
FStep:=frsFilesGathered;
|
|
end;
|
|
|
|
procedure TFPDocRun.CreateOutputDir;
|
|
var
|
|
TargetCSSFile: String;
|
|
begin
|
|
if ord(Step)>=ord(frsOutDirCreated) then
|
|
raise Exception.Create('TFPDocRun.CreateOutputDir already called');
|
|
|
|
if Not DirectoryExistsUTF8(OutDir) then
|
|
begin
|
|
writeln('Creating directory "',OutDir,'"');
|
|
if not CreateDirUTF8(OutDir) then
|
|
raise Exception.Create('Unable to create directory "'+OutDir+'"');
|
|
end;
|
|
|
|
if ord(Step)<ord(frsFilesGathered) then
|
|
FindSourceFiles;
|
|
|
|
if (OutFormat='chm') and (CSSFile<>'') then
|
|
begin
|
|
TargetCSSFile:=AppendPathDelim(OutDir)+ExtractFileName(CSSFile);
|
|
if CompareFilenames(TargetCSSFile,CSSFile)<>0 then
|
|
begin
|
|
if not CopyFile(CSSFile,TargetCSSFile) then
|
|
raise Exception.Create('Unable to copy css file: CSSfile="'+CSSFile+'" to "'+TargetCSSFile+'"');
|
|
end;
|
|
end;
|
|
|
|
FStep:=frsOutDirCreated;
|
|
end;
|
|
|
|
procedure TFPDocRun.RunFPDoc;
|
|
var
|
|
Process: TProcess;
|
|
CmdLine: String;
|
|
begin
|
|
if ord(Step)>=ord(frsFPDocExecuted) then
|
|
raise Exception.Create('TFPDocRun.Run already called');
|
|
if ord(Step)<ord(frsOutDirCreated) then
|
|
CreateOutputDir;
|
|
|
|
if ShowCmd then
|
|
begin
|
|
Writeln('WorkDirectory:',OutDir);
|
|
WriteLn('Exe:',FPDocExe);
|
|
WriteLn(Params.Text);
|
|
exit;
|
|
end;
|
|
{$IFDEF MSWINDOWS}FPDocExe := ChangeFileExt(FPDocExe,'.exe');{$ENDIF}
|
|
if not FileInEnvPATH(FPDocExe) then
|
|
begin
|
|
WriteLn('Error: fpdoc ('+FPDocExe+') cannot be found. Please add its location to the PATH ',
|
|
'or set it with --fpdoc path',PathDelim,'to',PathDelim,'fpdoc'{$IFDEF MSWINDOWS},'.exe'{$ENDIF});
|
|
Halt(1);
|
|
end;
|
|
Process := TProcessUTF8.Create(nil);
|
|
try
|
|
Process.Options := Process.Options + [poWaitOnExit];
|
|
Process.CurrentDirectory := OutDir;
|
|
Process.Executable:=FPDocExe;
|
|
Process.Parameters.Assign(Params);
|
|
CmdLine:=Process.Executable+' '+MergeCmdLineParams(Params);
|
|
if Verbosity>0 then
|
|
writeln('CmdLine: ',CmdLine);
|
|
try
|
|
Process.Execute;
|
|
if Process.ExitCode<>0 then
|
|
raise Exception.Create('fpdoc failed with code '+IntToStr(Process.ExitCode));
|
|
except
|
|
if WarningsCount >= 0 then
|
|
begin
|
|
WriteLn('Error running fpdoc, command line: '+CmdLine)
|
|
end
|
|
else
|
|
Dec(WarningsCount);
|
|
end;
|
|
if WarningsCount < -1 then
|
|
WriteLn(abs(WarningsCount+1), ' Warnings hidden. Use --warnings to see them all.');
|
|
if not FileExistsUTF8(XCTFile) then
|
|
raise Exception.Create('File not found: '+XCTFile);
|
|
finally
|
|
Process.Free;
|
|
end;
|
|
|
|
FStep:=frsFPDocExecuted;
|
|
end;
|
|
|
|
procedure TFPDocRun.CopyToXCTDir;
|
|
var
|
|
TargetXCTFile, SrcCHMFile, TargetCHMFile: String;
|
|
begin
|
|
if ord(Step)>=ord(frsCopiedToXCTDir) then
|
|
raise Exception.Create('TFPDocRun.CopyToXCTDir already called');
|
|
if ord(Step)<ord(frsFPDocExecuted) then
|
|
RunFPDoc;
|
|
|
|
if (foCopyToXCTDir in Options)
|
|
and (CompareFilenames(ChompPathDelim(OutDir),ChompPathDelim(XCTDir))<>0) then
|
|
begin
|
|
TargetXCTFile:=AppendPathDelim(XCTDir)+ExtractFileName(XCTFile);
|
|
if ShowCmd then
|
|
writeln('cp ',XCTFile,' ',TargetXCTFile)
|
|
else if not CopyFile(XCTFile,TargetXCTFile) then
|
|
raise Exception.Create('Unable to copy xct file: "'+XCTFile+'" to "'+TargetXCTFile+'"');
|
|
writeln('Created ',TargetXCTFile);
|
|
if OutFormat='chm' then
|
|
begin
|
|
SrcCHMFile:=AppendPathDelim(OutDir)+PackageName+'.chm';
|
|
TargetCHMFile:=AppendPathDelim(XCTDir)+PackageName+'.chm';
|
|
if ShowCmd then
|
|
writeln('cp ',SrcCHMFile,' ',TargetCHMFile)
|
|
else if not CopyFile(SrcCHMFile,TargetCHMFile) then
|
|
raise Exception.Create('Unable to copy chm file: "'+SrcCHMFile+'" to "'+TargetCHMFile+'"');
|
|
writeln('Created ',TargetCHMFile);
|
|
end;
|
|
end;
|
|
|
|
FStep:=frsCopiedToXCTDir;
|
|
end;
|
|
|
|
procedure TFPDocRun.Execute;
|
|
begin
|
|
writeln('===================================================================');
|
|
if ord(Step)>=ord(frsComplete) then
|
|
raise Exception.Create('TFPDocRun.Execute already called');
|
|
if ord(Step)<ord(frsCopiedToXCTDir) then
|
|
CopyToXCTDir;
|
|
|
|
FStep:=frsComplete;
|
|
end;
|
|
|
|
var
|
|
Run: TFPDocRun;
|
|
begin
|
|
ReadOptions;
|
|
|
|
{
|
|
LazUtils was never built with external links to LCL (See Also and source
|
|
declarations) because lcl.xct could not be imported. The file does not exist
|
|
when LazUtils is built.
|
|
|
|
To solve this problem, the output format for LazUtils is built twice. It is the
|
|
smaller of the two packages. Building LazUtils twice ensures that the
|
|
"chicken or the egg" problem with inter-file links is avoided.
|
|
|
|
Build LazUtils WITHOUT any external links (faster).
|
|
Build LCL with links to RTL, FCL, LazUtils.
|
|
Build LazUtils with links to RTL, FCL, LCL.
|
|
}
|
|
// build lazutils WITHOUT any external links
|
|
Run:=TFPDocRun.Create('lazutils');
|
|
Run.ExtraOptions:='-MObjFPC -Scghi'; // extra options from in lazutils makefile.
|
|
// Run.UsedPkgs.Add('rtl');
|
|
// Run.UsedPkgs.Add('fcl');
|
|
Run.XMLSrcDir := '..'+PathDelim+'xml'+PathDelim+'lazutils';
|
|
Run.PasSrcDir := '..'+PathDelim+'..'+PathDelim+'components'+PathDelim+'lazutils';
|
|
Run.Execute;
|
|
Run.Free;
|
|
|
|
// build lcl with links to rtl, fcl, lazutils
|
|
Run:=TFPDocRun.Create('lcl');
|
|
Run.ExtraOptions:='-MObjFPC -Sic'; // extra options from in LCL makefile.
|
|
Run.UsedPkgs.Add('rtl');
|
|
Run.UsedPkgs.Add('fcl');
|
|
Run.UsedPkgs.Add('lazutils');
|
|
Run.XMLSrcDir := '..'+PathDelim+'xml'+PathDelim+'lcl'+PathDelim;
|
|
Run.PasSrcDir := '..'+PathDelim+'..'+PathDelim+'lcl'+PathDelim;
|
|
Run.IncludePath := Run.PasSrcDir+PathDelim+'include';
|
|
Run.Execute;
|
|
Run.Free;
|
|
|
|
// build lazutils with links to rtl, fcl, lcl
|
|
Run:=TFPDocRun.Create('lazutils');
|
|
Run.ExtraOptions:='-MObjFPC -Scghi'; // extra options from in lazutils makefile.
|
|
Run.UsedPkgs.Add('rtl');
|
|
Run.UsedPkgs.Add('fcl');
|
|
Run.UsedPkgs.Add('lcl');
|
|
Run.XMLSrcDir := '..'+PathDelim+'xml'+PathDelim+'lazutils';
|
|
Run.PasSrcDir := '..'+PathDelim+'..'+PathDelim+'components'+PathDelim+'lazutils';
|
|
Run.Execute;
|
|
Run.Free;
|
|
|
|
if ShowCmd then
|
|
writeln('Not executed... simulation ended');
|
|
end.
|