mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-13 06:29:32 +02:00
* Added pas2fpm
git-svn-id: trunk@22173 -
This commit is contained in:
michael
parent
d118f4fb41
commit
d666240097
4
.gitattributes
vendored
4
.gitattributes
vendored
@ -13949,6 +13949,10 @@ utils/mksymbian/mksymbian.lpi svneol=native#text/plain
|
||||
utils/mksymbian/mksymbian.pas svneol=native#text/plain
|
||||
utils/mksymbian/projectparser.pas svneol=native#text/plain
|
||||
utils/mksymbian/sdkutil.pas svneol=native#text/plain
|
||||
utils/pas2fpm/Makefile svneol=native#text/plain
|
||||
utils/pas2fpm/Makefile.fpc svneol=native#text/plain
|
||||
utils/pas2fpm/pas2fpm.lpi svneol=native#text/plain
|
||||
utils/pas2fpm/pas2fpm.pp svneol=native#text/plain
|
||||
utils/pas2ut/Makefile svneol=native#text/plain
|
||||
utils/pas2ut/Makefile.fpc svneol=native#text/plain
|
||||
utils/pas2ut/pas2ut.lpi svneol=native#text/plain
|
||||
|
||||
548
utils/Makefile
548
utils/Makefile
File diff suppressed because it is too large
Load Diff
@ -7,7 +7,7 @@ name=utils
|
||||
version=2.7.1
|
||||
|
||||
[target]
|
||||
dirs=fppkg fpcm tply h2pas fprcp dxegen fpdoc fpcmkcfg
|
||||
dirs=fppkg fpcm tply h2pas fprcp dxegen fpdoc fpcmkcfg pas2ut pas2fpm
|
||||
programs=ppdep ptop rstconv data2inc delp bin2obj postw32 rmcvsdir
|
||||
programs_linux=grab_vcsa
|
||||
dirs_win32=fpmc fpcres rmwait instantfpc importtl
|
||||
|
||||
2645
utils/pas2fpm/Makefile
Normal file
2645
utils/pas2fpm/Makefile
Normal file
File diff suppressed because it is too large
Load Diff
28
utils/pas2fpm/Makefile.fpc
Normal file
28
utils/pas2fpm/Makefile.fpc
Normal file
@ -0,0 +1,28 @@
|
||||
#
|
||||
# Makefile.fpc for pas2fpm
|
||||
#
|
||||
|
||||
[package]
|
||||
name=pas2fpm
|
||||
version=2.7.1
|
||||
|
||||
[require]
|
||||
packages=fcl-passrc
|
||||
|
||||
[target]
|
||||
programs=pas2ut
|
||||
rst=pas2ut
|
||||
|
||||
[compiler]
|
||||
options=-S2h
|
||||
|
||||
[install]
|
||||
fpcpackage=y
|
||||
|
||||
[default]
|
||||
fpcdir=../..
|
||||
|
||||
[rules]
|
||||
.NOTPARALLEL:
|
||||
pas2ut$(EXEEXT): pas2fpm.pp
|
||||
|
||||
72
utils/pas2fpm/pas2fpm.lpi
Normal file
72
utils/pas2fpm/pas2fpm.lpi
Normal file
@ -0,0 +1,72 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="Pascal to FPMake application"/>
|
||||
<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="pas2fpm.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="pas2fpm"/>
|
||||
</Unit0>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="pas2fpm"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<MsgFileName Value=""/>
|
||||
</CompilerMessages>
|
||||
<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>
|
||||
237
utils/pas2fpm/pas2fpm.pp
Normal file
237
utils/pas2fpm/pas2fpm.pp
Normal file
@ -0,0 +1,237 @@
|
||||
program pas2fpm;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
Classes, SysUtils, CustApp, passrcutil;
|
||||
|
||||
type
|
||||
|
||||
{ TPas2FPMakeApp }
|
||||
|
||||
TPas2FPMakeApp = class(TCustomApplication)
|
||||
private
|
||||
procedure AddLine(const ALine: String);
|
||||
function CheckParams : boolean;
|
||||
procedure CreateSources;
|
||||
function GetUnitProps(const FN: String; out Res: Boolean; U: TStrings
|
||||
): Boolean;
|
||||
procedure WriteProgEnd;
|
||||
procedure WriteProgStart;
|
||||
procedure WriteSources;
|
||||
protected
|
||||
FFiles,
|
||||
FSrc,
|
||||
FUnits: TStrings;
|
||||
FOutputFile : string;
|
||||
procedure DoRun; override;
|
||||
public
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure WriteHelp; virtual;
|
||||
end;
|
||||
|
||||
{ TPas2FPMakeApp }
|
||||
|
||||
Function TPas2FPMakeApp.CheckParams : Boolean;
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
S : String;
|
||||
|
||||
begin
|
||||
Result:=True;
|
||||
I:=1;
|
||||
While I<=ParamCount do
|
||||
begin
|
||||
S:=Paramstr(i);
|
||||
if (S<>'') then
|
||||
begin
|
||||
if S[1]<>'-' then
|
||||
begin
|
||||
FFiles.Add(S);
|
||||
FUnits.Add(ChangeFileExt(ExtractFileName(S),''));
|
||||
end
|
||||
else
|
||||
begin
|
||||
If (s='-o') then
|
||||
else
|
||||
begin
|
||||
Result:=False;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
Inc(i);
|
||||
end;
|
||||
Result:=(FFiles.Count>0);
|
||||
end;
|
||||
|
||||
procedure TPas2FPMakeApp.AddLine(Const ALine : String);
|
||||
|
||||
begin
|
||||
FSrc.Add(ALine);
|
||||
end;
|
||||
|
||||
Function TPas2FPMakeApp.GetUnitProps(Const FN : String; Out Res : Boolean; U : TStrings) : Boolean;
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
A : TPasSrcAnalysis;
|
||||
|
||||
begin
|
||||
Result:=False;
|
||||
try
|
||||
A:=TPasSrcAnalysis.Create(Self);
|
||||
try
|
||||
A.FileName:=FN;
|
||||
Res:=A.HasResourcestrings;
|
||||
A.GetUsedUnits(U);
|
||||
For I:=U.Count-1 downto 0 do
|
||||
if FUnits.IndexOf(U[i])=-1 then
|
||||
U.Delete(i);
|
||||
finally
|
||||
A.Free;
|
||||
end;
|
||||
Result:=True;
|
||||
except
|
||||
// Ignore
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPas2FPMakeApp.WriteProgStart;
|
||||
|
||||
begin
|
||||
AddLine('program fpmake;');
|
||||
AddLine('');
|
||||
AddLine('uses fpmkunit;');
|
||||
AddLine('');
|
||||
AddLine('Var');
|
||||
AddLine(' T : TTarget;');
|
||||
AddLine(' P : TPackage;');
|
||||
AddLine('begin');
|
||||
AddLine(' With Installer do');
|
||||
AddLine(' begin');
|
||||
AddLine(' P.Version:=''0.0'';');
|
||||
// AddLine(' P.Dependencies.Add('fcl-base');
|
||||
AddLine(' P.Author := ''Your name'';');
|
||||
AddLine(' P.License := ''LGPL with modification'';');
|
||||
AddLine(' P.HomepageURL := ''www.yourcompany.com'';');
|
||||
AddLine(' P.Email := ''yourmail@yourcompany.com'';');
|
||||
AddLine(' P.Description := ''Your very nice program'';');
|
||||
AddLine(' // P.NeedLibC:= false;');
|
||||
end;
|
||||
|
||||
procedure TPas2FPMakeApp.WriteProgEnd;
|
||||
|
||||
begin
|
||||
AddLine(' Run;');
|
||||
AddLine(' end;');
|
||||
AddLine('end.');
|
||||
end;
|
||||
|
||||
procedure TPas2FPMakeApp.CreateSources;
|
||||
|
||||
|
||||
Var
|
||||
I,j : Integer;
|
||||
U : TStrings;
|
||||
FN : String;
|
||||
R : Boolean;
|
||||
|
||||
begin
|
||||
WriteProgStart;
|
||||
For I:=0 to FFiles.Count-1 do
|
||||
begin
|
||||
FN:=FFiles[i];
|
||||
AddLine(' T:=P.Targets.AddUnit('''+FN+''');');
|
||||
U:=TStringList.Create;
|
||||
if not GetUnitProps(Fn,R,U) then
|
||||
AddLine(' // Failed to analyse unit '+FN)
|
||||
else
|
||||
begin
|
||||
if R then
|
||||
AddLine(' T.ResourceStrings := True;');
|
||||
if (U.Count>0) then
|
||||
begin
|
||||
AddLine(' with T.Dependencies do');
|
||||
AddLine(' begin');
|
||||
For J:=0 to U.Count-1 do
|
||||
AddLine(' AddUnit('''+U[j]+''');');
|
||||
AddLine(' end;');
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
WriteProgEnd;
|
||||
end;
|
||||
|
||||
procedure TPas2FPMakeApp.WriteSources;
|
||||
|
||||
Var
|
||||
F : Text;
|
||||
|
||||
begin
|
||||
AssignFile(F,FOutputFile);
|
||||
Rewrite(F);
|
||||
try
|
||||
Write(F,FSrc.Text);
|
||||
finally
|
||||
CloseFile(F);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPas2FPMakeApp.DoRun;
|
||||
|
||||
var
|
||||
ErrorMsg: String;
|
||||
|
||||
begin
|
||||
// parse parameters
|
||||
if HasOption('h','help') or Not CheckParams then
|
||||
begin
|
||||
WriteHelp;
|
||||
Terminate;
|
||||
exit;
|
||||
end;
|
||||
TStringList(FUnits).Sorted:=True;
|
||||
CreateSources;
|
||||
WriteSources;
|
||||
// stop program loop
|
||||
Terminate;
|
||||
end;
|
||||
|
||||
constructor TPas2FPMakeApp.Create(TheOwner: TComponent);
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
StopOnException:=True;
|
||||
FFiles:=TStringList.Create;
|
||||
FSrc:=TStringList.Create;
|
||||
FUnits:=TStringList.Create;
|
||||
end;
|
||||
|
||||
destructor TPas2FPMakeApp.Destroy;
|
||||
begin
|
||||
FreeAndNil(FFiles);
|
||||
FreeAndNil(FSrc);
|
||||
FreeAndNil(FUnits);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TPas2FPMakeApp.WriteHelp;
|
||||
begin
|
||||
{ add your help code here }
|
||||
writeln('Usage: ',ExeName,' [-h] [-o outputfile] file1 .. filen');
|
||||
end;
|
||||
|
||||
var
|
||||
Application: TPas2FPMakeApp;
|
||||
begin
|
||||
Application:=TPas2FPMakeApp.Create(nil);
|
||||
Application.Title:='Pascal to FPMake application';
|
||||
Application.Run;
|
||||
Application.Free;
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user