lazarus/docs/html/build_lcl_docs.lpr

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 -dUseSystemUITypes'; // 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 -dUseSystemUITypes'; // 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 -dUseSystemUITypes'; // 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.