123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963 |
- program fppkg;
- {$mode objfpc}{$H+}
- uses
- Classes, SysUtils, TypInfo
- { add your units here };
-
- Resourcestring
- // SErrInValidArgument = 'Invalid command-line argument at position %d : %s';
- SErrNeedArgument = 'Option at position %d (%s) needs an argument';
- SErrMissingConfig = 'Missing configuration Makefile.fpc or fpmake.pp';
- SErrRunning = 'The FPC make tool encountered the following error: %s';
- SErrFailedToCompileFPCMake = 'Could not compile fpmake driver program';
- SLogGeneratingFPMake = 'Generating fpmake.pp';
- SLogCompilingFPMake = 'Compiling fpmake.pp: ';
- SLogRunningFPMake = 'Running fpmake';
- Type
- TRunMode = (rmHelp,rmCompile,rmBuild,rmInstall,rmArchive,rmClean,rmDownload);
- { TMakeTool }
- TMakeTool = Class(TObject)
- Private
- FConvertOnly,
- FLogging : Boolean;
- FCompiler : String;
- FRunMode : TRunMode;
- FHaveMakefile : Boolean;
- FHaveFpmake : Boolean;
- FFPMakeSrc : String;
- FFPMakeBin : String;
- Procedure Log(Msg : String);
- Procedure Error(Msg : String);
- Procedure Error(Fmt : String; Args : Array of const);
- Function GetCompiler : String;
- Public
- Procedure ProcessCommandLine;
- procedure CreateFPMake;
- procedure CompileFPMake(Extra : Boolean);
- Function RunFPMake : Integer;
- Procedure Run;
- end;
- EMakeToolError = Class(Exception);
- { TMakeFileConverter }
- TSectionType = (stNone,stPackage,stTarget,stclean,stinstall,stCompiler,
- stDefault,stRequire,stRules,stPrerules);
-
- TMakeFileConverter = Class(TObject)
- FSection : TSectionType;
- FPackageName,
- FpackageDir,
- FPackageOptions,
- FPackageDeps,
- FBuilDUnit,
- FSubName,
- FPackageVersion : String;
- // Reading;
- procedure DoPackageLine(Const S : String);
- Procedure DoTargetLine(Line : String; Var T,R,D : TStrings);
- Procedure DoInstallLine(Line : String; Var IFL : TStrings);
- procedure DoCleanLine(Line : String; Var CFL : TStrings);
- procedure DoRequireLine(Line : String);
- procedure DoCompilerLine(Line : String;Var SD : TStrings);
- // Writing;
- procedure WriteOSCPUCheck(Src: TStrings;OS,CPU : String);
- procedure StartPackage(Src : TStrings; Dir,OS : String);
- procedure EndPackage(Src : TStrings; Dir,OS : String);
- procedure DoTargets(Src,T,R,SD : TStrings; Dir,Prefix : String);
- procedure DoCleans(Src,CFL : TStrings);
- procedure DoInstalls(Src,IFL : TStrings);
- Procedure StartInstaller(Src : TStrings);
- Procedure EndInstaller(Src : TStrings);
- Function GetLine (L : TStrings; Var I : Integer) : String;
- Public
- procedure ConvertFile(const AFileName: String; Src: TStrings; Dir,OS : String);
- Procedure ConvertFile(Const Source,Dest: String);
- end;
- { Auxiliary functions }
- Function GetWord(var S : String; Sep : Char) : String;
- Var
- L : Integer;
- begin
- L:=Pos(Sep,S);
- If (L=0) then
- L:=Length(S)+1;
- Result:=Copy(S,1,L-1);
- Delete(S,1,L);
- S:=Trim(S);
- end;
- Function GetWord(var S : String) : String;
- begin
- Result:=GetWord(S,' ');
- end;
- Function IsCPU (S: String) : Boolean;
- begin
- Result:=Pos(lowercase(S)+',','i386,powerpc,arm,alpha,sparc,')<>0
- end;
- Function GetOSCPU(L : String; var OS,CPU : String) : String;
- Procedure Add(Var A : String; ad : String);
-
- begin
- If (A<>'') then
- A:=A+',';
- A:=A+ad;
- end;
-
- Var
- S : String;
- begin
- OS:='';
- CPU:='';
- S:=GetWord(L,',');
- While (S<>'') do
- begin
- If (S<>'all') then
- If IsCPU(S) then
- Add(CPU,S)
- else
- Add(OS,S);
- S:=GetWord(L,',');
- end;
- end;
- { TMakeFileConverter }
- procedure TMakeFileConverter.StartInstaller(Src: TStrings);
- begin
- With Src do
- begin
- Add('{$mode objfpc}{$H+}');
- Add('program fpmake;');
-
- Add('');
- Add(' { Generated automatically by '+ExtractFileName(Paramstr(0))+' on '+DateToStr(Sysutils.Date)+' }');
- Add('');
- Add('uses fpmkunit;');
- Add('');
- Add('Var');
- Add(' T : TTarget;');
- Add('');
- Add('begin');
- Add(' With Installer do ');
- Add(' begin');
- end;
- end;
- procedure TMakeFileConverter.EndInstaller(Src: TStrings);
- begin
- With Src do
- begin
- Add(' Run;');
- Add(' end;');
- Add('end.');
- Add('');
- end;
- end;
- Function TMakeFileConverter.GetLine (L : TStrings; Var I : Integer) : String;
- Var
- P : Integer;
- OK : Boolean;
- begin
- OK:=False;
- Result:='';
- Repeat
- Result:=Result+L[i];
- P:=Pos('#',Result);
- If (P>0) then
- Result:=Copy(Result,1,P-1);
- Result:=Trim(Result);
- P:=Length(Result);
- If (P>0) and (Result[P]='\') then
- Result:=Copy(Result,1,P-1)
- else
- OK:=(Result<>'');
- if Not OK then
- Inc(I);
- Until OK or (I>L.Count-1);
- end;
- Function SplitNamevalue(Const S : String; Var AName,AValue : String) : boolean;
- var
- L : Integer;
- begin
- L:=Pos('=',S);
- Result:=(L<>0);
- If Result then
- begin
- AName:=LowerCase(trim(Copy(S,1,L-1)));
- AValue:=S;
- Delete(AValue,1,L);
- AValue:=Trim(Avalue);
- end
- else
- begin
- AName:='';
- AValue:='';
- end;
- end;
- procedure TMakeFileConverter.StartPackage(Src : TStrings; Dir,OS : String);
- Var
- S : String;
- begin
- With Src do
- begin
- Add(' { ');
- Add(' '+FPackageName);
- Add(' } ');
- Add(' StartPackage('''+FPackageName+''');');
- If (Dir<>'') then
- Add(' Directory:='''+ExcludeTrailingPathDelimiter(Dir)+''';');
- If (OS<>'') and (OS<>'all') then
- Add(' OS:=['+OS+'];');
- If (FPackageVersion<>'') then
- Add(' Version:='''+FPackageVersion+''';');
- If (FPackageOptions<>'') then
- Add(' Options:='''+FPackageOptions+''';');
- If (FPackageDeps<>'') then
- begin
- S:=GetWord(FPackageDeps);
- While S<>'' do
- begin
- Add(' Dependencies.Add('''+S+''');');
- S:=GetWord(FPackageDeps);
- end;
- end;
- end;
- end;
- procedure TMakeFileConverter.EndPackage(Src : TStrings; Dir,OS : String);
- begin
- Src.add(' EndPackage;');
- FPackageName:='';
- FPackageVersion:='';
- FPackageOptions:='';
- FBuilDUnit:='';
- FPackageDeps:='';
- end;
- procedure TMakeFileConverter.DoPackageLine(Const S : String);
- Var V,N : String;
- begin
- SplitNameValue(S,N,V);
- If (N='name') then
- FPackageName:=V
- else If (N='version') then
- FPackageVersion:=V
- else If (N='main') then
- begin
- FPackageName:='sub';
- FSubName:=V;
- end
- else
- Writeln(StdErr,'Unknown name/value pair in package section :',N);
- end;
- {
- Convert various entries of type
- XXYY_OSN=words
- to entries of type
- prefix_word=OS1,OS2,OS3
- OS is never empty, 'all' is default.
- }
- Procedure AddStrings(Var L : TStrings; Values,Prefix,OS : String) ;
- Var
- S,O : String;
- i : integer;
-
- begin
- If (L=Nil) then
- L:=TstringList.Create;
- If prefix<>'' then
- prefix:=prefix+'_';
- S:=GetWord(Values);
- While (S<>'') do
- begin
- S:=Prefix+S;
- I:=L.IndexOfName(S);
- If (I<>-1) then
- begin
- O:=L.Values[S];
- If (O='all') then
- O:='';
- If (O<>'') then
- O:=O+',';
- O:=O+OS;
- L.Values[S]:=O;
- end
- else
- L.Add(S+'='+OS);
- S:=GetWord(Values);
- end;
- end;
- procedure TMakeFileConverter.DoTargetLine(Line : String; Var T,R,D : TStrings);
- Var
- V,N,OS : String;
- P : Integer;
- begin
- SplitNameValue(Line,N,V);
- P:=Pos('_',N);
- If (P=0) then
- OS:='all'
- else
- begin
- OS:=N;
- Delete(OS,1,P);
- N:=Copy(N,1,P-1);
- end;
- If (N='dirs') then
- AddStrings(D,V,'',OS)
- else If (N='units') then
- AddStrings(T,V,'unit',OS)
- else If (N='implicitunits') then
- AddStrings(T,V,'unit',OS)
- else If (N='programs') then
- AddStrings(T,V,'program',OS)
- else If (N='examples') then
- AddStrings(T,V,'exampleunit',OS)
- else If (N='rsts') then
- AddStrings(R,V,'',OS)
- else
- Writeln(StdErr,'Unknown name/value pair in target section : ',Line);
- end;
- procedure TMakeFileConverter.DoInstallLine(Line : String; Var IFL : TStrings);
- Var
- S,V,N,OS : String;
- P : Integer;
-
- begin
- SplitNameValue(Line,N,V);
- P:=Pos('_',N);
- If (P=0) then
- OS:='all'
- else
- begin
- OS:=N;
- Delete(OS,1,P);
- N:=Copy(N,1,P-1);
- end;
- If (N='fpcpackage') then
- P:=0 // temporary, needs fixing.
- else If (N='buildunit') then
- FBuildUnit:=V // temporary, needs fixing.
- else If (N='units') then
- begin
- S:=GetWord(V);
- While (S<>'') do
- begin
- AddStrings(IFL,S+'.o','',OS);
- AddStrings(IFL,S+'.ppu','',OS);
- S:=GetWord(V);
- end;
- end
- else
- Writeln(StdErr,'Unknown name/value pair in install section : ',N);
- end;
- procedure TMakeFileConverter.DoCleanLine(Line : String; Var CFL : TStrings);
- Var
- V,N,S,OS : String;
- P : Integer;
- begin
- SplitNameValue(Line,N,V);
- P:=Pos('_',N);
- If (P=0) then
- OS:='all'
- else
- begin
- OS:=N;
- Delete(OS,1,P);
- N:=Copy(N,1,P-1);
- end;
- If (N='fpcpackage') then
- P:=0 // temporary, needs fixing.
- else If (N='units') then
- begin
- S:=GetWord(V);
- While (S<>'') do
- begin
- AddStrings(CFL,S+'.o','',OS);
- AddStrings(CFL,S+'.ppu','',OS);
- S:=GetWord(V);
- end;
- end
- else
- Writeln(StdErr,'Unknown name/value pair in clean section : ',N);
- end;
- procedure TMakeFileConverter.DoRequireLine(Line : String);
- Var
- V,N,OS : String;
- P : Integer;
-
- begin
- SplitNameValue(Line,N,V);
- P:=Pos('_',N);
- If (P=0) then
- OS:='all'
- else
- begin
- OS:=N;
- Delete(OS,1,P);
- N:=Copy(N,1,P-1);
- end;
- if (N='packages') then
- FPackageDeps:=V
- else If (N='libc') and (Upcase(V)='Y') then
- P:=0 // Set options ?
- else
- Writeln(StdErr,'Unknown name/value pair in require section : ',N);
- end;
- procedure TMakeFileConverter.DoCompilerLine(Line : String;Var SD : TStrings);
- Var
- V,N,OS : String;
- P : Integer;
- begin
- SplitNameValue(Line,N,V);
- P:=Pos('_',N);
- If (P=0) then
- OS:='all'
- else
- begin
- OS:=N;
- Delete(OS,1,P);
- N:=Copy(N,1,P-1);
- end;
- If (N='includedir') then
- FPackageOptions:=Trim(FPackageOptions+' -Fi'+V)
- else If (N='options') then
- FPackageOptions:=Trim(FPackageOptions+' '+V)
- else If (N='targetdir') then
- P:=0 // Ignore
- else if (N='sourcedir') or (N='unitdir') then
- begin
- If (SD=Nil) then
- SD:=TStringList.Create;
- SD.Add(OS+'='+V);
- end
- else
- Writeln(StdErr,'Unknown name/value pair in compiler section : ',N);
- end;
- Function SearchInDirs(Prefix,AName, Dirs : String) : string;
- Var
- D,S : String;
- begin
- S:=GetWord(Dirs);
- Result:='';
- While (Result='') and (S<>'') do
- begin
- D:=Prefix+S+PathDelim;
- If FileExists(D+AName+'.pp') or FileExists(D+AName+'.pas') then
- Result:=S;
- S:=GetWord(Dirs);
- end;
- end;
- procedure TMakeFileConverter.DoTargets(Src,T,R,SD : TStrings; Dir,Prefix : String);
- Var
- I,J,P : Integer;
- Pre,N,V,D,DOS,OS,CPU : String;
- Res : Boolean;
-
- begin
- If (Dir<>'') then
- Dir:=IncludeTrailingPathDelimiter(Dir);
- If (Prefix<>'') then
- Prefix:=IncludeTrailingPathDelimiter(Prefix);
- Dir:=Prefix+Dir;
- Res:=False;
- If Assigned(T) then
- For I:=0 to T.Count-1 do
- begin
- T.GetNamevalue(I,N,V);
- P:=Pos('_',N);
- If (P<>0) then
- begin
- Pre:=Copy(N,1,P-1);
- Delete(N,1,P);
- end;
- If Assigned(R) then
- Res:=R.IndexOfName(N)<>-1;
- GetOSCPU(V,OS,CPU);
- Pre[1]:=Upcase(Pre[1]);
- Src.Add(' T:=Targets.Add'+Pre+'('''+Prefix+N+''');');
- If (CPU<>'') then
- Src.Add(' T.CPU:=['+CPU+'];');
- If (OS<>'') then
- Src.Add(' T.OS:=['+OS+'];');
- If res then
- Src.add(' T.ResourceStrings:=True;');
- If (CompareText(FBuildUnit,N)=0) then
- Src.add(' T.Install:=False;');
- if Assigned(SD) then
- for J:=0 to SD.Count-1 do
- begin
- SD.GetNameValue(J,DOS,D);
- If (DOS<>'all') then
- Src.Add(' if (Defaults.OS='+DOS+') then');
- Src.add(' T.Directory:='''+SearchInDirs(Dir,N,D)+''';');
- end;
- end;
- end;
- procedure TMakeFileConverter.WriteOSCPUCheck(Src: TStrings;OS,CPU : String);
- Var
- S : String;
- begin
- If (CPU<>'') then
- S:='(Defaults.CPU='+CPU+')';
- If (OS<>'') then
- begin
- IF (S<>'') then
- S:=S+' OR ';
- S:=S+'(Defaults.OS='+CPU+')';
- end;
- If (S<>'') then
- Src.Add(' If '+S+' then');
- end;
- procedure TMakeFileConverter.DoInstalls(Src,IFL : TStrings);
- Var
- I,J,P : Integer;
- Pre,N,V,D,DOS,OS,CPU : String;
- begin
- If Assigned(IFL) then
- For I:=0 to IFL.Count-1 do
- begin
- IFL.GetNamevalue(I,N,V);
- GetOSCPU(V,OS,CPU);
- WriteOSCPUCheck(Src,OS,CPU);
- Src.add(' InstallFiles.Add('''+N+''');');
- end;
- end;
- procedure TMakeFileConverter.DoCleans(Src,CFL : TStrings);
- Var
- I,J,P : Integer;
- N,V,DOS,OS,CPU : String;
- begin
- If Assigned(CFL) then
- For I:=0 to CFL.Count-1 do
- begin
- CFL.GetNamevalue(I,N,V);
- GetOSCPU(V,OS,CPU);
- WriteOSCPUCheck(Src,OS,CPU);
- Src.add(' CleanFiles.Add('''+N+''');');
- end;
- end;
- procedure TMakeFileConverter.ConvertFile(const AFileName: String; Src: TStrings; Dir,OS : String);
- Function IsSection(var S : String) : Boolean;
-
- Var
- L : Integer;
-
- begin
- L:=Length(S);
- Result:=(L>0) and (S[1]='[') and (S[L]=']');
- If Result then
- S:=trim(Copy(S,2,L-2));
- end;
- Var
- R,L,T,D,S,SD,IFL,CFL : TStrings;
- I,J : Integer;
- Prefix,Line,DN : String;
- B : Boolean;
-
- begin
- Writeln('Converting '+AFileName);
- T:=Nil;
- D:=Nil;
- S:=Nil;
- SD:=Nil;
- R:=Nil;
- IFL:=Nil;
- CFL:=Nil;
- FPackageOptions:='';
- FPackageDir:='';
- L:=TStringList.Create;
- try
- L.LoadFromFile(AFileName);
- I:=0;
- While (I<L.Count) do
- begin
- Line:=GetLine(L,I);
- If IsSection(Line) then
- begin
- J:=GetEnumValue(TypeInfo(TSectionType),'st'+Line);
- If (J=-1) then
- begin
- FSection:=stNone;
- Writeln(stdErr,'Unsupported section: ',Line);
- end
- else
- FSection:=TSectiontype(J);
- end
- else
- case FSection of
- stPackage : DoPackageLine(Line);
- stTarget : DoTargetLine(Line,T,R,D);
- stInstall : DoInstallLine(Line,IFL);
- stClean : DoCleanLine(Line,CFL);
- stCompiler : DoCompilerLine(Line,SD);
- strequire : DoRequireLine(Line);
- end;
- inc(I);
- end;
- // If there are only 'dir' entries, then there is no package name.
- B:=False;
- if (FPackageName<>'') then
- begin
- Prefix:='';
- B:=FPackageName<>'sub';
- If B then
- StartPackage(Src,Dir,OS)
- else
- Prefix:=Dir;
- DoTargets(Src,T,R,SD,Dir,Prefix);
- DoInstalls(Src,IFL);
- DoCleans(Src,CFL);
- end;
- If Assigned(D) then
- begin
- If (Dir<>'') then
- Dir:=IncludeTrailingPathDelimiter(Dir);
- For I:=0 to D.Count-1 do
- begin
- D.GetNameValue(I,DN,Line);
- If (Line<>'all') and (Line<>'') then
- OS:=Line;
- DN:=Dir+DN+PathDelim;
- If FileExists(DN+'Makefile.fpc') then
- ConvertFile(DN+'Makefile.fpc',Src,DN,OS);
- end;
- end;
- If B then
- EndPackage(Src,Dir,OS);
- Finally
- S.Free;
- IFL.Free;
- CFL.Free;
- D.Free;
- SD.Free;
- T.Free;
- L.Free;
- end;
- end;
- procedure TMakeFileConverter.ConvertFile(const Source, Dest: String);
- Var
- L : TStrings;
-
- begin
- L:=TStringList.Create;
- Try
- StartInstaller(L);
- ConvertFile(Source,L,'','');
- EndInstaller(L);
- L.SaveToFile(Dest);
- Finally
- L.Free;
- end;
- end;
- { TMakeTool }
- procedure TMakeTool.CompileFPMake(Extra: Boolean);
- Var
- O,C : String;
- begin
- C:=GetCompiler;
- O:=FFPmakeSrc;
- If Extra then
- O:='-Fafpmkext '+O;
- Log(SLogCompilingFPMake+C+' '+O);
- If ExecuteProcess(C,O)<>0 then
- Error(SErrFailedToCompileFPCMake)
- end;
- procedure TMakeTool.CreateFPMake;
- begin
- Log(SLogGeneratingFPMake);
- With TMakeFileConverter.Create do
- try
- ConvertFile('Makefile.fpc','fpmake.pp');
- finally
- Free;
- end;
- end;
- Function TMakeTool.RunFPMake : Integer;
- Function MaybeQuote(Const S : String) : String;
-
- begin
- If Pos(' ',S)=0 then
- Result:=S
- else
- Result:='"'+S+'"';
- end;
-
- Var
- I : integer;
- D,O : String;
- begin
- Log(SLogRunningFPMake);
- D:=IncludeTrailingPathDelimiter(GetCurrentDir);
- O:='';
- For I:=1 to ParamCount do
- begin
- If (O<>'') then
- O:=O+' ';
- O:=O+MaybeQuote(ParamStr(I));
- end;
- Result:=ExecuteProcess(D+FFPMakeBin,O);
- end;
- procedure TMakeTool.Log(Msg: String);
- begin
- If FLogging then
- Writeln(stdErr,Msg);
- end;
- procedure TMakeTool.Error(Msg: String);
- begin
- Raise EMakeToolError.Create(Msg);
- end;
- procedure TMakeTool.Error(Fmt: String; Args: array of const);
- begin
- Raise EMakeToolError.CreateFmt(Fmt,Args);
- end;
- function TMakeTool.GetCompiler: String;
- begin
- If (FCompiler='') then
- begin
- {$if defined(cpui386)}
- FCompiler:='ppc386';
- {$elseif defined(cpuAlpha)}
- FCompiler:='ppcaxp';
- {$elseif defined(cpusparc)}
- FCompiler:='ppcsparc';
- {$elseif defined(cpuarm)}
- FCompiler:='ppcarm';
- {$elseif defined(cpum68k)}
- FCompiler:='ppcm68k';
- {$elseif defined(cpux86_64)}
- FCompiler:='ppcx64';
- {$elseif defined(cpupowerpc)}
- FCompiler:='ppcppc';
- {$else}
- {$Fatal Unknown architecture}
- {$endif}
- end;
- If (ExtractFilePath(FCompiler)<>'') then
- Result:=FCompiler
- else
- begin
- Result:=FileSearch(FCompiler,GetEnvironmentVariable('PATH'));
- If (Result='') then
- Result:=FCompiler;
- end;
- end;
- procedure TMakeTool.ProcessCommandLine;
- Function CheckOption(Index : Integer;Short,Long : String): Boolean;
- var
- O : String;
- begin
- O:=Paramstr(Index);
- Result:=(O='-'+short) or (O='--'+long) or (copy(O,1,Length(Long)+3)=('--'+long+'='));
- end;
- Function OptionArg(Var Index : Integer) : String;
- Var
- P : Integer;
- begin
- if (Length(ParamStr(Index))>1) and (Paramstr(Index)[2]<>'-') then
- begin
- If Index<ParamCount then
- begin
- Inc(Index);
- Result:=Paramstr(Index);
- end
- else
- Error(SErrNeedArgument,[Index,ParamStr(Index)]);
- end
- else If length(ParamStr(Index))>2 then
- begin
- P:=Pos('=',Paramstr(Index));
- If (P=0) then
- Error(SErrNeedArgument,[Index,ParamStr(Index)])
- else
- begin
- Result:=Paramstr(Index);
- Delete(Result,1,P);
- end;
- end;
- end;
- Var
- I : Integer;
- begin
- I:=0;
- FLogging:=False;
- FRunMode:=rmhelp;
- FConvertOnly:=False;
- While (I<ParamCount) do
- begin
- Inc(I);
- if Checkoption(I,'n','convert') then
- FConvertOnly:=True
- else if Checkoption(I,'m','compile') then
- FRunMode:=rmCompile
- else if Checkoption(I,'b','build') then
- FRunMode:=rmBuild
- else if CheckOption(I,'i','install') then
- FRunMode:=rmInstall
- else if CheckOption(I,'c','clean') then
- FRunMode:=rmClean
- else if CheckOption(I,'a','archive') then
- FRunMode:=rmarchive
- else if CheckOption(I,'d','download') then
- FRunMode:=rmDownload
- else if CheckOption(I,'h','help') then
- FRunMode:=rmhelp
- // Check.
- else if CheckOption(I,'r','compiler') then
- FCompiler:=OptionArg(I)
- else if CheckOption(I,'v','verbose') then
- Flogging:=Pos('info',Lowercase(OptionArg(I)))<>0;
- end;
- end;
- procedure TMakeTool.Run;
- begin
- Try
- ProcessCommandLine;
- If FConvertOnly then
- CreateFPMake
- else
- begin
- FHaveMakefile:=FileExists('Makefile.fpc');
- FFPMakeSrc:='fpmake.pp';
- FHaveFpmake:=FileExists(FFPMakeSrc);
- If Not FHaveFPMake then
- begin
- FHaveFPMake:=FileExists('fpmake.pas');
- If FHaveFPMake then
- FFPMakeSrc:='fpmake.pas';
- end;
- if Not (FHaveFPMake or FHaveMakeFile) then
- Error(SErrMissingConfig);
- If (Not FHaveFPMake) or (FileAge(FFPMakeSrc)<FileAge('Makefile.fpc')) then
- CreateFPMake;
- {$ifndef unix}
- FFPMakeBin:='fpmake.exe';
- {$else}
- FFPMakeBin:='fpmake';
- {$endif}
- if FileAge(FFPMakeBin)<FileAge(FFPMakeSrc) then
- CompileFPMake(FRunMode in [rmArchive,rmDownload]);
- Halt(RunFPMake);
- end;
- except
- On E : Exception do
- begin
- Writeln(StdErr,Format(SErrRunning,[E.Message]));
- Halt(1);
- end;
- end;
- end;
- begin
- With TMakeTool.Create do
- try
- run;
- finally
- Free;
- end;
- end.
|