mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-22 07:02:32 +02:00
480 lines
14 KiB
ObjectPascal
480 lines
14 KiB
ObjectPascal
program update_lcl_docs;
|
|
|
|
{ Runs FPC's fpdoc document generator to generate LCL documentation,
|
|
e.g. in CHM format }
|
|
|
|
{$mode objfpc}{$H+}
|
|
{$IFDEF MSWINDOWS}
|
|
{$APPTYPE console}
|
|
{$ENDIF}
|
|
|
|
uses
|
|
Classes, Sysutils, GetOpts, LazFileUtils, FileUtil, UTF8Process, LazUtilities,
|
|
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; // ToDo
|
|
|
|
type
|
|
TFPDocRunStep = (
|
|
frsCreated,
|
|
frsVarsInitialized,
|
|
frsFilesGathered,
|
|
frsOutDirCreated,
|
|
frsFPDocExecuted,
|
|
frsComplete
|
|
);
|
|
|
|
{ TFPDocRun }
|
|
|
|
TFPDocRun = class
|
|
private
|
|
FCSSFile: String;
|
|
FFooterFilename: String;
|
|
FIncludePath: string;
|
|
FInputFile: string;
|
|
FPackageName: string;
|
|
FPasSrcDir: string;
|
|
FStep: TFPDocRunStep;
|
|
FXCTDir: string;
|
|
FXMLSrcDir: string;
|
|
procedure SetCSSFile(AValue: String);
|
|
procedure SetFooterFilename(AValue: String);
|
|
procedure SetIncludePath(AValue: string);
|
|
procedure SetInputFile(AValue: string);
|
|
procedure SetPasSrcDir(AValue: string);
|
|
procedure SetXCTDir(AValue: string);
|
|
procedure SetXMLSrcDir(AValue: string);
|
|
public
|
|
OutDir: string;
|
|
FPDocExe: String;
|
|
Params: String;
|
|
ParseParams: string;
|
|
OutFormat: String;
|
|
UsedPkgs: TStringList; // e.g. 'rtl','fcl', 'lazutils'
|
|
constructor Create(aPackageName: string);
|
|
destructor Destroy; override;
|
|
procedure InitVars;
|
|
procedure AddFilesToList(Dir: String; List: TStrings);
|
|
procedure FindSourceFiles;
|
|
procedure CreateOuputDir;
|
|
procedure Run;
|
|
property PackageName: string read FPackageName;
|
|
property XMLSrcDir: string read FXMLSrcDir write SetXMLSrcDir;
|
|
property PasSrcDir: string read FPasSrcDir write SetPasSrcDir;
|
|
property IncludePath: string read FIncludePath write SetIncludePath;// semicolon separated search path
|
|
property InputFile: string read FInputFile write SetInputFile; // relative to OutDir, automatically created
|
|
property CSSFile: String read FCSSFile write SetCSSFile;
|
|
property FooterFilename: String read FFooterFilename write SetFooterFilename; // ToDo
|
|
property XCTDir: string read FXCTDir write SetXCTDir;
|
|
property Step: TFPDocRunStep read FStep;
|
|
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(' --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, '', 'FPDOCFOOTER');
|
|
GetEnvDef(DefaultXCTDir, DefaultXCTDir, 'FPCDOCS');
|
|
|
|
if DefaultOutFormat = '' then
|
|
begin
|
|
writeln('Error: Param outfmt wrong');
|
|
PrintHelp;
|
|
end;
|
|
end;
|
|
|
|
{ TFPDocRun }
|
|
|
|
procedure TFPDocRun.SetInputFile(AValue: string);
|
|
begin
|
|
AValue:=TrimFilename(AValue);
|
|
if FInputFile=AValue then Exit;
|
|
FInputFile:=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;
|
|
|
|
procedure TFPDocRun.SetFooterFilename(AValue: String);
|
|
begin
|
|
AValue:=TrimAndExpandFilename(AValue);
|
|
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;
|
|
UsedPkgs:=TStringList.Create;
|
|
InputFile := 'inputfile.txt';
|
|
OutDir:=TrimAndExpandFilename(PackageName);
|
|
FPDocExe:=TrimFilename(DefaultFPDocExe);
|
|
CSSFile:=TrimFilename(DefaultCSSFile);
|
|
Params := DefaultFPDocParams;
|
|
OutFormat:=DefaultOutFormat;
|
|
FooterFilename:=TrimFilename(DefaultFooterFilename);
|
|
XCTDir:=DefaultXCTDir;
|
|
|
|
FStep:=frsCreated;
|
|
end;
|
|
|
|
destructor TFPDocRun.Destroy;
|
|
begin
|
|
FreeAndNil(UsedPkgs);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TFPDocRun.InitVars;
|
|
var
|
|
Pkg, Prefix, IncludeDir: 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;
|
|
|
|
Params += ' --content='+PackageName+'.xct'
|
|
+ ' --package='+PackageName
|
|
+ ' --descr='+CreateRelativePath(AppendPathDelim(XMLSrcDir)+PackageName+'.xml',OutDir)
|
|
+ ' --format='+OutFormat;
|
|
if FilenameIsAbsolute(InputFile) then
|
|
Params += ' --input=@'+CreateRelativePath(InputFile,OutDir)
|
|
else
|
|
Params += ' --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');
|
|
|
|
Params+=' --import='+CreateRelativePath(AppendPathDelim(XCTDir)+LowerCase(Pkg)+'.xct',OutDir);
|
|
if Prefix<>'' then
|
|
Params+=','+Prefix;
|
|
end;
|
|
end;
|
|
|
|
if OutFormat='chm' then
|
|
begin
|
|
Params+=' --output='+ ChangeFileExt(PackageName, '.chm')
|
|
+' --auto-toc --auto-index --make-searchable';
|
|
if CSSFile<>'' then
|
|
Params+=' --css-file='+CreateRelativePath(CSSFile,OutDir);
|
|
end;
|
|
|
|
if EnvParams<>'' then
|
|
Params += ' '+EnvParams;
|
|
|
|
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=',ParseParams);
|
|
writeln('FPDocParams=',Params);
|
|
writeln('----------------------------------');
|
|
end;
|
|
|
|
FStep:=frsVarsInitialized;
|
|
end;
|
|
|
|
procedure TFPDocRun.AddFilesToList(Dir: String; List: TStrings);
|
|
var
|
|
FRec: TSearchRec;
|
|
begin
|
|
Dir:=AppendPathDelim(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 FilenameIsPascalUnit(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: String;
|
|
begin
|
|
if ord(Step)>=ord(frsFilesGathered) then
|
|
raise Exception.Create('TFPDocRun.FindSourceFiles not again');
|
|
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 := XMLSrcDir+ExtractFileNameOnly(FileList[I])+'.xml';
|
|
if FileExistsUTF8(XMLFile) then
|
|
begin
|
|
InputList.Add(CreateRelativePath(FileList[I],OutDir) + ParseParams);
|
|
Params:=Params+' --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;
|
|
InputList.SaveToFile(InputFile);
|
|
InputList.Free;
|
|
|
|
FStep:=frsFilesGathered;
|
|
end;
|
|
|
|
procedure TFPDocRun.CreateOuputDir;
|
|
begin
|
|
if ord(Step)>=ord(frsOutDirCreated) then
|
|
raise Exception.Create('TFPDocRun.CreateOuputDir not again');
|
|
if ord(Step)<ord(frsFilesGathered) then
|
|
FindSourceFiles;
|
|
|
|
if Not DirectoryExistsUTF8(OutDir) then
|
|
begin
|
|
writeln('Creating directory "',OutDir,'"');
|
|
if not CreateDirUTF8(OutDir) then
|
|
raise Exception.Create('unable to create directory "'+OutDir+'"');
|
|
end;
|
|
|
|
FStep:=frsOutDirCreated;
|
|
end;
|
|
|
|
procedure TFPDocRun.Run;
|
|
var
|
|
Process: TProcess;
|
|
CmdLine: String;
|
|
begin
|
|
if ord(Step)>=ord(frsFPDocExecuted) then
|
|
raise Exception.Create('TFPDocRun.Run not again');
|
|
if ord(Step)<ord(frsOutDirCreated) then
|
|
CreateOuputDir;
|
|
|
|
CmdLine := FPDocExe + Params;
|
|
if ShowCmd then
|
|
begin
|
|
Writeln('WorkDirectory:',OutDir);
|
|
WriteLn(CmdLine);
|
|
Exit;
|
|
end;
|
|
{$IFDEF MSWINDOWS}fpdoc := ChangeFileExt(fpdoc,'.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.CommandLine := CmdLine;
|
|
if Verbosity>0 then
|
|
writeln('Command="',Process.CommandLine,'"');
|
|
try
|
|
Process.Execute;
|
|
except
|
|
if WarningsCount >= 0 then
|
|
WriteLn('Error running fpdoc, command line: '+CmdLine)
|
|
else
|
|
Dec(WarningsCount);
|
|
end;
|
|
if WarningsCount < -1 then
|
|
WriteLn(abs(WarningsCount+1), ' Warnings hidden. Use --warnings to see them all.');
|
|
finally
|
|
Process.Free;
|
|
end;
|
|
|
|
FStep:=frsComplete;
|
|
end;
|
|
|
|
var
|
|
Run: TFPDocRun;
|
|
begin
|
|
ReadOptions;
|
|
|
|
Run:=TFPDocRun.Create('lcl');
|
|
Run.UsedPkgs.Add('rtl');
|
|
Run.UsedPkgs.Add('fcl');
|
|
Run.XMLSrcDir := '..'+PathDelim+'xml'+PathDelim+'lcl'+PathDelim;
|
|
Run.PasSrcDir := '..'+PathDelim+'..'+PathDelim+'lcl'+PathDelim;
|
|
Run.IncludePath := Run.PasSrcDir+PathDelim+'include';
|
|
Run.Run;
|
|
Run.Free;
|
|
end.
|
|
|