mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-22 15:29:25 +02:00
* Start of project file manipulation program
git-svn-id: trunk@19725 -
This commit is contained in:
parent
e07646a653
commit
c17d15cf72
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -12910,6 +12910,8 @@ utils/fpdoc/intl/fpdocstr.de.po svneol=native#text/plain
|
|||||||
utils/fpdoc/intl/makeskel.de.po svneol=native#text/plain
|
utils/fpdoc/intl/makeskel.de.po svneol=native#text/plain
|
||||||
utils/fpdoc/makeskel.lpi svneol=native#text/plain
|
utils/fpdoc/makeskel.lpi svneol=native#text/plain
|
||||||
utils/fpdoc/makeskel.pp svneol=native#text/plain
|
utils/fpdoc/makeskel.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
|
utils/fpdoc/sample-project.xml svneol=native#text/plain
|
||||||
utils/fpdoc/sh_pas.pp svneol=native#text/plain
|
utils/fpdoc/sh_pas.pp svneol=native#text/plain
|
||||||
utils/fpdoc/testunit.pp svneol=native#text/plain
|
utils/fpdoc/testunit.pp svneol=native#text/plain
|
||||||
|
69
utils/fpdoc/mkfpdocproj.lpi
Normal file
69
utils/fpdoc/mkfpdocproj.lpi
Normal file
@ -0,0 +1,69 @@
|
|||||||
|
<?xml version="1.0"?>
|
||||||
|
<CONFIG>
|
||||||
|
<ProjectOptions>
|
||||||
|
<Version Value="9"/>
|
||||||
|
<General>
|
||||||
|
<Flags>
|
||||||
|
<MainUnitHasCreateFormStatements Value="False"/>
|
||||||
|
</Flags>
|
||||||
|
<SessionStorage Value="InProjectDir"/>
|
||||||
|
<MainUnit Value="0"/>
|
||||||
|
<UseAppBundle Value="False"/>
|
||||||
|
<ResourceType Value="res"/>
|
||||||
|
</General>
|
||||||
|
<i18n>
|
||||||
|
<EnableI18N LFM="False"/>
|
||||||
|
</i18n>
|
||||||
|
<VersionInfo>
|
||||||
|
<StringTable ProductVersion=""/>
|
||||||
|
</VersionInfo>
|
||||||
|
<BuildModes Count="1">
|
||||||
|
<Item1 Name="Default" Default="True"/>
|
||||||
|
</BuildModes>
|
||||||
|
<PublishOptions>
|
||||||
|
<Version Value="2"/>
|
||||||
|
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
||||||
|
<ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
|
||||||
|
</PublishOptions>
|
||||||
|
<RunParams>
|
||||||
|
<local>
|
||||||
|
<FormatVersion Value="1"/>
|
||||||
|
<LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||||
|
</local>
|
||||||
|
</RunParams>
|
||||||
|
<Units Count="1">
|
||||||
|
<Unit0>
|
||||||
|
<Filename Value="mkfpdocproj.pp"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<UnitName Value="mkfpdocproj"/>
|
||||||
|
</Unit0>
|
||||||
|
</Units>
|
||||||
|
</ProjectOptions>
|
||||||
|
<CompilerOptions>
|
||||||
|
<Version Value="11"/>
|
||||||
|
<SearchPaths>
|
||||||
|
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||||
|
</SearchPaths>
|
||||||
|
<Parsing>
|
||||||
|
<SyntaxOptions>
|
||||||
|
<UseAnsiStrings Value="False"/>
|
||||||
|
</SyntaxOptions>
|
||||||
|
</Parsing>
|
||||||
|
<Other>
|
||||||
|
<CompilerPath Value="$(CompPath)"/>
|
||||||
|
</Other>
|
||||||
|
</CompilerOptions>
|
||||||
|
<Debugging>
|
||||||
|
<Exceptions Count="3">
|
||||||
|
<Item1>
|
||||||
|
<Name Value="EAbort"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<Name Value="ECodetoolError"/>
|
||||||
|
</Item2>
|
||||||
|
<Item3>
|
||||||
|
<Name Value="EFOpenError"/>
|
||||||
|
</Item3>
|
||||||
|
</Exceptions>
|
||||||
|
</Debugging>
|
||||||
|
</CONFIG>
|
141
utils/fpdoc/mkfpdocproj.pp
Normal file
141
utils/fpdoc/mkfpdocproj.pp
Normal file
@ -0,0 +1,141 @@
|
|||||||
|
program mkfpdocproj;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, fpdocproj, fpdocxmlopts, CustApp;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TManageFPDocProjectApplication }
|
||||||
|
|
||||||
|
TManageFPDocProjectApplication = class(TCustomApplication)
|
||||||
|
private
|
||||||
|
procedure ParseOptions;
|
||||||
|
protected
|
||||||
|
FRecurse : boolean;
|
||||||
|
FDirectory,
|
||||||
|
FMask,
|
||||||
|
FPackageName,
|
||||||
|
FInputFileName,
|
||||||
|
FOutputFileName : String;
|
||||||
|
FProject : TFPDocProject;
|
||||||
|
FPackage : TFPDocPackage;
|
||||||
|
procedure ReadOptionFile(const AFileName: String);
|
||||||
|
procedure Usage(AExitCode: Integer);
|
||||||
|
procedure WriteOptionFile(const AFileName: String);
|
||||||
|
procedure AddFilesFromDirectory(ADirectory, AMask: String; ARecurse: Boolean);
|
||||||
|
procedure DoRun; override;
|
||||||
|
public
|
||||||
|
constructor Create(TheOwner: TComponent); override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TManageFPDocProjectApplication }
|
||||||
|
|
||||||
|
procedure TManageFPDocProjectApplication.Usage(AExitCode : Integer);
|
||||||
|
|
||||||
|
begin
|
||||||
|
// to be filled
|
||||||
|
Halt(AExitCode);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TManageFPDocProjectApplication.ParseOptions;
|
||||||
|
|
||||||
|
Var
|
||||||
|
PN : String;
|
||||||
|
|
||||||
|
begin
|
||||||
|
FInputFileName:=GetOptionValue('i','input');
|
||||||
|
FOutputFileName:=GetOptionValue('o','output');
|
||||||
|
FPackageName:=GetOptionValue('p','package');
|
||||||
|
if (FOutputFileName='') then
|
||||||
|
FOutputFileName:=FInputFileName;
|
||||||
|
FDirectory:=GetOptionValue('d','directory');
|
||||||
|
FMask:=GetOptionValue('m','mask');
|
||||||
|
FRecurse:=HasOption('r','recurse');
|
||||||
|
if HasOption('h','help') then
|
||||||
|
Usage(0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure TManageFPDocProjectApplication.AddFilesFromDirectory(ADirectory,AMask : String; ARecurse : Boolean);
|
||||||
|
|
||||||
|
Var
|
||||||
|
Info : TSearchRec;
|
||||||
|
D : String;
|
||||||
|
|
||||||
|
begin
|
||||||
|
if (AMask='') then
|
||||||
|
AMask:='*.xml';
|
||||||
|
D:=ADirectory;
|
||||||
|
if (D<>'') then
|
||||||
|
D:=includeTrailingPathDelimiter(D);
|
||||||
|
If FindFirst(D+AMask,0,info)=0 then
|
||||||
|
try
|
||||||
|
Repeat
|
||||||
|
if ((Info.Attr and faDirectory)=0) then
|
||||||
|
FPackage.Descriptions.add(D+Info.Name);
|
||||||
|
Until (FindNext(Info)<>0);
|
||||||
|
finally
|
||||||
|
FindClose(Info);
|
||||||
|
end;
|
||||||
|
If ARecurse and (FindFirst(ADirectory+AMask,0,info)=0) then
|
||||||
|
try
|
||||||
|
Repeat
|
||||||
|
if ((Info.Attr and faDirectory)<>0) then
|
||||||
|
AddFilesFromDirectory(IncludeTrailingPathDelimiter(D+Info.Name),AMask,ARecurse);
|
||||||
|
Until (FindNext(Info)<>0);
|
||||||
|
finally
|
||||||
|
FindClose(Info);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TManageFPDocProjectApplication.ReadOptionFile(Const AFileName : String);
|
||||||
|
|
||||||
|
begin
|
||||||
|
With TXMLFPDocOptions.Create(Self) do
|
||||||
|
try
|
||||||
|
LoadOptionsFromFile(FProject,AFileName);
|
||||||
|
finally
|
||||||
|
Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TManageFPDocProjectApplication.WriteOptionFile(Const AFileName : String);
|
||||||
|
|
||||||
|
begin
|
||||||
|
With TXMLFPDocOptions.Create(Self) do
|
||||||
|
try
|
||||||
|
SaveOptionsToFile(FProject,AFileName);
|
||||||
|
finally
|
||||||
|
Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TManageFPDocProjectApplication.DoRun;
|
||||||
|
|
||||||
|
begin
|
||||||
|
ParseOptions;
|
||||||
|
ReadOptionFile(FInputFileName);
|
||||||
|
FPackage:=FProject.Packages.FindPackage(FPackageName);
|
||||||
|
If (FDirectory<>'') or (FMask<>'') then
|
||||||
|
AddFilesFromDirectory(FDirectory,FMask, FRecurse);
|
||||||
|
WriteOptionFile(FOutputFileName);
|
||||||
|
Terminate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TManageFPDocProjectApplication.Create(TheOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(TheOwner);
|
||||||
|
StopOnException:=True;
|
||||||
|
FProject:=TFPDocProject.Create(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
Application: TManageFPDocProjectApplication;
|
||||||
|
begin
|
||||||
|
Application:=TManageFPDocProjectApplication.Create(nil);
|
||||||
|
Application.Title:='Program to manipulate FPDoc project files';
|
||||||
|
Application.Run;
|
||||||
|
Application.Free;
|
||||||
|
end.
|
||||||
|
|
Loading…
Reference in New Issue
Block a user