paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-28 09:01:33 +02:00
Code Issues Packages Projects Releases Wiki Activity

build_lcl_docs: uses class

Browse Source 
git-svn-id: trunk@50683 -
This commit is contained in:
mattias 2015-12-06 11:19:24 +00:00
parent ac89c87e02
commit e74f7e54e5
1 changed files with 173 additions and 87 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

260
docs/html/build_lcl_docs.lpr
View File

@ -10,30 +10,54 @@ program update_lcl_docs;
uses uses
Classes, Sysutils, GetOpts, LazFileUtils, FileUtil, UTF8Process, Process; Classes, Sysutils, GetOpts, LazFileUtils, FileUtil, UTF8Process, Process;
var
fpdoc: String = 'fpdoc';
ArgParams: String;
CSSFile: String = 'fpdoc.css';
EnvParams: String;
fpdocfooter: String;
FPCDocsPath: String;
OutFormat: String;
ShowCmd: Boolean;
UsedPkgs: TStringList; // e.g. 'rtl','fcl', 'lazutils'
WarningsCount: Integer;
Verbosity: integer = 0;
const var
PackageName = 'lcl'; DefaultFPDocExe: string = 'fpdoc';
XMLSrcDir = '..'+PathDelim+'..'+PathDelim+'xml'+PathDelim+PackageName+PathDelim; DefaultCSSFile: string = 'fpdoc.css';
PasSrcDir = '..'+PathDelim+'..'+PathDelim+PackageName+PathDelim; WarningsCount: Integer;
InputFileList = 'inputfile.txt'; Verbosity: integer;
FPDocParams = ' --content='+PackageName+'.xct' ShowCmd: Boolean;
+ ' --package='+PackageName EnvParams: String;
+ ' --descr='+XMLSrcDir+PackageName+'.xml' XCTDir: String;
+ ' --input=@'+InputFileList+' '; DefaultFPDocParams: string = '';
DefaultOutFormat: string = 'html';
DefaultFooterFilename: string;
type
{ TFPDocRun }
TFPDocRun = class
private
FFPDocParams: string;
FInputFileList: string;
FPackageName: string;
FPasSrcDir: string;
FXMLSrcDir: string;
procedure SetFPDocParams(AValue: string);
procedure SetInputFileList(AValue: string);
procedure SetPasSrcDir(AValue: string);
procedure SetXMLSrcDir(AValue: string);
public
FPDocExe: String;
CSSFile: String;
Params: String;
FooterFilename: 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 MakeFileList;
procedure CreateOuputDir;
procedure Run;
property PackageName: string read FPackageName;
property XMLSrcDir: string read FXMLSrcDir write SetXMLSrcDir;
property PasSrcDir: string read FPasSrcDir write SetPasSrcDir;
property Input_FileList_Filename: string read FInputFileList write SetInputFileList;
property FPDocParams: string read FFPDocParams write SetFPDocParams;
end;
procedure GetEnvDef(var S: String; DefaultValue: String; EnvName: String); procedure GetEnvDef(var S: String; DefaultValue: String; EnvName: String);
begin begin
S := GetEnvironmentVariable(EnvName); S := GetEnvironmentVariable(EnvName);
@ -41,20 +65,28 @@ begin
S := DefaultValue; S := DefaultValue;
end; end;
function FileInEnvPATH(FileName: String): Boolean;
var
FullFilename: String;
begin
FullFilename:=FindDefaultExecutablePath(Filename);
Result:=(FullFilename<>'') and not DirectoryExistsUTF8(FullFilename);
end;
procedure PrintHelp; procedure PrintHelp;
begin begin
WriteLn('Usage for '+ ExtractFileName(ParamStr(0)), ':'); WriteLn('Usage for '+ ExtractFileName(ParamStr(0)), ':');
WriteLn; WriteLn;
Writeln(' --css-file <value> (CHM format only) CSS file to be used by fpdoc'); Writeln(' --css-file <value> (CHM format only) CSS file to be used by fpdoc');
Writeln(' for the layout of the help pages. Default is "',CSSFile,'"'); Writeln(' for the layout of the help pages. Default is "',DefaultCSSFile,'"');
WriteLn(' --fpdoc <value> The full path to fpdoc to use. Default is "',fpdoc,'"'); 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(' --fpcdocs <value> The directory that contains the required .xct files.');
WriteLn(' Use this to make help that contains links to rtl and fcl'); 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(' --footer <value> Filename of a file to use a footer used in the generated pages.');
WriteLn(' --help Show this message'); WriteLn(' --help Show this message');
WriteLn(' --arg <value> Passes value to fpdoc as an arg. Use this option as'); WriteLn(' --arg <value> Passes value to fpdoc as an arg. Use this option as');
WriteLn(' many times as needed.'); WriteLn(' many times as needed.');
WriteLn(' --outfmt html|chm Use value as the format fpdoc will use. Default is "html"'); 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(' --showcmd Print the command that would be run instead if running it.');
WriteLn(' --warnings Show warnings while working.'); WriteLn(' --warnings Show warnings while working.');
WriteLn(' --verbose be more verbose'); WriteLn(' --verbose be more verbose');
@ -67,9 +99,9 @@ end;
procedure ReadOptions; procedure ReadOptions;
var var
c: char; c: char;
Options: array of TOption; Options: array of TOption;
OptIndex: Longint; OptIndex: Longint;
begin begin
ShowCmd := False; ShowCmd := False;
WarningsCount:=-1; WarningsCount:=-1;
@ -100,14 +132,14 @@ begin
//WriteLn(Options[OptIndex-1].Name, ' = ', OptArg); //WriteLn(Options[OptIndex-1].Name, ' = ', OptArg);
case OptIndex-1 of case OptIndex-1 of
0: PrintHelp; 0: PrintHelp;
1: ArgParams := ArgParams + ' ' + OptArg; 1: DefaultFPDocParams := DefaultFPDocParams + ' ' + OptArg;
2: fpdoc := OptArg; 2: DefaultFPDocExe := OptArg;
3: OutFormat := OptArg; 3: DefaultOutFormat := OptArg;
4: ShowCmd := True; 4: ShowCmd := True;
5: FPCDocsPath := OptArg; 5: XCTDir := OptArg;
6: fpdocfooter := OptArg; 6: DefaultFooterFilename := OptArg;
7: WarningsCount:=0; 7: WarningsCount:=0;
8: CssFile := OptArg; 8: DefaultCssFile := OptArg;
9: inc(Verbosity); 9: inc(Verbosity);
else else
WriteLn('Unknown Value: ', OptIndex); WriteLn('Unknown Value: ', OptIndex);
@ -120,28 +152,45 @@ begin
PrintHelp; PrintHelp;
end; end;
until c = EndOfOptions; until c = EndOfOptions;
GetEnvDef(DefaultOutFormat, DefaultOutFormat, 'FPDOCFORMAT');
GetEnvDef(EnvParams, '', 'FPDOCPARAMS');
GetEnvDef(DefaultFPDocExe, DefaultFPDocExe, 'FPDOC');
GetEnvDef(DefaultFooterFilename, '', 'FPDOCFOOTER');
GetEnvDef(XCTDir, XCTDir, 'FPCDOCS');
XCTDir:=TrimAndExpandDirectory(XCTDir);
if DefaultOutFormat = '' then
begin
writeln('Error: Param outfmt wrong');
PrintHelp;
end;
end; end;
procedure InitVars; { TFPDocRun }
procedure TFPDocRun.InitVars;
var var
Pkg, Prefix: String; Pkg, Prefix: String;
begin begin
// see if any are set or set them to a default value FPDocExe:=TrimFilename(DefaultFPDocExe);
GetEnvDef(OutFormat, OutFormat, 'FPDOCFORMAT'); CSSFile:=TrimFilename(DefaultCSSFile);
GetEnvDef(EnvParams, '', 'FPDOCPARAMS'); XMLSrcDir := '..'+PathDelim+'..'+PathDelim+'xml'+PathDelim+PackageName+PathDelim;
PasSrcDir := '..'+PathDelim+'..'+PathDelim+PackageName+PathDelim;
Input_FileList_Filename := 'inputfile.txt';
FPDocParams := ' --content='+PackageName+'.xct'
+ ' --package='+PackageName
+ ' --descr='+XMLSrcDir+PackageName+'.xml'
+ ' --input=@'+Input_FileList_Filename+' ';
Params:=DefaultFPDocParams;
OutFormat:=DefaultOutFormat;
FooterFilename:=TrimFilename(DefaultFooterFilename);
GetEnvDef(fpdoc, fpdoc, 'FPDOC');
GetEnvDef(fpdocfooter, '', 'FPDOCFOOTER'); Params+=' --format='+OutFormat+' ';
fpdocfooter:=TrimFilename(fpdocfooter);
GetEnvDef(FPCDocsPath, FPCDocsPath, 'FPCDOCS'); if XCTDir <> '' then
FPCDocsPath:=TrimAndExpandDirectory(FPCDocsPath);
if OutFormat = '' then
OutFormat := 'html';
if FPCDocsPath <> '' then
begin begin
for Pkg in UsedPkgs do for Pkg in UsedPkgs do
begin begin
@ -154,24 +203,22 @@ begin
Prefix:=''; Prefix:='';
GetEnvDef(Prefix, Prefix, UpperCase(Pkg)+'LINKPREFIX'); GetEnvDef(Prefix, Prefix, UpperCase(Pkg)+'LINKPREFIX');
ArgParams+=' --import='+TrimFilename(FPCDocsPath+PathDelim+LowerCase(Pkg)+'.xct'); Params+=' --import='+TrimFilename(XCTDir+PathDelim+LowerCase(Pkg)+'.xct');
if Prefix<>'' then if Prefix<>'' then
ArgParams+=','+Prefix; Params+=','+Prefix;
end; end;
end; end;
if OutFormat='chm' then if OutFormat='chm' then
begin begin
if CSSFile='' then CSSFile:='..'+PathDelim+'fpdoc.css'; //css file is chm only if CSSFile='' then CSSFile:='..'+PathDelim+'fpdoc.css'; //css file is chm only
ArgParams+=' --output='+ ChangeFileExt(PackageName, '.chm') Params+=' --output='+ ChangeFileExt(PackageName, '.chm')
+' --auto-toc --auto-index --make-searchable' +' --auto-toc --auto-index --make-searchable'
+' --css-file='+CSSFile+' '; +' --css-file='+CSSFile+' ';
end; end;
ArgParams+=' --format='+OutFormat+' ';
end; end;
procedure AddFilesToList(Dir: String; Ext: String; List: TStrings); procedure TFPDocRun.AddFilesToList(Dir: String; List: TStrings);
var var
FRec: TSearchRec; FRec: TSearchRec;
SubDirs: String; // we do not want the PasSrcDir in this string but the subfolders only SubDirs: String; // we do not want the PasSrcDir in this string but the subfolders only
@ -183,10 +230,10 @@ begin
if (FRec.Name='') or (FRec.Name='.') or (FRec.Name='..') then continue; if (FRec.Name='') or (FRec.Name='.') or (FRec.Name='..') then continue;
if ((FRec.Attr and faDirectory) <> 0) then if ((FRec.Attr and faDirectory) <> 0) then
begin begin
AddFilesToList(Dir+FRec.Name, Ext, List); AddFilesToList(Dir+FRec.Name, List);
//WriteLn('Checking Subfolder ',Dir+ FRec.Name); //WriteLn('Checking Subfolder ',Dir+ FRec.Name);
end end
else if Lowercase(ExtractFileExt(FRec.Name)) = Ext then else if FilenameIsPascalUnit(FRec.Name) then
begin begin
SubDirs := AppendPathDelim(Copy(Dir, Length(PasSrcDir)+1, Length(Dir))); SubDirs := AppendPathDelim(Copy(Dir, Length(PasSrcDir)+1, Length(Dir)));
if Length(SubDirs) = 1 then if Length(SubDirs) = 1 then
@ -197,15 +244,7 @@ begin
FindCloseUTF8(FRec); FindCloseUTF8(FRec);
end; end;
function FileInEnvPATH(FileName: String): Boolean; procedure TFPDocRun.MakeFileList;
var
FullFilename: String;
begin
FullFilename:=FindDefaultExecutablePath(Filename);
Result:=(FullFilename<>'') and not DirectoryExistsUTF8(FullFilename);
end;
procedure MakeFileList;
var var
FileList: TStringList; FileList: TStringList;
InputList: TStringList; InputList: TStringList;
@ -216,9 +255,8 @@ begin
writeln('PasSrcDir="',PasSrcDir,'"'); writeln('PasSrcDir="',PasSrcDir,'"');
FileList := TStringList.Create; FileList := TStringList.Create;
InputList := TStringList.Create; InputList := TStringList.Create;
AddFilesToList(PasSrcDir, '.pas', FileList); AddFilesToList(PasSrcDir, FileList);
AddFilesToList(PasSrcDir, '.pp', FileList);
FileList.Sort; FileList.Sort;
for I := 0 to FileList.Count-1 do for I := 0 to FileList.Count-1 do
begin begin
@ -226,7 +264,7 @@ begin
if FileExistsUTF8(PackageName+PathDelim+XMLFile) and (filelist[i]<>'fpmake.pp') then if FileExistsUTF8(PackageName+PathDelim+XMLFile) and (filelist[i]<>'fpmake.pp') then
begin begin
InputList.Add('..'+PathDelim+PasSrcDir+FileList[I] + ' -Fi..'+PathDelim+PasSrcDir+'include'); InputList.Add('..'+PathDelim+PasSrcDir+FileList[I] + ' -Fi..'+PathDelim+PasSrcDir+'include');
ArgParams:=ArgParams+' --descr='+XMLSrcDir+ChangeFileExt(FileList[I],'.xml'); Params:=Params+' --descr='+XMLSrcDir+ChangeFileExt(FileList[I],'.xml');
end end
else else
begin begin
@ -237,17 +275,30 @@ begin
end; end;
end; end;
FileList.Free; FileList.Free;
InputList.SaveToFile(PackageName+PathDelim+InputFileList); InputList.SaveToFile(PackageName+PathDelim+Input_FileList_Filename);
InputList.Free; InputList.Free;
end; end;
procedure Run; procedure TFPDocRun.CreateOuputDir;
var
OutDir: String;
begin
OutDir:=PackageName;
if Not DirectoryExistsUTF8(OutDir) then
begin
writeln('Creating directory "',OutDir,'"');
if not CreateDirUTF8(OutDir) then
raise Exception.Create('unable to create directory "'+OutDir+'"');
end;
end;
procedure TFPDocRun.Run;
var var
Process: TProcess; Process: TProcess;
CmdLine: String; CmdLine: String;
WorkDir: String; WorkDir: String;
begin begin
CmdLine := fpdoc + FPDocParams + ArgParams + EnvParams; CmdLine := FPDocExe + FPDocParams + Params + EnvParams;
WorkDir := GetCurrentDirUTF8+PathDelim+PackageName; WorkDir := GetCurrentDirUTF8+PathDelim+PackageName;
if ShowCmd then if ShowCmd then
begin begin
@ -256,9 +307,9 @@ begin
Exit; Exit;
end; end;
{$IFDEF MSWINDOWS}fpdoc := ChangeFileExt(fpdoc,'.exe');{$ENDIF} {$IFDEF MSWINDOWS}fpdoc := ChangeFileExt(fpdoc,'.exe');{$ENDIF}
if not FileInEnvPATH(fpdoc) then if not FileInEnvPATH(FPDocExe) then
begin begin
WriteLn('Error: fpdoc cannot be found. Please add its location to the PATH ', 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}); 'or set it with --fpdoc path',PathDelim,'to',PathDelim,'fpdoc'{$IFDEF MSWINDOWS},'.exe'{$ENDIF});
Halt(1); Halt(1);
end; end;
@ -284,21 +335,56 @@ begin
end; end;
end; end;
procedure TFPDocRun.SetFPDocParams(AValue: string);
begin
if FFPDocParams=AValue then Exit;
FFPDocParams:=AValue;
end;
procedure TFPDocRun.SetInputFileList(AValue: string);
begin
if FInputFileList=AValue then Exit;
FInputFileList:=AValue;
end;
procedure TFPDocRun.SetPasSrcDir(AValue: string);
begin
if FPasSrcDir=AValue then Exit;
FPasSrcDir:=AValue;
end;
procedure TFPDocRun.SetXMLSrcDir(AValue: string);
begin
if FXMLSrcDir=AValue then Exit;
FXMLSrcDir:=AValue;
end;
constructor TFPDocRun.Create(aPackageName: string);
begin begin
UsedPkgs:=TStringList.Create; UsedPkgs:=TStringList.Create;
UsedPkgs.Add('rtl'); FPackageName:=aPackageName;
UsedPkgs.Add('fcl'); end;
destructor TFPDocRun.Destroy;
begin
FreeAndNil(UsedPkgs);
inherited Destroy;
end;
var
Run: TFPDocRun;
begin
ReadOptions; ReadOptions;
if Not DirectoryExistsUTF8(PackageName) then
begin
writeln('Creating directory "',PackageName,'"');
mkdir(PackageName);
end;
InitVars;
MakeFileList;
Run;
UsedPkgs.Free; Run:=TFPDocRun.Create('lcl');
Run.UsedPkgs.Add('rtl');
Run.UsedPkgs.Add('fcl');
Run.InitVars;
Run.MakeFileList;
Run.CreateOuputDir;
Run.Run;
Run.Free;
end. end.