fppkg.pp 20 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963
  1. program fppkg;
  2. {$mode objfpc}{$H+}
  3. uses
  4. Classes, SysUtils, TypInfo
  5. { add your units here };
  6. Resourcestring
  7. // SErrInValidArgument = 'Invalid command-line argument at position %d : %s';
  8. SErrNeedArgument = 'Option at position %d (%s) needs an argument';
  9. SErrMissingConfig = 'Missing configuration Makefile.fpc or fpmake.pp';
  10. SErrRunning = 'The FPC make tool encountered the following error: %s';
  11. SErrFailedToCompileFPCMake = 'Could not compile fpmake driver program';
  12. SLogGeneratingFPMake = 'Generating fpmake.pp';
  13. SLogCompilingFPMake = 'Compiling fpmake.pp: ';
  14. SLogRunningFPMake = 'Running fpmake';
  15. Type
  16. TRunMode = (rmHelp,rmCompile,rmBuild,rmInstall,rmArchive,rmClean,rmDownload);
  17. { TMakeTool }
  18. TMakeTool = Class(TObject)
  19. Private
  20. FConvertOnly,
  21. FLogging : Boolean;
  22. FCompiler : String;
  23. FRunMode : TRunMode;
  24. FHaveMakefile : Boolean;
  25. FHaveFpmake : Boolean;
  26. FFPMakeSrc : String;
  27. FFPMakeBin : String;
  28. Procedure Log(Msg : String);
  29. Procedure Error(Msg : String);
  30. Procedure Error(Fmt : String; Args : Array of const);
  31. Function GetCompiler : String;
  32. Public
  33. Procedure ProcessCommandLine;
  34. procedure CreateFPMake;
  35. procedure CompileFPMake(Extra : Boolean);
  36. Function RunFPMake : Integer;
  37. Procedure Run;
  38. end;
  39. EMakeToolError = Class(Exception);
  40. { TMakeFileConverter }
  41. TSectionType = (stNone,stPackage,stTarget,stclean,stinstall,stCompiler,
  42. stDefault,stRequire,stRules,stPrerules);
  43. TMakeFileConverter = Class(TObject)
  44. FSection : TSectionType;
  45. FPackageName,
  46. FpackageDir,
  47. FPackageOptions,
  48. FPackageDeps,
  49. FBuilDUnit,
  50. FSubName,
  51. FPackageVersion : String;
  52. // Reading;
  53. procedure DoPackageLine(Const S : String);
  54. Procedure DoTargetLine(Line : String; Var T,R,D : TStrings);
  55. Procedure DoInstallLine(Line : String; Var IFL : TStrings);
  56. procedure DoCleanLine(Line : String; Var CFL : TStrings);
  57. procedure DoRequireLine(Line : String);
  58. procedure DoCompilerLine(Line : String;Var SD : TStrings);
  59. // Writing;
  60. procedure WriteOSCPUCheck(Src: TStrings;OS,CPU : String);
  61. procedure StartPackage(Src : TStrings; Dir,OS : String);
  62. procedure EndPackage(Src : TStrings; Dir,OS : String);
  63. procedure DoTargets(Src,T,R,SD : TStrings; Dir,Prefix : String);
  64. procedure DoCleans(Src,CFL : TStrings);
  65. procedure DoInstalls(Src,IFL : TStrings);
  66. Procedure StartInstaller(Src : TStrings);
  67. Procedure EndInstaller(Src : TStrings);
  68. Function GetLine (L : TStrings; Var I : Integer) : String;
  69. Public
  70. procedure ConvertFile(const AFileName: String; Src: TStrings; Dir,OS : String);
  71. Procedure ConvertFile(Const Source,Dest: String);
  72. end;
  73. { Auxiliary functions }
  74. Function GetWord(var S : String; Sep : Char) : String;
  75. Var
  76. L : Integer;
  77. begin
  78. L:=Pos(Sep,S);
  79. If (L=0) then
  80. L:=Length(S)+1;
  81. Result:=Copy(S,1,L-1);
  82. Delete(S,1,L);
  83. S:=Trim(S);
  84. end;
  85. Function GetWord(var S : String) : String;
  86. begin
  87. Result:=GetWord(S,' ');
  88. end;
  89. Function IsCPU (S: String) : Boolean;
  90. begin
  91. Result:=Pos(lowercase(S)+',','i386,powerpc,arm,alpha,sparc,')<>0
  92. end;
  93. Function GetOSCPU(L : String; var OS,CPU : String) : String;
  94. Procedure Add(Var A : String; ad : String);
  95. begin
  96. If (A<>'') then
  97. A:=A+',';
  98. A:=A+ad;
  99. end;
  100. Var
  101. S : String;
  102. begin
  103. OS:='';
  104. CPU:='';
  105. S:=GetWord(L,',');
  106. While (S<>'') do
  107. begin
  108. If (S<>'all') then
  109. If IsCPU(S) then
  110. Add(CPU,S)
  111. else
  112. Add(OS,S);
  113. S:=GetWord(L,',');
  114. end;
  115. end;
  116. { TMakeFileConverter }
  117. procedure TMakeFileConverter.StartInstaller(Src: TStrings);
  118. begin
  119. With Src do
  120. begin
  121. Add('{$mode objfpc}{$H+}');
  122. Add('program fpmake;');
  123. Add('');
  124. Add(' { Generated automatically by '+ExtractFileName(Paramstr(0))+' on '+DateToStr(Sysutils.Date)+' }');
  125. Add('');
  126. Add('uses fpmkunit;');
  127. Add('');
  128. Add('Var');
  129. Add(' T : TTarget;');
  130. Add('');
  131. Add('begin');
  132. Add(' With Installer do ');
  133. Add(' begin');
  134. end;
  135. end;
  136. procedure TMakeFileConverter.EndInstaller(Src: TStrings);
  137. begin
  138. With Src do
  139. begin
  140. Add(' Run;');
  141. Add(' end;');
  142. Add('end.');
  143. Add('');
  144. end;
  145. end;
  146. Function TMakeFileConverter.GetLine (L : TStrings; Var I : Integer) : String;
  147. Var
  148. P : Integer;
  149. OK : Boolean;
  150. begin
  151. OK:=False;
  152. Result:='';
  153. Repeat
  154. Result:=Result+L[i];
  155. P:=Pos('#',Result);
  156. If (P>0) then
  157. Result:=Copy(Result,1,P-1);
  158. Result:=Trim(Result);
  159. P:=Length(Result);
  160. If (P>0) and (Result[P]='\') then
  161. Result:=Copy(Result,1,P-1)
  162. else
  163. OK:=(Result<>'');
  164. if Not OK then
  165. Inc(I);
  166. Until OK or (I>L.Count-1);
  167. end;
  168. Function SplitNamevalue(Const S : String; Var AName,AValue : String) : boolean;
  169. var
  170. L : Integer;
  171. begin
  172. L:=Pos('=',S);
  173. Result:=(L<>0);
  174. If Result then
  175. begin
  176. AName:=LowerCase(trim(Copy(S,1,L-1)));
  177. AValue:=S;
  178. Delete(AValue,1,L);
  179. AValue:=Trim(Avalue);
  180. end
  181. else
  182. begin
  183. AName:='';
  184. AValue:='';
  185. end;
  186. end;
  187. procedure TMakeFileConverter.StartPackage(Src : TStrings; Dir,OS : String);
  188. Var
  189. S : String;
  190. begin
  191. With Src do
  192. begin
  193. Add(' { ');
  194. Add(' '+FPackageName);
  195. Add(' } ');
  196. Add(' StartPackage('''+FPackageName+''');');
  197. If (Dir<>'') then
  198. Add(' Directory:='''+ExcludeTrailingPathDelimiter(Dir)+''';');
  199. If (OS<>'') and (OS<>'all') then
  200. Add(' OS:=['+OS+'];');
  201. If (FPackageVersion<>'') then
  202. Add(' Version:='''+FPackageVersion+''';');
  203. If (FPackageOptions<>'') then
  204. Add(' Options:='''+FPackageOptions+''';');
  205. If (FPackageDeps<>'') then
  206. begin
  207. S:=GetWord(FPackageDeps);
  208. While S<>'' do
  209. begin
  210. Add(' Dependencies.Add('''+S+''');');
  211. S:=GetWord(FPackageDeps);
  212. end;
  213. end;
  214. end;
  215. end;
  216. procedure TMakeFileConverter.EndPackage(Src : TStrings; Dir,OS : String);
  217. begin
  218. Src.add(' EndPackage;');
  219. FPackageName:='';
  220. FPackageVersion:='';
  221. FPackageOptions:='';
  222. FBuilDUnit:='';
  223. FPackageDeps:='';
  224. end;
  225. procedure TMakeFileConverter.DoPackageLine(Const S : String);
  226. Var V,N : String;
  227. begin
  228. SplitNameValue(S,N,V);
  229. If (N='name') then
  230. FPackageName:=V
  231. else If (N='version') then
  232. FPackageVersion:=V
  233. else If (N='main') then
  234. begin
  235. FPackageName:='sub';
  236. FSubName:=V;
  237. end
  238. else
  239. Writeln(StdErr,'Unknown name/value pair in package section :',N);
  240. end;
  241. {
  242. Convert various entries of type
  243. XXYY_OSN=words
  244. to entries of type
  245. prefix_word=OS1,OS2,OS3
  246. OS is never empty, 'all' is default.
  247. }
  248. Procedure AddStrings(Var L : TStrings; Values,Prefix,OS : String) ;
  249. Var
  250. S,O : String;
  251. i : integer;
  252. begin
  253. If (L=Nil) then
  254. L:=TstringList.Create;
  255. If prefix<>'' then
  256. prefix:=prefix+'_';
  257. S:=GetWord(Values);
  258. While (S<>'') do
  259. begin
  260. S:=Prefix+S;
  261. I:=L.IndexOfName(S);
  262. If (I<>-1) then
  263. begin
  264. O:=L.Values[S];
  265. If (O='all') then
  266. O:='';
  267. If (O<>'') then
  268. O:=O+',';
  269. O:=O+OS;
  270. L.Values[S]:=O;
  271. end
  272. else
  273. L.Add(S+'='+OS);
  274. S:=GetWord(Values);
  275. end;
  276. end;
  277. procedure TMakeFileConverter.DoTargetLine(Line : String; Var T,R,D : TStrings);
  278. Var
  279. V,N,OS : String;
  280. P : Integer;
  281. begin
  282. SplitNameValue(Line,N,V);
  283. P:=Pos('_',N);
  284. If (P=0) then
  285. OS:='all'
  286. else
  287. begin
  288. OS:=N;
  289. Delete(OS,1,P);
  290. N:=Copy(N,1,P-1);
  291. end;
  292. If (N='dirs') then
  293. AddStrings(D,V,'',OS)
  294. else If (N='units') then
  295. AddStrings(T,V,'unit',OS)
  296. else If (N='implicitunits') then
  297. AddStrings(T,V,'unit',OS)
  298. else If (N='programs') then
  299. AddStrings(T,V,'program',OS)
  300. else If (N='examples') then
  301. AddStrings(T,V,'exampleunit',OS)
  302. else If (N='rsts') then
  303. AddStrings(R,V,'',OS)
  304. else
  305. Writeln(StdErr,'Unknown name/value pair in target section : ',Line);
  306. end;
  307. procedure TMakeFileConverter.DoInstallLine(Line : String; Var IFL : TStrings);
  308. Var
  309. S,V,N,OS : String;
  310. P : Integer;
  311. begin
  312. SplitNameValue(Line,N,V);
  313. P:=Pos('_',N);
  314. If (P=0) then
  315. OS:='all'
  316. else
  317. begin
  318. OS:=N;
  319. Delete(OS,1,P);
  320. N:=Copy(N,1,P-1);
  321. end;
  322. If (N='fpcpackage') then
  323. P:=0 // temporary, needs fixing.
  324. else If (N='buildunit') then
  325. FBuildUnit:=V // temporary, needs fixing.
  326. else If (N='units') then
  327. begin
  328. S:=GetWord(V);
  329. While (S<>'') do
  330. begin
  331. AddStrings(IFL,S+'.o','',OS);
  332. AddStrings(IFL,S+'.ppu','',OS);
  333. S:=GetWord(V);
  334. end;
  335. end
  336. else
  337. Writeln(StdErr,'Unknown name/value pair in install section : ',N);
  338. end;
  339. procedure TMakeFileConverter.DoCleanLine(Line : String; Var CFL : TStrings);
  340. Var
  341. V,N,S,OS : String;
  342. P : Integer;
  343. begin
  344. SplitNameValue(Line,N,V);
  345. P:=Pos('_',N);
  346. If (P=0) then
  347. OS:='all'
  348. else
  349. begin
  350. OS:=N;
  351. Delete(OS,1,P);
  352. N:=Copy(N,1,P-1);
  353. end;
  354. If (N='fpcpackage') then
  355. P:=0 // temporary, needs fixing.
  356. else If (N='units') then
  357. begin
  358. S:=GetWord(V);
  359. While (S<>'') do
  360. begin
  361. AddStrings(CFL,S+'.o','',OS);
  362. AddStrings(CFL,S+'.ppu','',OS);
  363. S:=GetWord(V);
  364. end;
  365. end
  366. else
  367. Writeln(StdErr,'Unknown name/value pair in clean section : ',N);
  368. end;
  369. procedure TMakeFileConverter.DoRequireLine(Line : String);
  370. Var
  371. V,N,OS : String;
  372. P : Integer;
  373. begin
  374. SplitNameValue(Line,N,V);
  375. P:=Pos('_',N);
  376. If (P=0) then
  377. OS:='all'
  378. else
  379. begin
  380. OS:=N;
  381. Delete(OS,1,P);
  382. N:=Copy(N,1,P-1);
  383. end;
  384. if (N='packages') then
  385. FPackageDeps:=V
  386. else If (N='libc') and (Upcase(V)='Y') then
  387. P:=0 // Set options ?
  388. else
  389. Writeln(StdErr,'Unknown name/value pair in require section : ',N);
  390. end;
  391. procedure TMakeFileConverter.DoCompilerLine(Line : String;Var SD : TStrings);
  392. Var
  393. V,N,OS : String;
  394. P : Integer;
  395. begin
  396. SplitNameValue(Line,N,V);
  397. P:=Pos('_',N);
  398. If (P=0) then
  399. OS:='all'
  400. else
  401. begin
  402. OS:=N;
  403. Delete(OS,1,P);
  404. N:=Copy(N,1,P-1);
  405. end;
  406. If (N='includedir') then
  407. FPackageOptions:=Trim(FPackageOptions+' -Fi'+V)
  408. else If (N='options') then
  409. FPackageOptions:=Trim(FPackageOptions+' '+V)
  410. else If (N='targetdir') then
  411. P:=0 // Ignore
  412. else if (N='sourcedir') or (N='unitdir') then
  413. begin
  414. If (SD=Nil) then
  415. SD:=TStringList.Create;
  416. SD.Add(OS+'='+V);
  417. end
  418. else
  419. Writeln(StdErr,'Unknown name/value pair in compiler section : ',N);
  420. end;
  421. Function SearchInDirs(Prefix,AName, Dirs : String) : string;
  422. Var
  423. D,S : String;
  424. begin
  425. S:=GetWord(Dirs);
  426. Result:='';
  427. While (Result='') and (S<>'') do
  428. begin
  429. D:=Prefix+S+PathDelim;
  430. If FileExists(D+AName+'.pp') or FileExists(D+AName+'.pas') then
  431. Result:=S;
  432. S:=GetWord(Dirs);
  433. end;
  434. end;
  435. procedure TMakeFileConverter.DoTargets(Src,T,R,SD : TStrings; Dir,Prefix : String);
  436. Var
  437. I,J,P : Integer;
  438. Pre,N,V,D,DOS,OS,CPU : String;
  439. Res : Boolean;
  440. begin
  441. If (Dir<>'') then
  442. Dir:=IncludeTrailingPathDelimiter(Dir);
  443. If (Prefix<>'') then
  444. Prefix:=IncludeTrailingPathDelimiter(Prefix);
  445. Dir:=Prefix+Dir;
  446. Res:=False;
  447. If Assigned(T) then
  448. For I:=0 to T.Count-1 do
  449. begin
  450. T.GetNamevalue(I,N,V);
  451. P:=Pos('_',N);
  452. If (P<>0) then
  453. begin
  454. Pre:=Copy(N,1,P-1);
  455. Delete(N,1,P);
  456. end;
  457. If Assigned(R) then
  458. Res:=R.IndexOfName(N)<>-1;
  459. GetOSCPU(V,OS,CPU);
  460. Pre[1]:=Upcase(Pre[1]);
  461. Src.Add(' T:=Targets.Add'+Pre+'('''+Prefix+N+''');');
  462. If (CPU<>'') then
  463. Src.Add(' T.CPU:=['+CPU+'];');
  464. If (OS<>'') then
  465. Src.Add(' T.OS:=['+OS+'];');
  466. If res then
  467. Src.add(' T.ResourceStrings:=True;');
  468. If (CompareText(FBuildUnit,N)=0) then
  469. Src.add(' T.Install:=False;');
  470. if Assigned(SD) then
  471. for J:=0 to SD.Count-1 do
  472. begin
  473. SD.GetNameValue(J,DOS,D);
  474. If (DOS<>'all') then
  475. Src.Add(' if (Defaults.OS='+DOS+') then');
  476. Src.add(' T.Directory:='''+SearchInDirs(Dir,N,D)+''';');
  477. end;
  478. end;
  479. end;
  480. procedure TMakeFileConverter.WriteOSCPUCheck(Src: TStrings;OS,CPU : String);
  481. Var
  482. S : String;
  483. begin
  484. If (CPU<>'') then
  485. S:='(Defaults.CPU='+CPU+')';
  486. If (OS<>'') then
  487. begin
  488. IF (S<>'') then
  489. S:=S+' OR ';
  490. S:=S+'(Defaults.OS='+CPU+')';
  491. end;
  492. If (S<>'') then
  493. Src.Add(' If '+S+' then');
  494. end;
  495. procedure TMakeFileConverter.DoInstalls(Src,IFL : TStrings);
  496. Var
  497. I,J,P : Integer;
  498. Pre,N,V,D,DOS,OS,CPU : String;
  499. begin
  500. If Assigned(IFL) then
  501. For I:=0 to IFL.Count-1 do
  502. begin
  503. IFL.GetNamevalue(I,N,V);
  504. GetOSCPU(V,OS,CPU);
  505. WriteOSCPUCheck(Src,OS,CPU);
  506. Src.add(' InstallFiles.Add('''+N+''');');
  507. end;
  508. end;
  509. procedure TMakeFileConverter.DoCleans(Src,CFL : TStrings);
  510. Var
  511. I,J,P : Integer;
  512. N,V,DOS,OS,CPU : String;
  513. begin
  514. If Assigned(CFL) then
  515. For I:=0 to CFL.Count-1 do
  516. begin
  517. CFL.GetNamevalue(I,N,V);
  518. GetOSCPU(V,OS,CPU);
  519. WriteOSCPUCheck(Src,OS,CPU);
  520. Src.add(' CleanFiles.Add('''+N+''');');
  521. end;
  522. end;
  523. procedure TMakeFileConverter.ConvertFile(const AFileName: String; Src: TStrings; Dir,OS : String);
  524. Function IsSection(var S : String) : Boolean;
  525. Var
  526. L : Integer;
  527. begin
  528. L:=Length(S);
  529. Result:=(L>0) and (S[1]='[') and (S[L]=']');
  530. If Result then
  531. S:=trim(Copy(S,2,L-2));
  532. end;
  533. Var
  534. R,L,T,D,S,SD,IFL,CFL : TStrings;
  535. I,J : Integer;
  536. Prefix,Line,DN : String;
  537. B : Boolean;
  538. begin
  539. Writeln('Converting '+AFileName);
  540. T:=Nil;
  541. D:=Nil;
  542. S:=Nil;
  543. SD:=Nil;
  544. R:=Nil;
  545. IFL:=Nil;
  546. CFL:=Nil;
  547. FPackageOptions:='';
  548. FPackageDir:='';
  549. L:=TStringList.Create;
  550. try
  551. L.LoadFromFile(AFileName);
  552. I:=0;
  553. While (I<L.Count) do
  554. begin
  555. Line:=GetLine(L,I);
  556. If IsSection(Line) then
  557. begin
  558. J:=GetEnumValue(TypeInfo(TSectionType),'st'+Line);
  559. If (J=-1) then
  560. begin
  561. FSection:=stNone;
  562. Writeln(stdErr,'Unsupported section: ',Line);
  563. end
  564. else
  565. FSection:=TSectiontype(J);
  566. end
  567. else
  568. case FSection of
  569. stPackage : DoPackageLine(Line);
  570. stTarget : DoTargetLine(Line,T,R,D);
  571. stInstall : DoInstallLine(Line,IFL);
  572. stClean : DoCleanLine(Line,CFL);
  573. stCompiler : DoCompilerLine(Line,SD);
  574. strequire : DoRequireLine(Line);
  575. end;
  576. inc(I);
  577. end;
  578. // If there are only 'dir' entries, then there is no package name.
  579. B:=False;
  580. if (FPackageName<>'') then
  581. begin
  582. Prefix:='';
  583. B:=FPackageName<>'sub';
  584. If B then
  585. StartPackage(Src,Dir,OS)
  586. else
  587. Prefix:=Dir;
  588. DoTargets(Src,T,R,SD,Dir,Prefix);
  589. DoInstalls(Src,IFL);
  590. DoCleans(Src,CFL);
  591. end;
  592. If Assigned(D) then
  593. begin
  594. If (Dir<>'') then
  595. Dir:=IncludeTrailingPathDelimiter(Dir);
  596. For I:=0 to D.Count-1 do
  597. begin
  598. D.GetNameValue(I,DN,Line);
  599. If (Line<>'all') and (Line<>'') then
  600. OS:=Line;
  601. DN:=Dir+DN+PathDelim;
  602. If FileExists(DN+'Makefile.fpc') then
  603. ConvertFile(DN+'Makefile.fpc',Src,DN,OS);
  604. end;
  605. end;
  606. If B then
  607. EndPackage(Src,Dir,OS);
  608. Finally
  609. S.Free;
  610. IFL.Free;
  611. CFL.Free;
  612. D.Free;
  613. SD.Free;
  614. T.Free;
  615. L.Free;
  616. end;
  617. end;
  618. procedure TMakeFileConverter.ConvertFile(const Source, Dest: String);
  619. Var
  620. L : TStrings;
  621. begin
  622. L:=TStringList.Create;
  623. Try
  624. StartInstaller(L);
  625. ConvertFile(Source,L,'','');
  626. EndInstaller(L);
  627. L.SaveToFile(Dest);
  628. Finally
  629. L.Free;
  630. end;
  631. end;
  632. { TMakeTool }
  633. procedure TMakeTool.CompileFPMake(Extra: Boolean);
  634. Var
  635. O,C : String;
  636. begin
  637. C:=GetCompiler;
  638. O:=FFPmakeSrc;
  639. If Extra then
  640. O:='-Fafpmkext '+O;
  641. Log(SLogCompilingFPMake+C+' '+O);
  642. If ExecuteProcess(C,O)<>0 then
  643. Error(SErrFailedToCompileFPCMake)
  644. end;
  645. procedure TMakeTool.CreateFPMake;
  646. begin
  647. Log(SLogGeneratingFPMake);
  648. With TMakeFileConverter.Create do
  649. try
  650. ConvertFile('Makefile.fpc','fpmake.pp');
  651. finally
  652. Free;
  653. end;
  654. end;
  655. Function TMakeTool.RunFPMake : Integer;
  656. Function MaybeQuote(Const S : String) : String;
  657. begin
  658. If Pos(' ',S)=0 then
  659. Result:=S
  660. else
  661. Result:='"'+S+'"';
  662. end;
  663. Var
  664. I : integer;
  665. D,O : String;
  666. begin
  667. Log(SLogRunningFPMake);
  668. D:=IncludeTrailingPathDelimiter(GetCurrentDir);
  669. O:='';
  670. For I:=1 to ParamCount do
  671. begin
  672. If (O<>'') then
  673. O:=O+' ';
  674. O:=O+MaybeQuote(ParamStr(I));
  675. end;
  676. Result:=ExecuteProcess(D+FFPMakeBin,O);
  677. end;
  678. procedure TMakeTool.Log(Msg: String);
  679. begin
  680. If FLogging then
  681. Writeln(stdErr,Msg);
  682. end;
  683. procedure TMakeTool.Error(Msg: String);
  684. begin
  685. Raise EMakeToolError.Create(Msg);
  686. end;
  687. procedure TMakeTool.Error(Fmt: String; Args: array of const);
  688. begin
  689. Raise EMakeToolError.CreateFmt(Fmt,Args);
  690. end;
  691. function TMakeTool.GetCompiler: String;
  692. begin
  693. If (FCompiler='') then
  694. begin
  695. {$if defined(cpui386)}
  696. FCompiler:='ppc386';
  697. {$elseif defined(cpuAlpha)}
  698. FCompiler:='ppcaxp';
  699. {$elseif defined(cpusparc)}
  700. FCompiler:='ppcsparc';
  701. {$elseif defined(cpuarm)}
  702. FCompiler:='ppcarm';
  703. {$elseif defined(cpum68k)}
  704. FCompiler:='ppcm68k';
  705. {$elseif defined(cpux86_64)}
  706. FCompiler:='ppcx64';
  707. {$elseif defined(cpupowerpc)}
  708. FCompiler:='ppcppc';
  709. {$else}
  710. {$Fatal Unknown architecture}
  711. {$endif}
  712. end;
  713. If (ExtractFilePath(FCompiler)<>'') then
  714. Result:=FCompiler
  715. else
  716. begin
  717. Result:=FileSearch(FCompiler,GetEnvironmentVariable('PATH'));
  718. If (Result='') then
  719. Result:=FCompiler;
  720. end;
  721. end;
  722. procedure TMakeTool.ProcessCommandLine;
  723. Function CheckOption(Index : Integer;Short,Long : String): Boolean;
  724. var
  725. O : String;
  726. begin
  727. O:=Paramstr(Index);
  728. Result:=(O='-'+short) or (O='--'+long) or (copy(O,1,Length(Long)+3)=('--'+long+'='));
  729. end;
  730. Function OptionArg(Var Index : Integer) : String;
  731. Var
  732. P : Integer;
  733. begin
  734. if (Length(ParamStr(Index))>1) and (Paramstr(Index)[2]<>'-') then
  735. begin
  736. If Index<ParamCount then
  737. begin
  738. Inc(Index);
  739. Result:=Paramstr(Index);
  740. end
  741. else
  742. Error(SErrNeedArgument,[Index,ParamStr(Index)]);
  743. end
  744. else If length(ParamStr(Index))>2 then
  745. begin
  746. P:=Pos('=',Paramstr(Index));
  747. If (P=0) then
  748. Error(SErrNeedArgument,[Index,ParamStr(Index)])
  749. else
  750. begin
  751. Result:=Paramstr(Index);
  752. Delete(Result,1,P);
  753. end;
  754. end;
  755. end;
  756. Var
  757. I : Integer;
  758. begin
  759. I:=0;
  760. FLogging:=False;
  761. FRunMode:=rmhelp;
  762. FConvertOnly:=False;
  763. While (I<ParamCount) do
  764. begin
  765. Inc(I);
  766. if Checkoption(I,'n','convert') then
  767. FConvertOnly:=True
  768. else if Checkoption(I,'m','compile') then
  769. FRunMode:=rmCompile
  770. else if Checkoption(I,'b','build') then
  771. FRunMode:=rmBuild
  772. else if CheckOption(I,'i','install') then
  773. FRunMode:=rmInstall
  774. else if CheckOption(I,'c','clean') then
  775. FRunMode:=rmClean
  776. else if CheckOption(I,'a','archive') then
  777. FRunMode:=rmarchive
  778. else if CheckOption(I,'d','download') then
  779. FRunMode:=rmDownload
  780. else if CheckOption(I,'h','help') then
  781. FRunMode:=rmhelp
  782. // Check.
  783. else if CheckOption(I,'r','compiler') then
  784. FCompiler:=OptionArg(I)
  785. else if CheckOption(I,'v','verbose') then
  786. Flogging:=Pos('info',Lowercase(OptionArg(I)))<>0;
  787. end;
  788. end;
  789. procedure TMakeTool.Run;
  790. begin
  791. Try
  792. ProcessCommandLine;
  793. If FConvertOnly then
  794. CreateFPMake
  795. else
  796. begin
  797. FHaveMakefile:=FileExists('Makefile.fpc');
  798. FFPMakeSrc:='fpmake.pp';
  799. FHaveFpmake:=FileExists(FFPMakeSrc);
  800. If Not FHaveFPMake then
  801. begin
  802. FHaveFPMake:=FileExists('fpmake.pas');
  803. If FHaveFPMake then
  804. FFPMakeSrc:='fpmake.pas';
  805. end;
  806. if Not (FHaveFPMake or FHaveMakeFile) then
  807. Error(SErrMissingConfig);
  808. If (Not FHaveFPMake) or (FileAge(FFPMakeSrc)<FileAge('Makefile.fpc')) then
  809. CreateFPMake;
  810. {$ifndef unix}
  811. FFPMakeBin:='fpmake.exe';
  812. {$else}
  813. FFPMakeBin:='fpmake';
  814. {$endif}
  815. if FileAge(FFPMakeBin)<FileAge(FFPMakeSrc) then
  816. CompileFPMake(FRunMode in [rmArchive,rmDownload]);
  817. Halt(RunFPMake);
  818. end;
  819. except
  820. On E : Exception do
  821. begin
  822. Writeln(StdErr,Format(SErrRunning,[E.Message]));
  823. Halt(1);
  824. end;
  825. end;
  826. end;
  827. begin
  828. With TMakeTool.Create do
  829. try
  830. run;
  831. finally
  832. Free;
  833. end;
  834. end.