fpmkunit.pp 88 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392
  1. {$Mode objfpc}
  2. {$H+}
  3. {$define debug}
  4. unit fpmkunit;
  5. Interface
  6. uses SysUtils,Classes;
  7. Type
  8. TFileType = (ftSource,ftUnit,ftObject,ftResource,ftExecutable,ftStaticLibrary,
  9. ftSharedLibrary);
  10. TFileTypes = set of TFileType;
  11. TOS = (Amiga,Atari,Darwin,FreeBSD,Go32v2,Linux,MacOS,MorphOS,NetBSD,
  12. Netware,NetwLibc,OpenBSD,OS2,PalmOS,Solaris,Win32,wince,Emx);
  13. TOSes = Set of TOS;
  14. TCPU = (Arm,I386,PPC,SPARC,X86_64,m68k);
  15. TCPUS = Set of TCPU;
  16. TCompilerMode = (FPC,TP,ObjFPC,Delphi,MacPas);
  17. TCompilerModes = Set of TCompilerMode;
  18. TTargetType = (ttUnit,ttProgram,ttExampleUnit,ttExampleProgram);
  19. TTargetTypes = set of TTargetType;
  20. TTargetState = (tsNeutral,tsCompiling,tsCompiled,tsInstalled);
  21. TTargetStates = Set of TTargetState;
  22. TRunMode = (rmHelp,rmCompile,rmBuild,rmInstall,rmArchive,rmClean,rmDownload);
  23. TVerboseLevel = (vlError,vlWarning,vlInfo,vlCompare,vlCommand,vldebug);
  24. TVerboseLevels = Set of TVerboseLevel;
  25. TLogEvent = Procedure (Level : TVerboseLevel; Const Msg : String) of Object;
  26. { TNamedItem }
  27. TNamedItem = Class(TCollectionItem)
  28. private
  29. FName: String;
  30. procedure SetName(const AValue: String);virtual;
  31. Public
  32. property Name : String Read FName Write SetName;
  33. end;
  34. { TNamedCollection }
  35. TNamedCollection = Class(TCollection)
  36. private
  37. FUniqueNames: Boolean;
  38. Public
  39. Function IndexOfName(AName : String) : Integer;
  40. Function ItemByName(AName : String) : TNamedItem;
  41. Property UniqueNames : Boolean Read FUniqueNames;
  42. end;
  43. { TNamedItemList }
  44. TNamedItemList = Class(TList)
  45. private
  46. function GetNamedItem(Index : Integer): TNamedItem;
  47. procedure SetNamedItem(Index : Integer; const AValue: TNamedItem);
  48. public
  49. Function IndexOfName(AName : String) : Integer;
  50. Function ItemByName(ANAme : String) : TNamedItem;
  51. Property NamedItems[Index : Integer] : TNamedItem Read GetNamedItem Write SetNamedItem; default;
  52. end;
  53. TCommandAt = (caBeforeCompile,caAfterCompile,
  54. caBeforeInstall,caAfterInstall,
  55. caBeforeArchive,caAfterArchive,
  56. caBeforeClean,caAfterClean,
  57. caBeforeDownload,caAfterDownload);
  58. { TCommand }
  59. TCommand = Class(TNamedItem)
  60. private
  61. FAfterCommand: TNotifyEvent;
  62. FBeforeCommand: TNotifyEvent;
  63. FCommand: String;
  64. FCommandAt: TCommandAt;
  65. FDestFile: String;
  66. FIgnoreResult: Boolean;
  67. FOptions: String;
  68. FSourceFile: String;
  69. Public
  70. Property SourceFile : String Read FSourceFile Write FSourceFile;
  71. Property DestFile : String Read FDestFile Write FDestFile;
  72. Property Command : String Read FCommand Write FCommand;
  73. Property Options : String Read FOptions Write FOptions;
  74. Property At : TCommandAt Read FCommandAt Write FCommandAt;
  75. Property IgnoreResult : Boolean Read FIgnoreResult Write FIgnoreResult;
  76. Property BeforeCommand : TNotifyEvent Read FBeforeCommand Write FBeforeCommand;
  77. Property AfterCommand : TNotifyEvent Read FAfterCommand Write FAfterCommand;
  78. end;
  79. { TCommands }
  80. TCommands = Class(TNamedCollection)
  81. private
  82. FDefaultAt: TCommandAt;
  83. function GetCommand(Dest : String): TCommand;
  84. function GetCommandItem(Index : Integer): TCommand;
  85. procedure SetCommandItem(Index : Integer; const AValue: TCommand);
  86. Public
  87. Function AddCommand(Const Cmd : String) : TCommand;
  88. Function AddCommand(Const Cmd,Options : String) : TCommand;
  89. Function AddCommand(Const Cmd,Options,Dest,Source : String) : TCommand;
  90. Function AddCommand(At : TCommandAt; Const Cmd : String) : TCommand;
  91. Function AddCommand(At : TCommandAt; Const Cmd,Options : String) : TCommand;
  92. Function AddCommand(At : TCommandAt; Const Cmd,Options, Dest,Source : String) : TCommand;
  93. Property CommandItems[Index : Integer] : TCommand Read GetCommandItem Write SetCommandItem;
  94. Property Commands[Dest : String] : TCommand Read GetCommand; default;
  95. Property DefaultAt : TCommandAt Read FDefaultAt Write FDefaultAt;
  96. end;
  97. { TTarget }
  98. TTarget = Class(TNamedItem)
  99. private
  100. FInstall : Boolean;
  101. FAfterClean: TNotifyEvent;
  102. FAfterCompile: TNotifyEvent;
  103. FBeforeClean: TNotifyEvent;
  104. FBeforeCompile: TNotifyEvent;
  105. FCPUs: TCPUs;
  106. FMode: TCompilerMode;
  107. FResourceStrings: Boolean;
  108. FObjectPath,
  109. FUnitPath,
  110. FIncludePath,
  111. FDependencies: TStrings;
  112. FCommands : TCommands;
  113. FDirectory: String;
  114. FExtension: String;
  115. FFileType: TFileType;
  116. FOptions: String;
  117. FOSes: TOSes;
  118. FFPCTarget: String;
  119. FTargetState: TTargetState;
  120. FTargetType: TTargetType;
  121. function GetCommands: TCommands;
  122. function GetHasCommands: Boolean;
  123. function GetHasStrings(AIndex: integer): Boolean;
  124. function GetStrings(AIndex: integer): TStrings;
  125. procedure SetCommands(const AValue: TCommands);
  126. procedure SetStrings(AIndex: integer; const AValue: TStrings);
  127. Protected
  128. Function GetSourceFileName : String; virtual;
  129. Function GetUnitFileName : String; virtual;
  130. Function GetObjectFileName : String; virtual;
  131. Function GetRSTFileName : String; Virtual;
  132. Function GetProgramFileName(AnOS : TOS) : String; Virtual;
  133. Public
  134. Constructor Create(ACollection : TCollection); override;
  135. Destructor Destroy; override;
  136. Function GetOutputFileName (AOs : TOS) : String; Virtual;
  137. procedure SetName(const AValue: String);override;
  138. Procedure GetCleanFiles(List : TStrings; APrefix : String; AnOS : TOS); virtual;
  139. Procedure GetInstallFiles(List : TStrings; APrefix : String; AnOS : TOS); virtual;
  140. Procedure GetArchiveFiles(List : TStrings; APrefix : String; AnOS : TOS); virtual;
  141. Property HasUnitPath : Boolean Index 0 Read GetHasStrings;
  142. Property HasObjectPath : Boolean Index 1 Read GetHasStrings;
  143. Property HasIncludePath : Boolean Index 2 Read GetHasStrings;
  144. Property HasDependencies : Boolean Index 3 Read GetHasStrings;
  145. Property HasCommands : Boolean Read GetHasCommands;
  146. Property UnitPath : TStrings Index 0 Read GetStrings Write SetStrings;
  147. Property ObjectPath : TStrings Index 1 Read GetStrings Write SetStrings;
  148. Property IncludePath : TStrings Index 2 Read GetStrings Write SetStrings;
  149. Property Dependencies : TStrings Index 3 Read GetStrings Write SetStrings;
  150. Property Commands : TCommands Read GetCommands Write SetCommands;
  151. Property State : TTargetState Read FTargetState;
  152. Property TargetType : TTargetType Read FTargetType Write FTargetType;
  153. Property OS : TOSes Read FOSes Write FOSes;
  154. Property Mode : TCompilerMode Read FMode Write FMode;
  155. Property Options : String Read FOptions Write Foptions;
  156. Property SourceFileName: String Read GetSourceFileName ;
  157. Property UnitFileName : String Read GetUnitFileName;
  158. Property ObjectFileName : String Read GetObjectFileName;
  159. Property RSTFileName : String Read GetRSTFileName;
  160. Property CPU : TCPUs Read FCPUs Write FCPUs;
  161. Property FPCTarget : String Read FFPCTarget Write FFPCTarget;
  162. Property Extension : String Read FExtension Write FExtension;
  163. Property FileType : TFileType Read FFileType Write FFileType;
  164. Property Directory : String Read FDirectory Write FDirectory;
  165. Property ResourceStrings : Boolean Read FResourceStrings Write FResourceStrings;
  166. Property Install : Boolean Read FInstall Write FInstall;
  167. // Events.
  168. Property BeforeCompile : TNotifyEvent Read FBeforeCompile Write FBeforeCompile;
  169. Property AfterCompile : TNotifyEvent Read FAfterCompile Write FAfterCompile;
  170. Property BeforeClean : TNotifyEvent Read FBeforeClean Write FBeforeClean;
  171. Property AfterClean : TNotifyEvent Read FAfterClean Write FAfterClean;
  172. end;
  173. { TTargets }
  174. TTargets = Class(TNamedCollection)
  175. private
  176. FDefaultCPU: TCPUs;
  177. FDefaultDir : String;
  178. FDefaultOS: TOSes;
  179. function GetTargetItem(Index : Integer): TTarget;
  180. function GetTarget(AName : String): TTarget;
  181. procedure SetDefaultDir(const AValue: String);
  182. procedure SetTargetItem(Index : Integer; const AValue: TTarget);
  183. Procedure ApplyDefaults(ATarget : TTarget);
  184. Public
  185. Procedure ResetDefaults;
  186. Function AddUnit(AUnitName : String) : TTarget;
  187. Function AddProgram(AProgramName : String) : TTarget;
  188. Function AddExampleUnit(AUnitName : String) : TTarget;
  189. Function AddExampleProgram(AProgramName : String) : TTarget;
  190. Property Targets[AName : String] : TTarget Read GetTarget; default;
  191. Property TargetItems[Index : Integer] : TTarget Read GetTargetItem Write SetTargetItem;
  192. Property DefaultDir : String Read FDefaultDir Write SetDefaultDir;
  193. Property DefaultOS : TOSes Read FDefaultOS Write FDefaultOS;
  194. Property DefaultCPU : TCPUs Read FDefaultCPU Write FDefaultCPU;
  195. end;
  196. { TPackage }
  197. TPackage = Class(TNamedItem) // Maybe descend from/use TTarget ?
  198. private
  199. FAfterArchive: TNotifyEvent;
  200. FAfterClean: TNotifyEvent;
  201. FAfterCompile: TNotifyEvent;
  202. FAfterDownload: TNotifyEvent;
  203. FAfterInstall: TNotifyEvent;
  204. FBeforeArchive: TNotifyEvent;
  205. FBeforeClean: TNotifyEvent;
  206. FBeforeCompile: TNotifyEvent;
  207. FBeforeDownload: TNotifyEvent;
  208. FBeforeInstall: TNotifyEvent;
  209. FUnitPath,
  210. FObjectPath,
  211. FIncludePath,
  212. FCleanFiles,
  213. FArchiveFiles,
  214. FInstallFiles,
  215. FDependencies: TStrings;
  216. FCPU: TCPUs;
  217. FOS: TOses;
  218. FTargetState: TTargetState;
  219. FTargets: TTargets;
  220. FDirectory: String;
  221. FOptions: String;
  222. FAuthor: String;
  223. FLicense: String;
  224. FURL: String;
  225. FVersion: String;
  226. FCommands : TCommands;
  227. function GetCommands: TCommands;
  228. function GetHasCommands: Boolean;
  229. function GetHasStrings(AIndex: integer): Boolean;
  230. function GetStrings(AIndex: integer): TStrings;
  231. procedure SetCommands(const AValue: TCommands);
  232. procedure SetStrings(AIndex: integer; const AValue: TStrings);
  233. Public
  234. constructor Create(ACollection: TCollection); override;
  235. destructor destroy; override;
  236. Function AddTarget(AName : String) : TTarget;
  237. Procedure AddDependency(AName : String);
  238. Procedure AddInstallFile(AFileName : String);
  239. Procedure GetCleanFiles(List : TStrings; Const APrefix : String; AOS : TOS); virtual;
  240. procedure GetInstallFiles(List: TStrings;Types : TTargetTypes;Const APrefix : String; AOS : TOS);
  241. Procedure GetArchiveFiles(List : TStrings; Const APrefix : String; AOS : TOS); virtual;
  242. Property Version : String Read FVersion Write FVersion;
  243. Property URL : String Read FURL Write FURL;
  244. Property Author : String Read FAuthor Write FAuthor;
  245. Property License : String Read FLicense Write FLicense;
  246. Property Directory : String Read FDirectory Write FDirectory;
  247. // Compiler options.
  248. Property OS : TOses Read FOS Write FOS;
  249. Property CPU : TCPUs Read FCPU Write FCPU;
  250. Property Options: String Read FOptions Write FOptions;
  251. Property HasUnitPath : Boolean Index 0 Read GetHasStrings;
  252. Property HasObjectPath : Boolean Index 1 Read GetHasStrings;
  253. Property HasIncludePath : Boolean Index 2 Read GetHasStrings;
  254. Property HasDependencies : Boolean Index 3 Read GetHasStrings;
  255. Property HasInstallFiles: Boolean Index 4 Read GetHasStrings;
  256. Property HasCleanFiles : Boolean Index 5 Read GetHasStrings;
  257. Property HasArchiveFiles : Boolean Index 6 Read GetHasStrings;
  258. Property HasCommands : Boolean Read GetHasCommands;
  259. Property UnitPath : TStrings Index 0 Read GetStrings Write SetStrings;
  260. Property ObjectPath : TStrings Index 1 Read GetStrings Write SetStrings;
  261. Property IncludePath : TStrings Index 2 Read GetStrings Write SetStrings;
  262. // Targets and dependencies
  263. Property Dependencies : TStrings Index 3 Read GetStrings Write SetStrings;
  264. Property InstallFiles : TStrings Index 4 Read GetStrings Write SetStrings;
  265. Property CleanFiles : TStrings Index 5 Read GetStrings Write SetStrings;
  266. Property ArchiveFiles : TStrings Index 6 Read GetStrings Write SetStrings;
  267. Property Commands : TCommands Read GetCommands Write SetCommands;
  268. Property State : TTargetState Read FTargetState;
  269. Property Targets : TTargets Read FTargets;
  270. // events
  271. Property BeforeCompile : TNotifyEvent Read FBeforeCompile Write FBeforeCompile;
  272. Property AfterCompile : TNotifyEvent Read FAfterCompile Write FAfterCompile;
  273. Property BeforeInstall : TNotifyEvent Read FBeforeInstall Write FBeforeInstall;
  274. Property AfterInstall : TNotifyEvent Read FAfterInstall Write FAfterInstall;
  275. Property BeforeClean : TNotifyEvent Read FBeforeClean Write FBeforeClean;
  276. Property AfterClean : TNotifyEvent Read FAfterClean Write FAfterClean;
  277. Property BeforeArchive : TNotifyEvent Read FBeforeArchive Write FBeforeArchive;
  278. Property AfterArchive : TNotifyEvent Read FAfterArchive Write FAfterArchive;
  279. Property BeforeDownload : TNotifyEvent Read FBeforeDownload Write FBeforeDownload;
  280. Property AfterDownload : TNotifyEvent Read FAfterDownload Write FAfterDownload;
  281. end;
  282. { TPackages }
  283. TPackages = Class(TNamedCollection)
  284. private
  285. function GetPackage(AName : String): TPackage;
  286. function GetPackageItem(AIndex : Integer): TPackage;
  287. procedure SetPackageItem(AIndex : Integer; const AValue: TPackage);
  288. Public
  289. Function AddPackage(Const AName : String) : TPackage;
  290. Property Packages[AName : String] : TPackage Read GetPackage ; Default;
  291. Property PackageItems[AIndex : Integer] : TPackage Read GetPackageItem Write SetPackageItem;
  292. end;
  293. { TDefaults }
  294. TDefaults = Class(TPersistent)
  295. Private
  296. FArchive: String;
  297. FCompiler: String;
  298. FCopy: String;
  299. FDownload: String;
  300. FMkDir: String;
  301. FMove: String;
  302. FOptions: String;
  303. FCPU: TCPU;
  304. FOS: TOS;
  305. FMode : TCompilerMode;
  306. FPrefix: String;
  307. FBaseInstallDir,
  308. FUnitInstallDir,
  309. FBinInstallDir,
  310. FDocInstallDir,
  311. FExamplesInstallDir : String;
  312. FRemove: String;
  313. FTarget: String;
  314. FUnixPaths: Boolean;
  315. function GetBaseInstallDir: String;
  316. function GetBinInstallDir: String;
  317. function GetCompiler: String;
  318. function GetDocInstallDir: String;
  319. function GetExamplesInstallDir: String;
  320. function GetUnitInstallDir: String;
  321. procedure SetBaseInstallDir(const AValue: String);
  322. procedure SetCPU(const AValue: TCPU);
  323. procedure SetOS(const AValue: TOS);
  324. procedure SetPrefix(const AValue: String);
  325. procedure SetTarget(const AValue: String);
  326. Protected
  327. procedure RecalcTarget;
  328. Public
  329. Constructor Create;
  330. Procedure InitDefaults;
  331. Procedure Assign(ASource : TPersistent);override;
  332. Procedure LocalInit(Const AFileName : String);
  333. Procedure LoadFromFile(Const AFileName : String);
  334. Procedure SaveToFile(Const AFileName : String);
  335. procedure SaveToStream(S : TStream);virtual;
  336. procedure LoadFromStream(S : TStream);virtual;
  337. // Compile Information
  338. Property Target : String Read FTarget Write SetTarget;
  339. Property OS : TOS Read FOS Write SetOS;
  340. Property CPU : TCPU Read FCPU Write SetCPU;
  341. Property Mode : TCompilerMode Read FMode Write FMode;
  342. Property UnixPaths : Boolean Read FUnixPaths Write FUnixPaths;
  343. Property Options : String Read FOptions Write FOptions; // Default compiler options.
  344. // paths etc.
  345. Property Prefix : String Read FPrefix Write SetPrefix;
  346. Property BaseInstallDir : String Read GetBaseInstallDir Write SetBaseInstallDir;
  347. Property UnitInstallDir : String Read GetUnitInstallDir Write FUnitInstallDir;
  348. Property BinInstallDir : String Read GetBinInstallDir Write FBinInstallDir;
  349. Property DocInstallDir : String Read GetDocInstallDir Write FDocInstallDir;
  350. Property ExamplesInstallDir : String Read GetExamplesInstallDir Write FExamplesInstallDir;
  351. // Command tools. If not set, internal commands will be used.
  352. Property Compiler : String Read GetCompiler Write FCompiler; // Compiler. Defaults to fpc/ppc386
  353. Property Copy : String Read FCopy Write FCopy; // copy $(FILES) to $(DEST)
  354. Property Move : String Read FMove Write FMove; // Move $(FILES) to $(DEST)
  355. Property Remove : String Read FRemove Write FRemove; // Delete $(FILES)
  356. Property MkDir : String Read FMkDir write FMkDir; // Make $(DIRECTORY)
  357. Property Archive : String Read FArchive Write FArchive; // zip $(ARCHIVE) $(FILESORDIRS)
  358. Property Download : String Read FDownload Write FDownload; // wget $(URL) $(DESTFILE)
  359. end;
  360. { TBuildEngine }
  361. TBuildEngine = Class(TComponent)
  362. private
  363. // general variables
  364. FCompiler : String;
  365. FStartDir : String;
  366. FTargetDir : String;
  367. FDefaults : TDefaults;
  368. FForceCompile : Boolean;
  369. FListMode : Boolean;
  370. // Variables used when compiling a package.
  371. // Only valid during compilation of the package.
  372. FCurrentOutputDir : String;
  373. FCurrentPackage: TPackage;
  374. // Events
  375. FOnLog: TLogEvent;
  376. FAfterArchive: TNotifyEvent;
  377. FAfterClean: TNotifyEvent;
  378. FAfterCompile: TNotifyEvent;
  379. FAfterDownload: TNotifyEvent;
  380. FAfterInstall: TNotifyEvent;
  381. FBeforeArchive: TNotifyEvent;
  382. FBeforeClean: TNotifyEvent;
  383. FBeforeCompile: TNotifyEvent;
  384. FBeforeDownload: TNotifyEvent;
  385. FBeforeInstall: TNotifyEvent;
  386. procedure SetDefaults(const AValue: TDefaults);
  387. procedure SetTargetDir(const AValue: String);
  388. Protected
  389. Procedure Error(Msg : String);
  390. Procedure Error(Fmt : String; Args : Array of const);
  391. // Internal copy/delete/move/archive/mkdir files
  392. Procedure SysCopyFile(Const Src,Dest : String); virtual;
  393. Procedure SysMoveFile(Const Src,Dest : String); virtual;
  394. Procedure SysDeleteFile(Const AFileName : String); virtual;
  395. Procedure SysArchiveFiles(List : TStrings; Const AFileName : String); virtual;
  396. Procedure SysDownloadFile(Const AURL, ALocalFileName : String); virtual;
  397. Procedure Log(Level : TVerboseLevel; Const Msg : String);
  398. Procedure Log(Level : TVerboseLevel; Const Fmt : String; Args : Array Of Const);
  399. Procedure EnterDir(ADir : String);
  400. Function GetCompiler : String;
  401. Procedure InstallPackageFiles(APAckage : TPackage; tt : TTargetType; Const Src,Dest : String); virtual;
  402. Function FileNewer(Src,Dest : String) : Boolean;
  403. Public
  404. Constructor Create(AOwner : TComponent); override;
  405. // Public Copy/delete/Move/Archive/Mkdir Commands.
  406. Procedure ExecuteCommand(Cmd : String; Args : String; IgnoreError : Boolean = False); virtual;
  407. Procedure CmdCopyFiles(List : TStrings; Const DestDir : String);
  408. Procedure CmdCreateDir(DestDir : String);
  409. Procedure CmdMoveFiles(List : TStrings; Const DestDir : String);
  410. Procedure CmdDeleteFiles(List : TStrings);
  411. Procedure CmdArchiveFiles(List : TStrings; Const ArchiveFile : String);
  412. Procedure ExecuteCommands(Commands : TCommands; At : TCommandAt);
  413. // Target commands
  414. Function GetTargetDir(APackage : TPackage; ATarget : TTarget; AbsolutePath : Boolean = False) : String;
  415. Function GetCompilerCommand(APackage : TPackage; Target : TTarget) : String;
  416. Function TargetOK(Target : TTarget) : Boolean;
  417. Function NeedsCompile(Target : TTarget) : Boolean;
  418. Procedure Compile(Target : TTarget); virtual;
  419. Procedure FixDependencies(Target: TTarget);
  420. // Package commands
  421. Function GetPackageDir(APackage : TPackage; AbsolutePath : Boolean = False) : String;
  422. Function GetOutputDir(APackage : TPackage; AbsolutePath : Boolean = False) : String;
  423. Function PackageOK(APackage : TPackage) : Boolean; virtual;
  424. Procedure DoBeforeCompile(APackage : TPackage);virtual;
  425. Procedure DoAfterCompile(APackage : TPackage);virtual;
  426. Procedure DoBeforeInstall(APackage : TPackage);virtual;
  427. Procedure DoAfterInstall(APackage : TPackage);virtual;
  428. Procedure DoBeforeArchive(APackage : TPackage);virtual;
  429. Procedure DoAfterArchive(APackage : TPackage);virtual;
  430. Procedure DoBeforeClean(APackage : TPackage);virtual;
  431. Procedure DoAfterClean(APackage : TPackage);virtual;
  432. Procedure DoBeforeDownload(APackage : TPackage);virtual;
  433. Procedure DoAfterDownload(APackage : TPackage);virtual;
  434. Function NeedsCompile(APackage : TPackage) : Boolean; virtual;
  435. Procedure Compile(APackage : TPackage);
  436. Procedure Install(APackage : TPackage);
  437. Procedure Archive(APackage : TPackage);
  438. Procedure Clean(APackage : TPackage);
  439. Procedure Download(APackage : TPackage);
  440. Procedure FixDependencies(APackage : TPackage);
  441. procedure CheckExternalPackage(Const APackageName : String);
  442. procedure CreateOutputDir(APackage: TPackage);
  443. // Packages commands
  444. Procedure Compile(Packages : TPackages);
  445. Procedure Install(Packages : TPackages);
  446. Procedure Archive(Packages : TPackages);
  447. Procedure Clean(Packages : TPackages);
  448. Procedure Download(Packages : TPackages);
  449. Property ListMode : Boolean Read FListMode Write FListMode;
  450. Property ForceCompile : Boolean Read FForceCompile Write FForceCompile;
  451. Property Defaults : TDefaults Read FDefaults Write SetDefaults;
  452. Property TargetDir : String Read FTargetDir Write SetTargetDir;
  453. // Events
  454. Property BeforeCompile : TNotifyEvent Read FBeforeCompile Write FBeforeCompile;
  455. Property AfterCompile : TNotifyEvent Read FAfterCompile Write FAfterCompile;
  456. Property BeforeInstall : TNotifyEvent Read FBeforeInstall Write FBeforeInstall;
  457. Property AfterInstall : TNotifyEvent Read FAfterInstall Write FAfterInstall;
  458. Property BeforeClean : TNotifyEvent Read FBeforeClean Write FBeforeClean;
  459. Property AfterClean : TNotifyEvent Read FAfterClean Write FAfterClean;
  460. Property BeforeArchive : TNotifyEvent Read FBeforeArchive Write FBeforeArchive;
  461. Property AfterArchive : TNotifyEvent Read FAfterArchive Write FAfterArchive;
  462. Property BeforeDownload : TNotifyEvent Read FBeforeDownload Write FBeforeDownload;
  463. Property AfterDownload : TNotifyEvent Read FAfterDownload Write FAfterDownload;
  464. Property OnLog : TLogEvent Read FOnLog Write FOnlog;
  465. end;
  466. { TInstaller }
  467. TInstaller = Class(TComponent)
  468. private
  469. FBuildEngine: TBuildEngine;
  470. FDefaultPackage: TPackage;
  471. FDefaults: TDefaults;
  472. FPackages: TPackages;
  473. FRunMode: TRunMode;
  474. FListMode : Boolean;
  475. FLogLevels : TVerboseLevels;
  476. function GetAuthor: String;
  477. function GetStrings(AIndex : Integer): TStrings;
  478. function GetDirectory: String;
  479. function GetLicense: String;
  480. function GetOSes: TOSes;
  481. function GetOptions: String;
  482. function GetTargets: TTargets;
  483. function GetURL: String;
  484. function GetVersion: String;
  485. procedure SetAuthor(const AValue: String);
  486. procedure SetDefaultPackage(const AValue: TPackage);
  487. procedure SetDefaults(const AValue: TDefaults);
  488. procedure SetStrings(AIndex : Integer; const AValue: TStrings);
  489. procedure SetDirectory(const AValue: String);
  490. procedure SetOptions(const AValue: String);
  491. procedure SetOses(const AValue: TOSes);
  492. procedure SetURL(const AValue: String);
  493. procedure SetVersion(const AValue: String);
  494. procedure SetLicense(const AValue: String);
  495. Protected
  496. Procedure Log(Level : TVerboseLevel; Const Msg : String);
  497. Procedure CreatePackages; virtual;
  498. Procedure CheckPackages; virtual;
  499. Procedure CreateBuildEngine; virtual;
  500. Procedure CheckDefaultPackage;
  501. Procedure Error(Msg : String);
  502. Procedure Error(Fmt : String; Args : Array of const);
  503. Procedure AnalyzeOptions;
  504. Procedure Usage(FMT : String; Args : Array of const);
  505. Procedure Compile(Force : Boolean); virtual;
  506. Procedure Clean; virtual;
  507. Procedure Install; virtual;
  508. Procedure Archive; virtual;
  509. Procedure Download; Virtual;
  510. Property BuildEngine : TBuildEngine Read FBuildEngine;
  511. Public
  512. Constructor Create(AOWner : TComponent); override;
  513. Destructor destroy; override;
  514. Function StartPackage(Const AName : String) : TPackage;
  515. Procedure EndPackage;
  516. Function Run : Boolean;
  517. Function AddTarget(AName : String) : TTarget;
  518. Procedure AddDependency(AName : String);
  519. Property DefaultPackage : TPackage read FDefaultPackage write SetDefaultPackage;
  520. Property Packages : TPackages Read FPackages;
  521. Property Dependencies : TStrings Index 0 Read GetStrings Write SetStrings;
  522. Property InstallFiles : TStrings Index 1 Read GetStrings Write SetStrings;
  523. Property CleanFiles : TStrings Index 2 Read GetStrings Write SetStrings;
  524. Property ArchiveFiles : TStrings Index 3 Read GetStrings Write SetStrings;
  525. Property Defaults : TDefaults Read FDefaults Write SetDefaults;
  526. Property RunMode : TRunMode Read FRunMode;
  527. Property ListMode : Boolean Read FListMode;
  528. // Default Package redirects.
  529. Property Targets : TTargets Read GetTargets;
  530. Property Version : String Read GetVersion Write SetVersion;
  531. Property URL : String Read GetURL Write SetURL;
  532. Property Author : String Read GetAuthor Write SetAuthor;
  533. Property License : String Read GetLicense Write SetLicense;
  534. Property Directory : String Read GetDirectory Write SetDirectory;
  535. Property Options : String Read GetOptions Write SetOptions;
  536. Property OS: TOSes Read GetOSes Write SetOses;
  537. end;
  538. TReplaceFunction = Function (Const AName,Args : String) : String of Object;
  539. { TValueItem }
  540. TValueItem = Class(TObject)
  541. FValue : String;
  542. Constructor Create(AValue : String);
  543. end;
  544. { TFunctionItem }
  545. TFunctionItem = Class(TObject)
  546. FFunc : TReplaceFunction;
  547. Constructor Create(AFunc : TReplaceFunction);
  548. end;
  549. { TDictionary }
  550. TDictionary = Class(TComponent)
  551. FList : TStringList;
  552. Public
  553. Constructor Create(AOwner : TComponent); override;
  554. Destructor Destroy;override;
  555. Procedure AddVariable(Const AName,Value : String);
  556. Procedure AddFunction(Const AName : String; FReplacement : TReplaceFunction);
  557. Procedure RemoveItem(Const AName : String);
  558. Function GetValue(Const AName : String) : String;
  559. Function GetValue(Const AName,Args : String) : String; virtual;
  560. Function ReplaceStrings(Const ASource : String) : String; virtual;
  561. end;
  562. ECollectionError = Class(Exception);
  563. EInstallerError = Class(Exception);
  564. EDictionaryError = Class(Exception);
  565. TInstallerClass = Class of TInstaller;
  566. TDictionaryClass = Class of TDictionary;
  567. Const
  568. // Aliases
  569. AmD64 = X86_64;
  570. PowerPC = PPC;
  571. dos = go32v2;
  572. AllOSs = [Low(TOS)..High(TOS)];
  573. AllCPUs = [Low(TCPU)..High(TCPU)];
  574. // Useful
  575. UnitExt = '.ppu';
  576. PPUExt = UnitExt;
  577. PasExt = '.pas';
  578. PPExt = '.pp';
  579. IncExt = '.inc';
  580. ObjExt = '.o';
  581. RstExt = '.rst';
  582. LibExt = '.a';
  583. SharedLibExt = '.so';
  584. DLLExt = '.dll';
  585. ExeExt = '.exe';
  586. ZipExt = '.zip';
  587. // Targets
  588. i386_Linux = 'i386-linux';
  589. i386_Win32 = 'i386-win32';
  590. i386_Dos = 'i386-go32v2';
  591. i386_OS2 = 'i386-os2';
  592. i386_FreeBSD = 'i386-freebsd';
  593. i386_NetBSD = 'i386-netsd';
  594. i386_OpenBSD = 'i386-openbsd';
  595. i386_netware = 'i386-netware';
  596. i386_netwlibc = 'i386-netwlibc';
  597. i386_go32v2 = 'i386-go32v2';
  598. PPC_Linux = 'ppc-linux';
  599. powerpc_linux = PPC_linux;
  600. sparc_linux = 'sparc-linux';
  601. arm_linux = 'arm-linux';
  602. ppc_macos = 'ppc-macos';
  603. ppc_darwin = 'ppc-darwin';
  604. UnitTargets = [ttUnit,ttExampleUnit];
  605. ProgramTargets = [ttProgram,ttExampleProgram];
  606. AllMessages = [vlError,vlWarning,vlInfo,vlCompare,vlCommand];
  607. Type
  608. TArchiveEvent = Procedure (Const AFileName : String; List : TStrings) of Object;
  609. TArchiveProc = Procedure (Const AFileName : String; List : TStrings);
  610. TDownLoadEvent = Procedure (Const AURL,ALocalFileName : String) of Object;
  611. TDownloadProc = Procedure (Const AURL,ALocalFileName : String);
  612. Var
  613. InstallerClass : TInstallerClass = TInstaller;
  614. DictionaryClass : TDictionaryClass = TDictionary;
  615. OnArchiveFiles : TArchiveEvent = Nil;
  616. ArchiveFilesProc : TArchiveProc = Nil;
  617. OnDownloadFile : TDownloadEvent = Nil;
  618. DownloadFileProc : TDownloadProc = Nil;
  619. Function CurrentOS : String;
  620. Function CurrentCPU : String;
  621. Function Installer : TInstaller;
  622. Function Defaults : TDefaults; // Set by installer.
  623. Function Dictionary : TDictionary;
  624. Function OSToString(OS: TOS) : String;
  625. Function OSesToString(OSes: TOSes) : String;
  626. Function CPUToString(CPU: TCPU) : String;
  627. Function CPUSToString(CPUS: TCPUS) : String;
  628. Function StringToOS(S : String) : TOS;
  629. Function OSesToString(S : String) : TOSes;
  630. Function StringToCPU(S : String) : TCPU;
  631. Function StringToCPUS(S : String) : TCPUS;
  632. Function ModeToString(Mode: TCompilerMode) : String;
  633. Function StringToMode(S : String) : TCompilerMode;
  634. Function MakeTargetString(CPU : TCPU;OS: TOS) : String;
  635. Procedure StringToCPUOS(S : String; Var CPU : TCPU; Var OS: TOS);
  636. Procedure ResolveDependencies(L : TStrings; P : TNamedCollection);
  637. Function AddStrings(Dest,Src : TStrings) : Integer ;
  638. function AddStrings(Dest, Src : TStrings; Const APrefix : String) : Integer ;
  639. Function FileListToString(List : TStrings; Prefix : String) : String;
  640. Function FixPath (APath : String) : String;
  641. Procedure ChangeDir(APath : String);
  642. Function Substitute(Const Source : String; Macros : Array of string) : String;
  643. Procedure SplitCommand(Const Cmd : String; Var Exe,Options : String);
  644. Implementation
  645. uses TypInfo;
  646. ResourceString
  647. SErrNameExists = 'Name "%s" already exists in the collection.';
  648. SErrNoSuchName = 'Could not find item with name "%s" in the collection.';
  649. SErrInvalidCPU = 'Invalid CPU name : "%s"';
  650. SErrInvalidOS = 'Invalid OS name : "%s"';
  651. SErrInvalidMode = 'Invalid compiler mode : "%s"';
  652. SErrNoPackage = 'No package available. Add package with StartPackage Call';
  653. SErrInValidArgument = 'Invalid command-line argument at position %d : %s';
  654. SErrNeedArgument = 'Option at position %d (%s) needs an argument';
  655. SErrInvalidTarget = 'Invalid compiler target: %s';
  656. SErrNoPackagesDefined = 'No action possible: No packages were defined.';
  657. SErrInstaller = 'The installer encountered the following error:';
  658. SErrDepUnknownTarget = 'Unknown target in dependencies for %s: %s';
  659. SErrExternalCommandFailed = 'External command "%s" failed with exit code: %d';
  660. SErrCreatingDirectory = 'Failed to create directory: %s';
  661. SErrDeletingFile = 'Failed to delete file: %s';
  662. SErrMovingFile = 'Failed to move file "%s" to "%s"';
  663. SErrCopyingFile = 'Failed to copy file "%s" to "%s"';
  664. SErrChangeDirFailed = 'Failed to enter directory: %s';
  665. SErrInvalidArgumentToSubstitute = 'Invalid number of arguments to Substitute';
  666. SErrNoArchiveSupport = 'This binary contains no archive support. Please recompile with archive support';
  667. SErrNoDownloadSupport = 'This binary contains no download support. Please recompile with download support';
  668. SErrNoDictionaryItem = 'No item called "%s" in the dictionary';
  669. SErrNoDictionaryValue = 'The item "%s" in the dictionary is not a value.';
  670. SErrNoDictionaryFunc = 'The item "%s" in the dictionary is not a function.';
  671. SWarnCircularDependency = 'Warning: Circular dependency detected when compiling target %s: %s';
  672. SWarnFailedToSetTime = 'Warning: Failed to set timestamp on file : %s';
  673. SWarnFailedToGetTime = 'Warning: Failed to get timestamp from file : %s';
  674. SWarnFileDoesNotExist = 'Warning: File "%s" does not exist';
  675. // Log messages
  676. SLogEnterDir = 'Entering directory: %s';
  677. SLogCompilingPackage = 'Compiling package : %s';
  678. SLogCompilingTarget = 'Compiling target : %s';
  679. SLogExecutingCommand = 'Executing command %s with options: %s';
  680. SLogCreatingOutputDir = 'Creating output dir : %s';
  681. SLogOutputDirExists = 'Output dir exists : %s';
  682. SLogInstallingPackage = 'Installing package : %s';
  683. SLogArchivingPackage = 'Archiving package : %s';
  684. SLogCleaningPackage = 'Cleaning package : %s';
  685. SLogDownloadingPackage = 'Downloading package : %s';
  686. SLogCopyingFile = 'Copying file "%s" to "%s"';
  687. SLogCompilingFileTimes = 'Comparing file "%s" time "%s" to "%s" time "%s".';
  688. SLogSourceNewerDest = 'Source file "%s" (%s) is newer than destination "%s" (%s).';
  689. Const
  690. // Keys for Defaults file. Do not localize.
  691. KeyCompiler = 'Compiler';
  692. KeyArchive = 'Archive';
  693. KeyCopy = 'Copy';
  694. KeyDownLoad = 'Download';
  695. KeyMkDir = 'MkDir';
  696. KeyMove = 'Move';
  697. KeyRemove = 'Remove';
  698. KeyOptions = 'Options';
  699. KeyCPU = 'CPU';
  700. KeyOS = 'OS';
  701. KeyMode = 'Mode';
  702. KeyPrefix = 'Prefix';
  703. KeyTarget = 'Target';
  704. KeyBaseInstallDir = 'BaseInstallDir';
  705. KeyUnitInstallDir = 'UnitInstallDir';
  706. KeyBinInstallDir = 'BinInstallDir';
  707. KeyDocInstallDir = 'DocInstallDir';
  708. KeyExamplesInstallDir = 'ExamplesInstallDir';
  709. // Callback for Sysutils getapplicationname.
  710. Function GetFPMakeName : String;
  711. begin
  712. Result:='fpmake';
  713. end;
  714. Function CurrentOS : String;
  715. begin
  716. Result:=OSToString(Defaults.OS);
  717. end;
  718. Function CurrentCPU : String;
  719. begin
  720. Result:=CPUToString(Defaults.CPU);
  721. end;
  722. Function OSToString(OS: TOS) : String;
  723. begin
  724. Result:=LowerCase(GetenumName(TypeInfo(TOS),Ord(OS)));
  725. end;
  726. Function OSesToString(OSes: TOSes) : String;
  727. begin
  728. Result:=LowerCase(SetToString(PtypeInfo(TypeInfo(TOSes)),Integer(OSes),False));
  729. end;
  730. Function CPUToString(CPU: TCPU) : String;
  731. begin
  732. Result:=LowerCase(GetenumName(TypeInfo(TCPU),Ord(CPU)));
  733. end;
  734. Function CPUSToString(CPUS: TCPUS) : String;
  735. begin
  736. Result:=LowerCase(SetToString(PTypeInfo(TypeInfo(TCPUS)),Integer(CPUS),False));
  737. end;
  738. Function StringToOS(S : String) : TOS;
  739. Var
  740. I : Integer;
  741. begin
  742. I:=GetEnumValue(TypeInfo(TOS),S);
  743. if (I=-1) then
  744. Raise EInstallerError.CreateFmt(SErrInvalidOS,[S]);
  745. Result:=TOS(I);
  746. end;
  747. Function OSesToString(S : String) : TOSes;
  748. begin
  749. Result:=TOSes(StringToSet(PTypeInfo(TypeInfo(TOSes)),S));
  750. end;
  751. Function StringToCPU(S : String) : TCPU;
  752. Var
  753. I : Integer;
  754. begin
  755. I:=GetEnumValue(TypeInfo(TCPU),S);
  756. if (I=-1) then
  757. Raise EInstallerError.CreateFmt(SErrInvalidCPU,[S]);
  758. Result:=TCPU(I);
  759. end;
  760. Function StringToCPUS(S : String) : TCPUS;
  761. begin
  762. Result:=TCPUS(StringToSet(PTypeInfo(TypeInfo(TCPUS)),S));
  763. end;
  764. Function ModeToString(Mode: TCompilerMode) : String;
  765. begin
  766. Result:=LowerCase(GetenumName(TypeInfo(TCompilerMode),Ord(Mode)));
  767. end;
  768. Function StringToMode(S : String) : TCompilerMode;
  769. Var
  770. I : Integer;
  771. begin
  772. I:=GetEnumValue(TypeInfo(TCompilerMode),S);
  773. if (I=-1) then
  774. Raise EInstallerError.CreateFmt(SErrInvalidMode,[S]);
  775. Result:=TCompilerMode(I);
  776. end;
  777. Function MakeTargetString(CPU : TCPU;OS: TOS) : String;
  778. begin
  779. Result:=CPUToString(CPU)+'-'+OSToString(OS);
  780. end;
  781. Procedure StringToCPUOS(S : String; Var CPU : TCPU; Var OS: TOS);
  782. Var
  783. P : integer;
  784. begin
  785. P:=Pos('-',S);
  786. If (P=0) then
  787. Raise EInstallerError.CreateFmt(SErrInvalidTarget,[S]);
  788. CPU:=StringToCPU(Copy(S,1,P-1));
  789. OS:=StringToOs(Copy(S,P+1,Length(S)-P));
  790. end;
  791. Procedure ResolveDependencies(L : TStrings; P : TNamedCollection);
  792. Var
  793. I,J : Integer;
  794. begin
  795. If Assigned(L) then
  796. For I:=0 to L.Count-1 do
  797. begin
  798. J:=P.IndexOfName(L[i]);
  799. If J<>-1 then
  800. L.Objects[I]:=P.Items[J];
  801. end;
  802. end;
  803. Function AddStrings(Dest,Src : TStrings) : Integer ;
  804. begin
  805. Result:=AddStrings(Dest,Src,'');
  806. end;
  807. Procedure AddStrings(Var S : String; L : TStrings; Prefix : String);
  808. Var
  809. I : Integer;
  810. begin
  811. For I:=0 to L.Count-1 do
  812. begin
  813. if (S<>'') then
  814. S:=S+' ';
  815. S:=S+Prefix+L[i];
  816. end;
  817. end;
  818. function AddStrings(Dest, Src : TStrings; Const APrefix : String) : Integer ;
  819. begin
  820. Result:=0;
  821. While (Result<Src.Count) do
  822. begin
  823. If (APrefix<>'') then
  824. Dest.Add(APrefix+Src[Result]) // Not sure whether '' is optimized away.
  825. else
  826. Dest.Add(Src[Result]);
  827. Inc(Result);
  828. end;
  829. end;
  830. function FileListToString(List : TStrings; Prefix : String) : String;
  831. Var
  832. I : integer;
  833. S : String;
  834. begin
  835. Result:='';
  836. For I:=0 to List.Count-1 do
  837. begin
  838. If (I>0) then
  839. Result:=Result+' ';
  840. S:=Prefix+List[i];
  841. If (Pos(' ',S)<>0) then
  842. S:='"'+S+'"';
  843. Result:=Result+S;
  844. end;
  845. end;
  846. function FixPath (APath : String) : String;
  847. Var
  848. P : PChar;
  849. begin
  850. Result:=APath;
  851. If (result<>'') then
  852. begin
  853. P:=PChar(Result);
  854. While (P^<>#0) do
  855. begin
  856. If P^ in ['/','\',':'] then // do not use drive letters.
  857. P^:=PathDelim;
  858. Inc(P);
  859. end;
  860. end;
  861. end;
  862. procedure ChangeDir(APath : String);
  863. begin
  864. if Not SetCurrentDir(APath) then
  865. Raise EInstallerError.CreateFmt(SErrChangeDirFailed,[APath]);
  866. end;
  867. procedure SplitCommand(const Cmd : String; var Exe, Options : String);
  868. Const
  869. WhiteSpace = [#9,#10,#13,' '];
  870. QuoteChars = ['''','"'];
  871. Var
  872. I : Integer;
  873. InQuote : Boolean;
  874. LastQuote : Char;
  875. S : String;
  876. begin
  877. S:=Trim(Cmd);
  878. InQuote:=False;
  879. LastQuote:=#0;
  880. I:=1;
  881. While (I<=Length(S)) and (Inquote or not (S[I] in whiteSpace)) do
  882. begin
  883. If S[i] in QuoteChars then
  884. begin
  885. InQuote:=Not (S[i]=LastQuote);
  886. If InQuote then
  887. LastQuote:=S[i]
  888. else
  889. LastQuote:=#0;
  890. end;
  891. Inc(I);
  892. end;
  893. Exe:=Copy(S,1,I-1);
  894. Delete(S,1,I);
  895. Options:=Trim(S);
  896. end;
  897. { TNamedItem }
  898. procedure TNamedItem.SetName(const AValue: String);
  899. begin
  900. if FName=AValue then exit;
  901. With TNamedCollection(Collection) do
  902. If UniqueNames then
  903. If (IndexOfName(AVAlue)<>-1) then
  904. Raise ECollectionError.CreateFmt(SErrNameExists,[AValue]);
  905. FName:=AValue;
  906. end;
  907. { TNamedCollection }
  908. function TNamedCollection.IndexOfName(AName: String): Integer;
  909. begin
  910. Result:=Count-1;
  911. While (Result>=0) and (CompareText(TNamedItem(Items[Result]).FName,AName)<>0) do
  912. Dec(Result);
  913. end;
  914. function TNamedCollection.ItemByName(AName: String): TNamedItem;
  915. Var
  916. I : Integer;
  917. begin
  918. I:=IndexOfName(AName);
  919. If (I=-1) Then
  920. Raise ECollectionError.CreateFmt(SErrNoSuchName,[AName]);
  921. Result:=TNamedItem(Items[i]);
  922. end;
  923. { TTargets }
  924. function TTargets.GetTargetItem(Index : Integer): TTarget;
  925. begin
  926. Result:=TTarget(Items[Index]);
  927. end;
  928. function TTargets.GetTarget(AName : String): TTarget;
  929. begin
  930. Result:=TTarget(ItemByName(AName));
  931. end;
  932. procedure TTargets.SetDefaultDir(const AValue: String);
  933. begin
  934. If (AValue<>'') then
  935. FDefaultDir:=IncludeTrailingPathDelimiter(AValue)
  936. else
  937. FDefaultDir:='';
  938. end;
  939. procedure TTargets.SetTargetItem(Index : Integer; const AValue: TTarget);
  940. begin
  941. Items[Index]:=AValue;
  942. end;
  943. procedure TTargets.ApplyDefaults(ATarget: TTarget);
  944. begin
  945. If (ATarget.Directory='') then
  946. ATarget.Directory:=FDefaultDir;
  947. ATarget.OS:=FDefaultOS;
  948. ATarget.CPU:=FDefaultCPU;
  949. end;
  950. procedure TTargets.ResetDefaults;
  951. begin
  952. FDefaultDir:='';
  953. FDefaultOS:=[];
  954. FDefaultCPU:=[];
  955. end;
  956. Function TTargets.AddUnit(AUnitName: String) : TTarget;
  957. begin
  958. Result:=Add as TTarget;
  959. Result.Name:=AUnitName;
  960. Result.TargetType:=TTUnit;
  961. ApplyDefaults(Result);
  962. end;
  963. Function TTargets.AddProgram(AProgramName: String) : TTarget;
  964. begin
  965. Result:=Add as TTarget;
  966. Result.Name:=AProgramName;
  967. Result.TargetType:=ttProgram;
  968. ApplyDefaults(Result);
  969. end;
  970. Function TTargets.AddExampleUnit(AUnitName: String): TTarget;
  971. begin
  972. Result:=Add as TTarget;
  973. Result.Name:=AUnitName;
  974. Result.TargetType:=ttExampleUnit;
  975. ApplyDefaults(Result);
  976. end;
  977. Function TTargets.AddExampleProgram(AProgramName: String): TTarget;
  978. begin
  979. Result:=Add as TTarget;
  980. Result.Name:=AProgramName;
  981. Result.TargetType:=ttExampleProgram;
  982. ApplyDefaults(Result);
  983. end;
  984. { TNamedItemList }
  985. function TNamedItemList.GetNamedItem(Index : Integer): TNamedItem;
  986. begin
  987. Result:=TNamedItem(Items[Index]);
  988. end;
  989. procedure TNamedItemList.SetNamedItem(Index : Integer; const AValue: TNamedItem);
  990. begin
  991. Items[Index]:=AValue;
  992. end;
  993. function TNamedItemList.IndexOfName(AName: String): Integer;
  994. begin
  995. Result:=Count-1;
  996. While (Result>=0) and (CompareText(GetNamedItem(Result).Name,AName)<>0) do
  997. Dec(Result);
  998. end;
  999. function TNamedItemList.ItemByName(ANAme: String): TNamedItem;
  1000. Var
  1001. I : Integer;
  1002. begin
  1003. I:=IndexOfName(AName);
  1004. If (I=-1) Then
  1005. Raise ECollectionError.CreateFmt(SErrNoSuchName,[AName]);
  1006. Result:=TNamedItem(Items[i]);
  1007. end;
  1008. { TDefaults }
  1009. procedure TDefaults.SetCPU(const AValue: TCPU);
  1010. begin
  1011. FCPU:=AValue;
  1012. RecalcTarget;
  1013. end;
  1014. function TDefaults.GetBaseInstallDir: String;
  1015. begin
  1016. If (FBaseInstallDir<>'') then
  1017. Result:=FBaseInstallDir
  1018. else
  1019. if UnixPaths then
  1020. Result:=Prefix+PathDelim+'lib'+PathDelim+'fpc'
  1021. else
  1022. Result:=Prefix;
  1023. end;
  1024. function TDefaults.GetBinInstallDir: String;
  1025. begin
  1026. If (FBinInstallDir<>'') then
  1027. Result:=FBinInstallDir
  1028. else
  1029. If UnixPaths then
  1030. Result:=BaseInstallDir+PathDelim+'bin'
  1031. else
  1032. Result:=BaseInstallDir+PathDelim+'bin';
  1033. end;
  1034. function TDefaults.GetCompiler: String;
  1035. begin
  1036. If (FCompiler<>'') then
  1037. Result:=FCompiler
  1038. else
  1039. Case CPU of
  1040. i386 : Result:='ppc386';
  1041. PowerPC : Result:='ppcppc';
  1042. sparc : Result:='ppcsparc';
  1043. arm : Result:='ppcarm';
  1044. x86_64 : Result:='ppcx64';
  1045. end;
  1046. end;
  1047. function TDefaults.GetDocInstallDir: String;
  1048. begin
  1049. If (FBinInstallDir<>'') then
  1050. Result:=FBinInstallDir
  1051. else
  1052. If UnixPaths then
  1053. Result:=Prefix+PathDelim+'share'+PathDelim+'docs'
  1054. else
  1055. Result:=BaseInstallDir+PathDelim+'docs';
  1056. end;
  1057. function TDefaults.GetExamplesInstallDir: String;
  1058. begin
  1059. If (FExamplesInstallDir<>'') then
  1060. Result:=FExamplesInstallDir
  1061. else
  1062. If UnixPaths then
  1063. Result:=Prefix+PathDelim+'share'+PathDelim+'docs'+PathDelim+'examples'
  1064. else
  1065. Result:=BaseInstallDir+PathDelim+'examples';
  1066. end;
  1067. function TDefaults.GetUnitInstallDir: String;
  1068. begin
  1069. If (FUnitInstallDir<>'') then
  1070. Result:=FBinInstallDir
  1071. else
  1072. If UnixPaths then
  1073. Result:=BaseInstallDir+PathDelim+'units'+PathDelim+Target
  1074. else
  1075. Result:=BaseInstallDir+PathDelim+'units'+PathDelim+Target;
  1076. end;
  1077. procedure TDefaults.SetBaseInstallDir(const AValue: String);
  1078. begin
  1079. FBaseInstallDir:=AValue;
  1080. UnitInstallDir:='';
  1081. BinInstallDir:='';
  1082. ExamplesInstallDir:='';
  1083. end;
  1084. procedure TDefaults.SetOS(const AValue: TOS);
  1085. begin
  1086. FOS:=AValue;
  1087. Recalctarget;
  1088. end;
  1089. procedure TDefaults.SetPrefix(const AValue: String);
  1090. begin
  1091. if FPrefix=AValue then exit;
  1092. FPrefix:=AValue;
  1093. BaseInstallDir:='';
  1094. end;
  1095. procedure TDefaults.SetTarget(const AValue: String);
  1096. Var
  1097. P : Integer;
  1098. begin
  1099. if FTarget<>AValue then
  1100. begin
  1101. P:=Pos('-',AValue);
  1102. If (P<>0) then
  1103. begin
  1104. FOS:=StringToOS(System.Copy(Avalue,P+1,Length(AValue)-P));
  1105. FCPU:=StringToCPU(System.Copy(Avalue,1,P-1));
  1106. end
  1107. else
  1108. FOS:=StringToOS(AValue);
  1109. FTarget:=AValue;
  1110. end;
  1111. end;
  1112. procedure TDefaults.RecalcTarget;
  1113. begin
  1114. Ftarget:=CPUToString(FCPU)+'-'+OStoString(FOS);
  1115. end;
  1116. constructor TDefaults.Create;
  1117. begin
  1118. InitDefaults;
  1119. end;
  1120. procedure TDefaults.InitDefaults;
  1121. begin
  1122. {$ifdef unix}
  1123. UnixPaths:=True;
  1124. {$else}
  1125. UnixPaths:=False;
  1126. {$endif}
  1127. // Code to init defaults for compiled platform.
  1128. CPU:=StringToCPU({$I %FPCTARGETCPU%});
  1129. OS:=StringToOS({$I %FPCTARGETOS%});
  1130. Compiler:='ppc386';
  1131. end;
  1132. procedure TDefaults.Assign(ASource: TPersistent);
  1133. Var
  1134. d : TDefaults;
  1135. begin
  1136. If ASource is TDefaults then
  1137. begin
  1138. D:=ASource as TDefaults;
  1139. FArchive:=D.Farchive;
  1140. FCompiler:=D.Compiler;
  1141. FCopy:=D.FCopy;
  1142. FCPU:=D.FCPU;
  1143. FMode:=D.FMode;
  1144. FDownload:=D.FDownload;
  1145. FMkDir:=D.FDownload;
  1146. FMove:=D.FDownload;
  1147. FOptions:=D.FOptions;
  1148. FOS:=D.FOS;
  1149. FPrefix:=D.FPrefix;
  1150. FBaseInstallDir:=D.FBaseInstallDir;
  1151. FUnitInstallDir:=D.FUnitInstallDir;
  1152. FBinInstallDir:=D.FBinInstallDir;
  1153. FDocInstallDir:=D.FDocInstallDir;
  1154. FExamplesInstallDir:=D.FExamplesInstallDir;
  1155. FRemove:=D.FRemove;
  1156. FTarget:=D.FTarget;
  1157. FUnixPaths:=D.FUnixPaths;
  1158. end;
  1159. end;
  1160. procedure TDefaults.LocalInit(Const AFileName : String);
  1161. Var
  1162. FN : String;
  1163. begin
  1164. FN:=AFileName;
  1165. If (FN='') then
  1166. begin
  1167. // Environment variable.
  1168. FN:=GetEnvironmentVariable('FPMAKECFG');
  1169. If (FN<>'') then
  1170. If not FileExists(FN) then
  1171. FN:='';
  1172. // User config file fpmake.cfg
  1173. If (FN='') then
  1174. begin
  1175. FN:=GetAppConfigFile(False);
  1176. If Not FileExists(FN) then
  1177. FN:='';
  1178. end;
  1179. // Global config file fpmake.cfg
  1180. If (FN='') then
  1181. begin
  1182. FN:=GetAppConfigFile(True);
  1183. If Not FileExists(FN) then
  1184. FN:='';
  1185. end;
  1186. end;
  1187. If (FN<>'') and FileExists(FN) then
  1188. LoadFromFile(FN)
  1189. // Code to find local config file and load it using LoadFromFile.
  1190. end;
  1191. procedure TDefaults.LoadFromFile(Const AFileName: String);
  1192. Var
  1193. F : TFileStream;
  1194. begin
  1195. F:=TFileStream.Create(AFileName,fmOpenRead);
  1196. Try
  1197. LoadFromStream(F);
  1198. Finally
  1199. F.Free;
  1200. end;
  1201. end;
  1202. procedure TDefaults.SaveToFile(Const AFileName: String);
  1203. Var
  1204. F : TFileStream;
  1205. begin
  1206. F:=TFileStream.Create(AFileName,fmCreate);
  1207. Try
  1208. SaveToStream(F);
  1209. Finally
  1210. F.Free;
  1211. end;
  1212. end;
  1213. procedure TDefaults.SaveToStream(S : TStream);
  1214. Var
  1215. L : TStringList;
  1216. begin
  1217. L:=TStringList.Create;
  1218. try
  1219. With L do
  1220. begin
  1221. Values[KeyArchive]:=FArchive;
  1222. Values[KeyCompiler]:=FCompiler;
  1223. Values[KeyCopy]:=FCopy;
  1224. Values[KeyDownLoad]:=FDownload;
  1225. Values[KeyMkDir]:=FMkDir;
  1226. Values[KeyMove]:=FMove;
  1227. Values[KeyOptions]:=FOptions;
  1228. Values[KeyCPU]:=CPUToString(FCPU);
  1229. Values[KeyOS]:=OSToString(FOS);
  1230. Values[KeyMode]:=ModeToString(FMode);
  1231. Values[KeyPrefix]:=FPrefix;
  1232. Values[KeyBaseInstallDir]:=FBaseInstallDir;
  1233. Values[KeyUnitInstallDir]:=FUnitInstallDir;
  1234. Values[KeyBinInstallDir]:=FBinInstallDir;
  1235. Values[KeyDocInstallDir]:=FDocInstallDir;
  1236. Values[KeyExamplesInstallDir]:=FExamplesInstallDir;
  1237. Values[KeyRemove]:=FRemove;
  1238. Values[KeyTarget]:=FTarget;
  1239. end;
  1240. L.SaveToStream(S);
  1241. Finally
  1242. L.Free;
  1243. end;
  1244. end;
  1245. procedure TDefaults.LoadFromStream(S: TStream);
  1246. Var
  1247. L : TStrings;
  1248. Line : String;
  1249. I,P,PC : Integer;
  1250. begin
  1251. L:=TStringList.Create;
  1252. Try
  1253. L.LoadFromStream(S);
  1254. // Fix lines.
  1255. For I:=L.Count-1 downto 0 do
  1256. begin
  1257. Line:=L[I];
  1258. P:=Pos('=',Line);
  1259. PC:=Pos(';',Line); // Comment line.
  1260. If (P=0) or ((PC<>0) and (PC<P)) then
  1261. L.Delete(I)
  1262. else
  1263. L[i]:=Trim(System.Copy(Line,1,P-1)+'='+Trim(System.Copy(Line,P+1,Length(Line)-P)));
  1264. end;
  1265. With L do
  1266. begin
  1267. FArchive:=Values[KeyArchive];
  1268. FCompiler:=Values[KeyCompiler];
  1269. FDownload:=Values[KeyDownLoad];
  1270. FCopy:=Values[KeyCopy];
  1271. FMkDir:=Values[KeyMkDir];
  1272. FMove:=Values[KeyMove];
  1273. FRemove:=Values[KeyRemove];
  1274. FOptions:=Values[KeyOptions];
  1275. Line:=Values[KeyCPU];
  1276. If (Line<>'') then
  1277. FCPU:=StringToCPU(Line);
  1278. Line:=Values[KeyOS];
  1279. If (Line<>'') then
  1280. FOS:=StringToOS(Line);
  1281. Line:=Values[KeyMode];
  1282. If (Line<>'') then
  1283. FMode:=StringToMode(Line);
  1284. FTarget:=Values[KeyTarget];
  1285. FPrefix:=Values[KeyPrefix];
  1286. FBaseInstallDir:=Values[KeyBaseInstallDir];
  1287. FUnitInstallDir:=Values[KeyUnitInstallDir];
  1288. FBinInstallDir:=Values[KeyBinInstallDir];
  1289. FDocInstallDir:=Values[KeyDocInstallDir];
  1290. FExamplesInstallDir:=Values[KeyExamplesInstallDir];
  1291. end;
  1292. Finally
  1293. L.Free;
  1294. end;
  1295. end;
  1296. { TPackage }
  1297. function TPackage.GetHasStrings(AIndex: integer): Boolean;
  1298. begin
  1299. Result:=False;
  1300. Case AIndex Of
  1301. 0 : Result:=FUnitPath<>Nil;
  1302. 1 : Result:=FObjectPath<>Nil;
  1303. 2 : Result:=FIncludePath<>Nil;
  1304. 3 : Result:=FDependencies<>Nil;
  1305. 4 : Result:=FInstallFiles<>Nil;
  1306. 5 : Result:=FCleanFiles<>Nil;
  1307. 6 : Result:=FArchiveFiles<>Nil;
  1308. end;
  1309. end;
  1310. function TPackage.GetCommands: TCommands;
  1311. begin
  1312. If Not Assigned(FCommands) then
  1313. FCommands:=TCommands.Create(TCommand);
  1314. Result:=FCommands;
  1315. end;
  1316. function TPackage.GetHasCommands: Boolean;
  1317. begin
  1318. Result:=Assigned(FCommands);
  1319. end;
  1320. function TPackage.GetStrings(AIndex: integer): TStrings;
  1321. Function EnsureStrings(Var S : TStrings) : TStrings;
  1322. begin
  1323. If (S=Nil) then
  1324. S:=TStringList.Create;
  1325. Result:=S;
  1326. end;
  1327. begin
  1328. Result:=Nil;
  1329. Case AIndex Of
  1330. 0 : Result:=EnsureStrings(FUnitPath);
  1331. 1 : Result:=EnsureStrings(FObjectPath);
  1332. 2 : Result:=EnsureStrings(FIncludePath);
  1333. 3 : begin
  1334. Result:=EnsureStrings(FDependencies);
  1335. With TStringList(Result) do
  1336. if (Count=0) then
  1337. begin
  1338. Sorted:=True;
  1339. Duplicates:=dupError;
  1340. end;
  1341. end;
  1342. 4 : Result:=EnsureStrings(FInstallFiles);
  1343. 5 : Result:=EnsureStrings(FCleanFiles);
  1344. 6 : Result:=EnsureStrings(FArchiveFiles);
  1345. end;
  1346. end;
  1347. procedure TPackage.SetCommands(const AValue: TCommands);
  1348. begin
  1349. Commands.Assign(AValue);
  1350. end;
  1351. procedure TPackage.SetStrings(AIndex: integer; const AValue: TStrings);
  1352. begin
  1353. GetStrings(AIndex).Assign(AValue);
  1354. end;
  1355. constructor TPackage.Create(ACollection: TCollection);
  1356. Var
  1357. L : TStringList;
  1358. begin
  1359. inherited Create(ACollection);
  1360. FTargets:=TTargets.Create(TTarget);
  1361. L:=TStringList.Create;
  1362. FDependencies:=L;
  1363. FInstallFiles:=TStringList.Create;
  1364. FCleanFiles:=TStringList.Create;
  1365. FArchiveFiles:=TStringList.Create;
  1366. end;
  1367. destructor TPackage.destroy;
  1368. begin
  1369. FreeAndNil(FDependencies);
  1370. FreeAndNil(FInstallFiles);
  1371. FreeAndNil(FCleanFiles);
  1372. FreeAndNil(FArchiveFiles);
  1373. FreeAndNil(FIncludePath);
  1374. FreeAndNil(FObjectPath);
  1375. FreeAndNil(FUnitPath);
  1376. FreeAndNil(FTargets);
  1377. inherited destroy;
  1378. end;
  1379. function TPackage.AddTarget(AName: String): TTarget;
  1380. begin
  1381. Result:=Targets.Add as TTarget;
  1382. Result.Name:=AName;
  1383. end;
  1384. procedure TPackage.AddDependency(AName: String);
  1385. begin
  1386. If FDependencies.IndexOf(AName)=-1 then
  1387. FDependencies.Add(AName);
  1388. end;
  1389. procedure TPackage.AddInstallFile(AFileName: String);
  1390. begin
  1391. FInstallFiles.add(AFileName);
  1392. end;
  1393. procedure TPackage.GetCleanFiles(List: TStrings; Const APrefix : String; AOS : TOS);
  1394. Var
  1395. I : Integer;
  1396. begin
  1397. AddStrings(List,CleanFiles,APrefix);
  1398. For I:=0 to FTargets.Count-1 do
  1399. FTargets.TargetItems[I].GetCleanFiles(List,APrefix,AOS);
  1400. end;
  1401. procedure TPackage.GetInstallFiles(List: TStrings;Types : TTargetTypes;Const APrefix : String; AOS : TOS);
  1402. Var
  1403. I : Integer;
  1404. T : TTarget;
  1405. begin
  1406. AddStrings(List,InstallFiles,APrefix);
  1407. For I:=0 to FTargets.Count-1 do
  1408. begin
  1409. T:=FTargets.TargetItems[I];
  1410. if (T.TargetType in Types) then
  1411. T.GetInstallFiles(List,APrefix,AOS);
  1412. end;
  1413. end;
  1414. procedure TPackage.GetArchiveFiles(List: TStrings;Const APrefix : String; AOS : TOS);
  1415. Var
  1416. I : Integer;
  1417. begin
  1418. If (OS=[]) or (AOS in OS) then
  1419. begin
  1420. AddStrings(List,ArchiveFiles,APrefix);
  1421. For I:=0 to FTargets.Count-1 do
  1422. FTargets.TargetItems[I].GetArchiveFiles(List,APrefix,AOS);
  1423. end;
  1424. end;
  1425. { TPackages }
  1426. function TPackages.GetPackage(AName : String): TPackage;
  1427. begin
  1428. Result:=TPackage(ItemByName(AName))
  1429. end;
  1430. function TPackages.GetPackageItem(AIndex : Integer): TPackage;
  1431. begin
  1432. Result:=TPackage(Items[AIndex]);
  1433. end;
  1434. procedure TPackages.SetPackageItem(AIndex : Integer; const AValue: TPackage);
  1435. begin
  1436. Items[AIndex]:=AValue;
  1437. end;
  1438. function TPackages.AddPackage(const AName: String): TPackage;
  1439. begin
  1440. Result:=Add as TPackage;
  1441. Result.Name:=AName;
  1442. end;
  1443. { TInstaller }
  1444. function TInstaller.GetStrings(AIndex : Integer): TStrings;
  1445. begin
  1446. CheckDefaultPackage;
  1447. Case AIndex of
  1448. 0: Result:=DefaultPackage.Dependencies;
  1449. 1: Result:=DefaultPackage.InstallFiles;
  1450. 2: Result:=DefaultPackage.CleanFiles;
  1451. 3: Result:=DefaultPackage.ArchiveFiles;
  1452. end;
  1453. end;
  1454. function TInstaller.GetDirectory: String;
  1455. begin
  1456. CheckDefaultPackage;
  1457. Result:=DefaultPackage.Directory;
  1458. end;
  1459. function TInstaller.GetLicense: String;
  1460. begin
  1461. CheckDefaultPackage;
  1462. Result:=DefaultPackage.License;
  1463. end;
  1464. function TInstaller.GetOSes: TOSes;
  1465. begin
  1466. CheckDefaultPackage;
  1467. Result:=DefaultPackage.OS;
  1468. end;
  1469. function TInstaller.GetOptions: String;
  1470. begin
  1471. CheckDefaultPackage;
  1472. Result:=DefaultPackage.Options;
  1473. end;
  1474. function TInstaller.GetAuthor: String;
  1475. begin
  1476. CheckDefaultPackage;
  1477. Result:=DefaultPackage.Author;
  1478. end;
  1479. function TInstaller.GetTargets: TTargets;
  1480. begin
  1481. CheckDefaultPackage;
  1482. Result:=DefaultPackage.Targets;
  1483. end;
  1484. function TInstaller.GetURL: String;
  1485. begin
  1486. CheckDefaultPackage;
  1487. Result:=DefaultPackage.URL;
  1488. end;
  1489. function TInstaller.GetVersion: String;
  1490. begin
  1491. CheckDefaultPackage;
  1492. Result:=DefaultPackage.Version;
  1493. end;
  1494. procedure TInstaller.SetAuthor(const AValue: String);
  1495. begin
  1496. CheckDefaultPackage;
  1497. DefaultPackage.Author:=AValue;
  1498. end;
  1499. procedure TInstaller.SetDefaultPackage(const AValue: TPackage);
  1500. begin
  1501. if FDefaultPackage=AValue then exit;
  1502. FDefaultPackage:=AValue;
  1503. end;
  1504. procedure TInstaller.SetDefaults(const AValue: TDefaults);
  1505. begin
  1506. FDefaults.Assign(AValue);
  1507. end;
  1508. procedure TInstaller.SetStrings(AIndex : Integer; const AValue: TStrings);
  1509. Var
  1510. Res : TStrings;
  1511. begin
  1512. CheckDefaultPackage;
  1513. Case AIndex of
  1514. 0: Res:=DefaultPackage.Dependencies;
  1515. 1: Res:=DefaultPackage.InstallFiles;
  1516. 2: Res:=DefaultPackage.CleanFiles;
  1517. 3: Res:=DefaultPackage.ArchiveFiles;
  1518. end;
  1519. Res.Assign(Avalue);
  1520. end;
  1521. procedure TInstaller.SetDirectory(const AValue: String);
  1522. begin
  1523. CheckDefaultPackage;
  1524. DefaultPackage.Directory:=AValue;
  1525. end;
  1526. procedure TInstaller.SetOptions(const AValue: String);
  1527. begin
  1528. CheckDefaultPackage;
  1529. DefaultPackage.Options:=AValue;
  1530. end;
  1531. procedure TInstaller.SetOses(const AValue: TOSes);
  1532. begin
  1533. CheckDefaultPackage;
  1534. DefaultPackage.OS:=AValue;
  1535. end;
  1536. procedure TInstaller.SetURL(const AValue: String);
  1537. begin
  1538. CheckDefaultPackage;
  1539. DefaultPackage.URL:=AValue;
  1540. end;
  1541. procedure TInstaller.SetVersion(const AValue: String);
  1542. begin
  1543. CheckDefaultPackage;
  1544. DefaultPackage.Version:=AValue;
  1545. end;
  1546. procedure TInstaller.SetLicense(const AValue: String);
  1547. begin
  1548. CheckDefaultPackage;
  1549. DefaultPackage.License:=AValue;
  1550. end;
  1551. procedure TInstaller.Log(Level: TVerboseLevel; const Msg: String);
  1552. begin
  1553. If Level in FLogLevels then
  1554. Writeln(StdErr,Msg);
  1555. end;
  1556. procedure TInstaller.CreatePackages;
  1557. begin
  1558. FPAckages:=TPackages.Create(TPackage);
  1559. end;
  1560. procedure TInstaller.CreateBuildEngine;
  1561. begin
  1562. FBuildEngine:=TBuildEngine.Create(Self);
  1563. FBuildEngine.Defaults:=Defaults;
  1564. FBuildEngine.ListMode:=FListMode;
  1565. FBuildEngine.OnLog:[email protected];
  1566. end;
  1567. procedure TInstaller.CheckDefaultPackage;
  1568. begin
  1569. If (FDefaultPackage=Nil) then
  1570. Raise EInstallerError.Create(SErrNoPackage);
  1571. end;
  1572. procedure TInstaller.Error(Msg: String);
  1573. begin
  1574. Raise EInstallerError.Create(Msg);
  1575. end;
  1576. procedure TInstaller.Error(Fmt: String; Args: array of const);
  1577. begin
  1578. Raise EInstallerError.CreateFmt(Fmt,Args);
  1579. end;
  1580. Function TInstaller.StartPackage(const AName: String) : TPackage;
  1581. begin
  1582. FDefaultPackage:=FPackages.AddPackage(AName);
  1583. Result:=FDefaultPackage;
  1584. end;
  1585. procedure TInstaller.EndPackage;
  1586. begin
  1587. FDefaultPackage:=Nil;
  1588. end;
  1589. procedure TInstaller.AnalyzeOptions;
  1590. Function CheckOption(Index : Integer;Short,Long : String): Boolean;
  1591. var
  1592. O : String;
  1593. begin
  1594. O:=Paramstr(Index);
  1595. Result:=(O='-'+short) or (O='--'+long) or (copy(O,1,Length(Long)+3)=('--'+long+'='));
  1596. end;
  1597. Function OptionArg(Var Index : Integer) : String;
  1598. Var
  1599. P : Integer;
  1600. begin
  1601. if (Length(ParamStr(Index))>1) and (Paramstr(Index)[2]<>'-') then
  1602. begin
  1603. If Index<ParamCount then
  1604. begin
  1605. Inc(Index);
  1606. Result:=Paramstr(Index);
  1607. end
  1608. else
  1609. Error(SErrNeedArgument,[Index,ParamStr(Index)]);
  1610. end
  1611. else If length(ParamStr(Index))>2 then
  1612. begin
  1613. P:=Pos('=',Paramstr(Index));
  1614. If (P=0) then
  1615. Error(SErrNeedArgument,[Index,ParamStr(Index)])
  1616. else
  1617. begin
  1618. Result:=Paramstr(Index);
  1619. Delete(Result,1,P);
  1620. end;
  1621. end;
  1622. end;
  1623. Var
  1624. I : Integer;
  1625. Nodefaults : Boolean;
  1626. DefaultsFileName : string;
  1627. begin
  1628. I:=0;
  1629. NoDefaults:=False;
  1630. FListMode:=False;
  1631. While (I<ParamCount) do
  1632. begin
  1633. Inc(I);
  1634. if Checkoption(I,'m','compile') then
  1635. FRunMode:=rmCompile
  1636. else if Checkoption(I,'b','build') then
  1637. FRunMode:=rmBuild
  1638. else if CheckOption(I,'i','install') then
  1639. FRunMode:=rmInstall
  1640. else if CheckOption(I,'c','clean') then
  1641. FRunMode:=rmClean
  1642. else if CheckOption(I,'a','archive') then
  1643. FRunMode:=rmarchive
  1644. else if CheckOption(I,'d','download') then
  1645. FRunMode:=rmDownload
  1646. else if CheckOption(I,'h','help') then
  1647. FRunMode:=rmhelp
  1648. else if Checkoption(I,'C','CPU') then
  1649. Defaults.CPU:=StringToCPU(OptionArg(I))
  1650. else if Checkoption(I,'O','OS') then
  1651. Defaults.OS:=StringToOS(OptionArg(I))
  1652. else if Checkoption(I,'t','target') then
  1653. Defaults.Target:=OptionArg(I)
  1654. else if CheckOption(I,'l','list-commands') then
  1655. FListMode:=True
  1656. else if Checkoption(I,'P','prefix') then
  1657. Defaults.Prefix:=OptionArg(I)
  1658. else if Checkoption(I,'n','nodefaults') then
  1659. NoDefaults:=true
  1660. else if CheckOption(I,'b','baseinstalldir') then
  1661. Defaults.BaseInstallDir:=OptionArg(I)
  1662. else if CheckOption(I,'r','compiler') then
  1663. Defaults.Compiler:=OptionArg(I)
  1664. else if CheckOption(I,'f','config') then
  1665. DefaultsFileName:=OptionArg(I)
  1666. else if CheckOption(I,'v','verbose') then
  1667. begin
  1668. Try
  1669. FLogLevels:=TVerboseLevels(StringToSet(PtypeInfo(TypeInfo(TVerboseLevels)),OptionArg(I)));
  1670. except
  1671. FLogLevels:=AllMessages;
  1672. end;
  1673. end
  1674. else
  1675. begin
  1676. Usage(SErrInValidArgument,[I,ParamStr(I)]);
  1677. end;
  1678. end;
  1679. If Not NoDefaults then
  1680. Defaults.LocalInit(DefaultsFileName);
  1681. {$ifdef debug}
  1682. FLogLevels:=AllMessages;
  1683. {$endif}
  1684. end;
  1685. procedure TInstaller.Usage(FMT: String; Args: array of const);
  1686. begin
  1687. If (FMT<>'') then
  1688. Writeln(stderr,Format(Fmt,Args));
  1689. Writeln(stderr,ExtractFileName(Paramstr(0)),' usage: ');
  1690. Writeln(stderr,'');
  1691. If (FMT<>'') then
  1692. halt(1);
  1693. end;
  1694. procedure TInstaller.Compile(Force: Boolean);
  1695. begin
  1696. FBuildEngine.ForceCompile:=Force;
  1697. FBuildEngine.Compile(FPackages);
  1698. end;
  1699. procedure TInstaller.Clean;
  1700. begin
  1701. BuildEngine.Clean(FPackages);
  1702. end;
  1703. procedure TInstaller.Install;
  1704. begin
  1705. BuildEngine.Install(FPackages);
  1706. end;
  1707. procedure TInstaller.Archive;
  1708. begin
  1709. FBuildEngine.Archive(FPackages);
  1710. end;
  1711. procedure TInstaller.Download;
  1712. begin
  1713. BuildEngine.Download(FPackages);
  1714. end;
  1715. constructor TInstaller.Create(AOWner: TComponent);
  1716. begin
  1717. inherited Create(AOWner);
  1718. FDefaults:=TDefaults.Create;
  1719. AnalyzeOptions;
  1720. CreatePackages;
  1721. end;
  1722. destructor TInstaller.destroy;
  1723. begin
  1724. FreeAndNil(FDefaults);
  1725. inherited destroy;
  1726. end;
  1727. procedure TInstaller.CheckPackages;
  1728. begin
  1729. If (FPackages.Count=0) then
  1730. Error(SErrNoPackagesDefined);
  1731. // Check for other obvious errors ?
  1732. end;
  1733. Function TInstaller.Run : Boolean;
  1734. begin
  1735. Result:=True;
  1736. try
  1737. If RunMode<>rmHelp then
  1738. begin
  1739. CheckPackages;
  1740. CreateBuildEngine;
  1741. end;
  1742. Case RunMode of
  1743. rmHelp : Usage('',[]);
  1744. rmCompile : Compile(False);
  1745. rmBuild : Compile(True);
  1746. rmInstall : Install;
  1747. rmArchive : Archive;
  1748. rmClean : Clean;
  1749. rmDownload : Download;
  1750. end;
  1751. except
  1752. On E : Exception do
  1753. begin
  1754. Writeln(StdErr,SErrInstaller);
  1755. Writeln(StdErr,E.Message);
  1756. Result:=False;
  1757. end;
  1758. end;
  1759. end;
  1760. function TInstaller.AddTarget(AName: String): TTarget;
  1761. begin
  1762. CheckDefaultPackage;
  1763. Result:=DefaultPackage.AddTarget(AName);
  1764. end;
  1765. procedure TInstaller.AddDependency(AName: String);
  1766. begin
  1767. CheckDefaultPackage;
  1768. DefaultPackage.AddDependency(AName);
  1769. end;
  1770. { TBuildEngine }
  1771. procedure TBuildEngine.SetDefaults(const AValue: TDefaults);
  1772. begin
  1773. FDefaults.Assign(AValue);
  1774. end;
  1775. procedure TBuildEngine.SetTargetDir(const AValue: String);
  1776. begin
  1777. if FTargetDir=AValue then exit;
  1778. FTargetDir:=AValue;
  1779. end;
  1780. procedure TBuildEngine.Error(Msg: String);
  1781. begin
  1782. Raise EInstallerError.Create(Msg);
  1783. end;
  1784. procedure TBuildEngine.Error(Fmt: String; Args: array of const);
  1785. begin
  1786. Raise EInstallerError.CreateFmt(Fmt,Args);
  1787. end;
  1788. constructor TBuildEngine.Create(AOwner: TComponent);
  1789. begin
  1790. inherited Create(AOwner);
  1791. FDefaults:=TDefaults.Create;
  1792. // Maybe this should be the current directory ?
  1793. // Or have it as a command-line option.
  1794. // Would allow to put all 'installers' in one dir and call them
  1795. // With --start-dir=/path/to/sources.
  1796. FStartDir:=includeTrailingPathDelimiter(GetCurrentDir);
  1797. end;
  1798. procedure TBuildEngine.ExecuteCommand(Cmd: String; Args : String; IgnoreError : Boolean = False);
  1799. Var
  1800. E : Integer;
  1801. begin
  1802. Log(vlCommand,SLogExecutingCommand,[Cmd,Args]);
  1803. // We should check cmd for spaces, and move all after first space to args.
  1804. E:=ExecuteProcess(cmd,args);
  1805. If (E<>0) and (not IgnoreError) then
  1806. Error(SErrExternalCommandFailed,[Cmd,E]);
  1807. end;
  1808. procedure TBuildEngine.SysCopyFile(Const Src,Dest : String);
  1809. Var
  1810. D,S : String;
  1811. Fin,FOut : TFileStream;
  1812. Count : Int64;
  1813. A : Integer;
  1814. begin
  1815. Log(vlCommand,SLogCopyingFile,[Src,Dest]);
  1816. FIn:=TFileStream.Create(Src,fmopenRead);
  1817. Try
  1818. D:=IncludeTrailingPathDelimiter(Dest);
  1819. If DirectoryExists(D) then
  1820. S:=D+ExtractFileName(Src)
  1821. else
  1822. S:=Dest;
  1823. FOut:=TFileStream.Create(S,fmCreate);
  1824. Try
  1825. Count:=Fout.CopyFrom(FIn,0);
  1826. If (Count<>Fin.Size) then
  1827. Error(SErrCopyingFile,[Src,S]);
  1828. Finally
  1829. FreeAndNil(Fout);
  1830. end;
  1831. A:=FileGetDate(FIn.Handle);
  1832. If (A=-1) then
  1833. log(vlWarning,SWarnFailedToGetTime,[Src])
  1834. else
  1835. if FileSetDate(S,A)<>0 then
  1836. Log(vlWarning,SWarnFailedToSetTime,[S]);
  1837. finally
  1838. FreeAndNil(Fin);
  1839. end;
  1840. end;
  1841. procedure TBuildEngine.SysMoveFile(Const Src,Dest : String);
  1842. Var
  1843. S : String;
  1844. begin
  1845. If DirectoryExists(IncludeTrailingPathDelimiter(Dest)) then
  1846. S:=IncludeTrailingPathDelimiter(Dest)+ExtractFileName(Src)
  1847. else
  1848. S:=Dest;
  1849. If Not RenameFile(Src,S) then
  1850. begin
  1851. Try
  1852. SysCopyFile(Src,S);
  1853. SysDeleteFile(Src);
  1854. Except
  1855. On E : Exception Do
  1856. Error(SErrMovingFile,[Src,S]);
  1857. end;
  1858. end;
  1859. end;
  1860. procedure TBuildEngine.SysDeleteFile(Const AFileName : String);
  1861. begin
  1862. if not FileExists(AFileName) then
  1863. Log(vlWarning,SWarnFileDoesNotExist,[AFileName])
  1864. else If Not DeleteFile(AFileName) then
  1865. Error(SErrDeletingFile,[AFileName]);
  1866. end;
  1867. procedure TBuildEngine.SysArchiveFiles(List: TStrings;Const AFileName: String);
  1868. begin
  1869. If Not (Assigned(OnArchivefiles) or Assigned(ArchiveFilesProc)) then
  1870. Raise EInstallerError.Create(SErrNoArchiveSupport);
  1871. If Assigned(ArchiveFilesProc) then
  1872. ArchiveFilesProc(AFileName,List)
  1873. else
  1874. OnArchiveFiles(AFileName,List);
  1875. end;
  1876. procedure TBuildEngine.SysDownloadFile(const AURL, ALocalFileName: String);
  1877. begin
  1878. If Not (Assigned(OnDownloadfile) or Assigned(DownloadFileProc)) then
  1879. Raise EInstallerError.Create(SErrNoDownloadSupport);
  1880. If Assigned(DownloadFileProc) then
  1881. DownloadFileProc(AURL,ALocalFileName)
  1882. else
  1883. OnDownloadFile(AURL,ALocalFileName);
  1884. end;
  1885. procedure TBuildEngine.Log(Level: TVerboseLevel; const Msg: String);
  1886. begin
  1887. If Assigned(FOnLog) then
  1888. FOnLog(Level,Msg);
  1889. end;
  1890. procedure TBuildEngine.Log(Level: TVerboseLevel; const Fmt: String;
  1891. Args: array of const);
  1892. begin
  1893. Log(Level,Format(Fmt,Args));
  1894. end;
  1895. procedure TBuildEngine.EnterDir(ADir: String);
  1896. Var
  1897. D : String;
  1898. begin
  1899. D:=FStartDir;
  1900. D:=D+ADir;
  1901. Log(vlInfo,SLogEnterDir,[D]);
  1902. If Not SetCurrentDir(D) then
  1903. Error(SErrChangeDirFailed,[D]);
  1904. end;
  1905. procedure TBuildEngine.CmdCopyFiles(List: TStrings; Const DestDir: String);
  1906. Var
  1907. Args : String;
  1908. I : Integer;
  1909. begin
  1910. CmdCreateDir(DestDir);
  1911. If (Defaults.Copy<>'') then
  1912. begin
  1913. Args:=FileListToString(List,'');
  1914. Args:=Args+' '+DestDir;
  1915. ExecuteCommand(Defaults.Copy,Args);
  1916. end
  1917. else
  1918. For I:=0 to List.Count-1 do
  1919. SysCopyFile(List[i],DestDir);
  1920. end;
  1921. procedure TBuildEngine.CmdCreateDir(DestDir: String);
  1922. begin
  1923. If (Defaults.MkDir<>'') then
  1924. ExecuteCommand(Defaults.MkDir,DestDir)
  1925. else
  1926. If not ForceDirectories(DestDir) then
  1927. Error(SErrCreatingDirectory,[DestDir]);
  1928. end;
  1929. procedure TBuildEngine.CmdMoveFiles(List: TStrings; Const DestDir: String);
  1930. Var
  1931. Args : String;
  1932. I : Integer;
  1933. begin
  1934. CmdCreateDir(DestDir);
  1935. If (Defaults.Move<>'') then
  1936. begin
  1937. Args:=FileListToString(List,'');
  1938. Args:=Args+' '+DestDir;
  1939. ExecuteCommand(Defaults.Move,Args);
  1940. end
  1941. else
  1942. For I:=0 to List.Count-1 do
  1943. SysMoveFile(List[i],DestDir);
  1944. end;
  1945. procedure TBuildEngine.CmdDeleteFiles(List: TStrings);
  1946. Var
  1947. Args : String;
  1948. I : Integer;
  1949. begin
  1950. If (Defaults.Remove<>'') then
  1951. begin
  1952. Args:=FileListToString(List,'');
  1953. ExecuteCommand(Defaults.Remove,Args);
  1954. end
  1955. else
  1956. For I:=0 to List.Count-1 do
  1957. SysDeleteFile(List[i]);
  1958. end;
  1959. procedure TBuildEngine.CmdArchiveFiles(List: TStrings; Const ArchiveFile: String);
  1960. Var
  1961. S,C,O : String;
  1962. begin
  1963. If (Defaults.Archive='') then
  1964. SysArchiveFiles(List,ArchiveFile)
  1965. else
  1966. begin
  1967. S:=FileListToString(List,'');
  1968. SplitCommand(Defaults.Archive,C,O);
  1969. If (O='') then
  1970. O:=ArchiveFile+' '+S
  1971. else
  1972. O:=Substitute(O,['ARCHIVE',ArchiveFile,'FILESORDIRS']);
  1973. ExecuteCommand(C,O);
  1974. end;
  1975. end;
  1976. Function TBuildEngine.FileNewer(Src,Dest : String) : Boolean;
  1977. Var
  1978. DS,DD : Longint;
  1979. D1,D2 : TDateTime;
  1980. begin
  1981. DS:=FileAge(Src);
  1982. DD:=FileAge(Dest);
  1983. D1:=FileDateToDateTime(DS);
  1984. D2:=FileDateToDateTime(DD);
  1985. Log(vlDebug,SLogCompilingFileTimes,[Src,DateTimeToStr(D1),Dest,DateTimeToStr(D2)]);
  1986. Result:=D1>=D2;
  1987. If Result then
  1988. Log(vlCompare,SLogSourceNewerDest,[Src,DateTimeToStr(D1),Dest,DateTimeToStr(D2)]);
  1989. end;
  1990. procedure TBuildEngine.ExecuteCommands(Commands: TCommands; At: TCommandAt);
  1991. Var
  1992. C : TCommand;
  1993. I : Integer;
  1994. Cmd,O : String;
  1995. E : Boolean;
  1996. begin
  1997. For I:=0 to Commands.Count-1 do
  1998. begin
  1999. C:=Commands.CommandItems[i];
  2000. if (C.At=At) then
  2001. begin
  2002. E:=True;
  2003. If (C.SourceFile<>'') and (C.DestFile<>'') then
  2004. E:=FileNewer(C.SourceFile,IncludeTrailingPathDelimiter(Dictionary.GetValue('OUTPUTDIR'))+C.DestFile);
  2005. If E then
  2006. begin
  2007. If Assigned(C.BeforeCommand) then
  2008. C.BeforeCommand(C);
  2009. O:=Substitute(C.Options,['SOURCE',C.SourceFile,'DEST',C.DestFile]);
  2010. Cmd:=C.Command;
  2011. If (ExtractFilePath(Cmd)='') then
  2012. Cmd:=FileSearch(Cmd,GetEnvironmentvariable('PATH'));
  2013. ExecuteCommand(Cmd,O,C.IgnoreResult);
  2014. If Assigned(C.AfterCommand) then
  2015. C.AfterCommand(C);
  2016. end;
  2017. end;
  2018. end;
  2019. end;
  2020. // Relative to startdir.
  2021. Function TBuildEngine.GetTargetDir(APackage : TPackage; ATarget : TTarget; AbsolutePath : Boolean = False) : String;
  2022. begin
  2023. If AbsolutePath then
  2024. Result:=IncludeTrailingPathDelimiter(FStartDir)
  2025. else
  2026. Result:='';
  2027. If (APackage.Directory<>'') then
  2028. Result:=Result+IncludeTrailingPathDelimiter(APackage.Directory);
  2029. If (ATarget.Directory<>'') then
  2030. Result:=IncludeTrailingPathDelimiter(Result+ATarget.Directory);
  2031. end;
  2032. Function TBuildEngine.TargetOK(Target : TTarget) : Boolean;
  2033. begin
  2034. Result:=(Target.TargetType in [ttUnit,ttProgram])
  2035. and
  2036. ((Target.CPU=[]) or (Defaults.CPU in Target.CPU))
  2037. and
  2038. ((Target.OS=[]) or (Defaults.OS in Target.OS));
  2039. If not Result then
  2040. begin
  2041. log(vldebug,'Target is not a unit or program');
  2042. If Not ((Target.CPU=[]) or (Defaults.CPU in Target.CPU)) then
  2043. Log(vldebug,'Target has wrong CPU: '+CPUsToString(Target.CPU));
  2044. if not ((Target.OS=[]) or (Defaults.OS in Target.OS)) then
  2045. Log(vldebug,'Target has wrong OS: '+OSesToString(Target.OS));
  2046. end;
  2047. end;
  2048. Function TBuildEngine.NeedsCompile(Target: TTarget): Boolean;
  2049. Var
  2050. I : Integer;
  2051. T : TTarget;
  2052. OD,SD,SFN,OFN : String;
  2053. begin
  2054. Result:=False;
  2055. OD:=FCurrentOutputDir;
  2056. If (OD<>'') then
  2057. OD:=IncludeTrailingPathDelimiter(OD);
  2058. OFN:=OD+Target.GetOutPutFileName(Defaults.OS);
  2059. SD:=Target.Directory;
  2060. If (SD<>'') then
  2061. SD:=IncludeTrailingPathDelimiter(SD);
  2062. Result:=Not FileExists(OFN);
  2063. // Check dependencies
  2064. If not Result then
  2065. If Target.HasDependencies then
  2066. begin
  2067. ResolveDependencies(Target.Dependencies,Target.Collection as TTargets);
  2068. I:=0;
  2069. While (Not Result) and (I<Target.Dependencies.Count) do
  2070. begin
  2071. T:=TTarget(Target.Dependencies.Objects[i]);
  2072. If (T<>Nil) then
  2073. Result:=NeedsCompile(T)
  2074. else // if it is a filename, check dates.
  2075. if FileExists(Target.Dependencies[i]) then
  2076. Result:=FileNewer(Target.Dependencies[i],OFN)
  2077. else if FileExists(SD+Target.Dependencies[i]) then
  2078. Result:=FileNewer(SD+Target.Dependencies[i],OFN);
  2079. Inc(I)
  2080. end;
  2081. end;
  2082. If not Result then
  2083. begin
  2084. SFN:=SD+Target.SourceFileName;
  2085. If (ExtractFileExt(SFN)='') then
  2086. if FileExists(SFN+'.pp') then
  2087. SFN:=SFN+'.pp'
  2088. else
  2089. SFN:=SFN+'.pas';
  2090. // Writeln('Checking : ',OFN,' against ',SFN);
  2091. Result:=FileNewer(SFN,OFN);
  2092. // here we should check file timestamps.
  2093. end;
  2094. end;
  2095. Function TBuildEngine.GetCompilerCommand(APackage : TPackage; Target : TTarget) : String;
  2096. Var
  2097. PD,TD,OD,RD : String;
  2098. begin
  2099. PD:=IncludeTrailingPathDelimiter(GetPackageDir(APackage,True));
  2100. OD:=IncludeTrailingPathDelimiter(GetOutputDir(APackage,True));
  2101. RD:=ExtractRelativePath(PD,OD);
  2102. If Target.TargetType in ProgramTargets then
  2103. Result:='-FE.' // Make this relative to target directory.
  2104. else
  2105. Result:='-FU'+RD;
  2106. If Target.Mode<>fpc then
  2107. Result:=Result+' -M'+ModeToString(Target.Mode)
  2108. else If Defaults.Mode<>fpc then
  2109. Result:=Result+' -M'+ModeToString(Defaults.Mode);
  2110. If (Defaults.Options<>'') then
  2111. Result:=Result+' '+Defaults.Options;
  2112. If (APackage.Options<>'') then
  2113. Result:=Result+' '+APackage.Options;
  2114. If APackage.HasUnitPath then
  2115. AddStrings(Result,APackage.UnitPath,'-Fu');
  2116. If APackage.HasIncludePath then
  2117. AddStrings(Result,APackage.IncludePath,'-Fi');
  2118. If APackage.HasObjectPath then
  2119. AddStrings(Result,APackage.ObjectPath,'-Fo');
  2120. If Target.HasUnitPath then
  2121. AddStrings(Result,Target.UnitPath,'-Fu');
  2122. If Target.HasIncludePath then
  2123. AddStrings(Result,Target.IncludePath,'-Fi');
  2124. If Target.HasObjectPath then
  2125. AddStrings(Result,Target.ObjectPath,'-Fo');
  2126. If (Target.Options<>'') then
  2127. Result:=Result+' '+Target.Options;
  2128. TD:=Target.Directory;
  2129. if (TD<>'') then
  2130. TD:=IncludeTrailingPathDelimiter(TD);
  2131. Result:=Result+' '+TD+Target.SourceFileName;
  2132. end;
  2133. Function TBuildEngine.GetCompiler : String;
  2134. Var
  2135. S : String;
  2136. begin
  2137. // Cache in FCompiler for speed.
  2138. If (FCompiler='') then
  2139. begin
  2140. FCompiler:=Defaults.Compiler;
  2141. If (ExtractFilePath(FCompiler)='') then
  2142. begin
  2143. S:=FileSearch(FCompiler,GetEnvironmentVariable('PATH'));
  2144. If (S<>'') then
  2145. FCompiler:=S;
  2146. end;
  2147. end;
  2148. Result:=FCompiler;
  2149. end;
  2150. procedure TBuildEngine.Compile(Target: TTarget);
  2151. Var
  2152. S : String;
  2153. begin
  2154. if Target.State in [tsNeutral,tsCompiling] then
  2155. begin
  2156. Log(vlInfo,SLogCompilingTarget,[Target.Name]);
  2157. If Target.HasCommands then
  2158. ExecuteCommands(Target.Commands,caBeforeCompile);
  2159. If Assigned(Target.BeforeCompile) then
  2160. Target.BeforeCompile(Target);
  2161. S:=GetCompilerCommand(FCurrentPackage,Target);
  2162. ExecuteCommand(GetCompiler,S);
  2163. Target.FTargetState:=tsCompiled;
  2164. If Assigned(Target.AfterCompile) then
  2165. Target.AfterCompile(Target);
  2166. If Target.HasCommands then
  2167. ExecuteCommands(Target.Commands,caAfterCompile);
  2168. end
  2169. else if Target.State<>tsCompiled then
  2170. Log(vlWarning,'Attempting to compile non-neutral target: '+Target.Name);
  2171. end;
  2172. procedure TBuildEngine.FixDependencies(Target: TTarget);
  2173. Var
  2174. I : Integer;
  2175. T : TTarget;
  2176. begin
  2177. Log(vlDebug,'Checking dependencies for target: '+Target.Name);
  2178. ResolveDependencies(Target.Dependencies,Target.Collection as TTargets);
  2179. If Target.HasDependencies then
  2180. For I:=0 to Target.Dependencies.Count-1 do
  2181. begin
  2182. T:=TTarget(Target.Dependencies.Objects[i]);
  2183. If Assigned(T) then
  2184. begin
  2185. If (T.State=tsCompiling) then
  2186. Log(vlWarning,SWarnCircularDependency,[Target.Name,T.Name])
  2187. else
  2188. Compile(T)
  2189. end
  2190. else if Not FileExists(Target.Dependencies[i]) then
  2191. Error(SErrDepUnknownTarget,[Target.Name,Target.Dependencies[i]]);
  2192. end;
  2193. end;
  2194. function TBuildEngine.GetPackageDir(APackage: TPackage; AbsolutePath: Boolean
  2195. ): String;
  2196. begin
  2197. If AbsolutePath then
  2198. Result:= IncludeTrailingPathDelimiter(FStartDir)
  2199. else
  2200. Result:='';
  2201. Result:=Result+APackage.Directory;
  2202. If (Result<>'') then
  2203. Result:= ExcludeTrailingPathDelimiter(Result)
  2204. end;
  2205. Function TBuildEngine.GetOutputDir(APackage : TPackage; AbsolutePath : Boolean = False) : String;
  2206. begin
  2207. If (TargetDir<>'') then
  2208. Result:=TargetDir
  2209. else
  2210. begin
  2211. If AbsolutePath then
  2212. Result:=IncludeTrailingPathDelimiter(FStartDir)
  2213. else
  2214. Result:='';
  2215. If (APackage.Directory<>'') then
  2216. Result:=IncludeTrailingPathDelimiter(Result+APackage.Directory);
  2217. Result:=Result+'units'+PathDelim+Defaults.Target;
  2218. end;
  2219. end;
  2220. procedure TBuildEngine.CreateOutputDir(APackage: TPackage);
  2221. Var
  2222. D : String;
  2223. begin
  2224. D:=GetOutputDir(APackage,True);
  2225. If DirectoryExists(D) then
  2226. Log(vlInfo,SLogOutputDirExists,[D])
  2227. else
  2228. begin
  2229. Log(vlInfo,SLogCreatingOutputDir,[D]);
  2230. CmdCreateDir(D);
  2231. end;
  2232. end;
  2233. Function TBuildEngine.PackageOK(APackage : TPackage) : Boolean;
  2234. begin
  2235. Result:=((APackage.CPU=[]) or (Defaults.CPU in APackage.CPU))
  2236. and
  2237. ((APAckage.OS=[]) or (Defaults.OS in APackage.OS));
  2238. end;
  2239. procedure TBuildEngine.DoBeforeCompile(APackage: TPackage);
  2240. begin
  2241. If APackage.HasCommands then
  2242. ExecuteCommands(APackage.Commands,caBeforeCompile);
  2243. If Assigned(APackage.BeforeCompile) then
  2244. APackage.BeforeCompile(APackage);
  2245. end;
  2246. procedure TBuildEngine.DoAfterCompile(APackage: TPackage);
  2247. begin
  2248. If Assigned(APackage.AfterCompile) then
  2249. APackage.AfterCompile(APackage);
  2250. If APackage.HasCommands then
  2251. ExecuteCommands(APackage.Commands,caAfterCompile);
  2252. end;
  2253. procedure TBuildEngine.Compile(APackage: TPackage);
  2254. Var
  2255. T : TTarget;
  2256. I : Integer;
  2257. begin
  2258. Log(vlInfo,SLogCompilingPackage,[APackage.Name]);
  2259. FCurrentPackage:=APackage;
  2260. FCurrentOutputDir:=GetOutputDir(APackage,True);
  2261. Try
  2262. If (APackage.Directory<>'') then
  2263. EnterDir(APackage.Directory);
  2264. CreateOutputDir(APackage);
  2265. Dictionary.AddVariable('OUTPUTDIR',FCurrentOutputDir);
  2266. DoBeforeCompile(APackage);
  2267. Try
  2268. For I:=0 to APackage.Targets.Count-1 do
  2269. begin
  2270. T:=APackage.Targets.TargetItems[i];
  2271. Log(vlDebug,'Considering target: '+T.Name);
  2272. If TargetOK(T) then
  2273. If (T.State=tsNeutral) then
  2274. begin
  2275. If (FForceCompile or NeedsCompile(T)) then
  2276. begin
  2277. T.FTargetState:=tsCompiling;
  2278. FixDependencies(T);
  2279. Compile(T);
  2280. end;
  2281. T.FTargetState:=tsCompiled;
  2282. end;
  2283. end;
  2284. DoAfterCompile(APackage);
  2285. Finally
  2286. If (APackage.Directory<>'') then
  2287. EnterDir('');
  2288. end;
  2289. Finally
  2290. FCurrentPackage:=Nil;
  2291. FCurrentOutputDir:='';
  2292. end;
  2293. end;
  2294. procedure TBuildEngine.CheckExternalPackage(Const APackageName : String);
  2295. begin
  2296. // A check needs to be implemented here.
  2297. Log(vldebug,'Unresolved external dependency : %s',[APackageName]);
  2298. end;
  2299. procedure TBuildEngine.FixDependencies(APackage: TPackage);
  2300. Var
  2301. I : Integer;
  2302. P : TPackage;
  2303. begin
  2304. if APackage.HasDependencies then
  2305. For I:=0 to APAckage.Dependencies.Count-1 do
  2306. begin
  2307. P:=TPackage(Apackage.Dependencies.Objects[i]);
  2308. If Assigned(P) then
  2309. Compile(P) // If it already was compiled, then State<>tsNeutral, and it won't be compiled again.
  2310. else
  2311. CheckExternalPackage(Apackage.Dependencies[i]);
  2312. end;
  2313. end;
  2314. Procedure TBuildEngine.InstallPackageFiles(APAckage : TPackage; tt : TTargetType; Const Src,Dest : String);
  2315. Var
  2316. I : Integer;
  2317. List : TStringList;
  2318. begin
  2319. List:=TStringList.Create;
  2320. Try
  2321. APackage.GetInstallFiles(List,[tt],Src,Defaults.OS);
  2322. if (List.Count>0) then
  2323. CmdCopyFiles(List,Dest);
  2324. Finally
  2325. List.Free;
  2326. end;
  2327. end;
  2328. procedure TBuildEngine.DoBeforeInstall(APackage: TPackage);
  2329. begin
  2330. If APackage.HasCommands then
  2331. ExecuteCommands(APackage.Commands,caBeforeInstall);
  2332. If Assigned(APackage.BeforeInstall) then
  2333. APackage.BeforeInstall(APackage);
  2334. end;
  2335. procedure TBuildEngine.DoAfterInstall(APackage: TPackage);
  2336. begin
  2337. If Assigned(APackage.AfterInstall) then
  2338. APackage.AfterInstall(APackage);
  2339. If APackage.HasCommands then
  2340. ExecuteCommands(APackage.Commands,caAfterInstall);
  2341. end;
  2342. procedure TBuildEngine.Install(APackage: TPackage);
  2343. Var
  2344. PD,D,O : String;
  2345. begin
  2346. If (Apackage.State<>tsCompiled) then
  2347. Compile(APackage);
  2348. Log(vlInfo,SLogInstallingPackage,[APackage.Name]);
  2349. DoBeforeInstall(APackage);
  2350. O:=IncludeTrailingPathDelimiter(GetOutputDir(APAckage));
  2351. PD:=IncludeTrailingPathDelimiter(GetPackageDir(APackage));
  2352. // units
  2353. D:=IncludeTrailingPathDelimiter(Defaults.UnitInstallDir)+APackage.Name;
  2354. InstallPackageFiles(APAckage,ttUnit,O,D);
  2355. // Programs
  2356. D:=IncludeTrailingPathDelimiter(Defaults.BinInstallDir);
  2357. InstallPackageFiles(APAckage,ttProgram,PD,D);
  2358. // Done.
  2359. APackage.FTargetState:=tsInstalled;
  2360. DoAfterInstall(APackage);
  2361. end;
  2362. procedure TBuildEngine.DoBeforeArchive(APackage: TPackage);
  2363. begin
  2364. If APackage.HasCommands then
  2365. ExecuteCommands(APackage.Commands,caBeforeArchive);
  2366. If Assigned(APackage.BeforeArchive) then
  2367. APackage.BeforeArchive(APackage);
  2368. end;
  2369. procedure TBuildEngine.DoAfterArchive(APackage: TPackage);
  2370. begin
  2371. If Assigned(APackage.AfterArchive) then
  2372. APackage.AfterArchive(APackage);
  2373. If APackage.HasCommands then
  2374. ExecuteCommands(APackage.Commands,caAfterArchive);
  2375. end;
  2376. procedure TBuildEngine.Archive(APackage: TPackage);
  2377. Var
  2378. L : TStrings;
  2379. A,S,C,O : String;
  2380. begin
  2381. Log(vlInfo,SLogArchivingPackage,[APackage.Name]);
  2382. DoBeforeArchive(Apackage);
  2383. L:=TStringList.Create;
  2384. Try
  2385. APackage.GetInstallFiles(L,[ttUnit],TargetDir,Defaults.OS);
  2386. A:=APackage.Name+ZipExt;
  2387. CmdArchiveFiles(L,A);
  2388. Finally
  2389. L.Free;
  2390. end;
  2391. Writeln('Archiving : ',APackage.Name);
  2392. DoAfterArchive(Apackage);
  2393. end;
  2394. procedure TBuildEngine.DoBeforeClean(APackage: TPackage);
  2395. begin
  2396. If APackage.HasCommands then
  2397. ExecuteCommands(APackage.Commands,caBeforeClean);
  2398. If Assigned(APackage.BeforeClean) then
  2399. APackage.BeforeClean(APackage);
  2400. end;
  2401. procedure TBuildEngine.DoAfterClean(APackage: TPackage);
  2402. begin
  2403. If Assigned(APackage.AfterClean) then
  2404. APackage.AfterClean(APackage);
  2405. If APackage.HasCommands then
  2406. ExecuteCommands(APackage.Commands,caAfterClean);
  2407. end;
  2408. procedure TBuildEngine.Clean(APackage: TPackage);
  2409. Var
  2410. O : String;
  2411. List : TStringList;
  2412. begin
  2413. Log(vlInfo,SLogCleaningPackage,[APackage.Name]);
  2414. DoBeforeClean(Apackage);
  2415. O:=IncludeTrailingPathDelimiter(GetOutputDir(APAckage));
  2416. List:=TStringList.Create;
  2417. try
  2418. APackage.GetCleanFiles(List,O,Defaults.OS);
  2419. if (List.Count>0) then
  2420. CmdDeleteFiles(List);
  2421. Finally
  2422. List.Free;
  2423. end;
  2424. DoAfterClean(Apackage);
  2425. end;
  2426. procedure TBuildEngine.DoBeforeDownload(APackage: TPackage);
  2427. begin
  2428. If APackage.HasCommands then
  2429. ExecuteCommands(APackage.Commands,caBeforeDownload);
  2430. If Assigned(APackage.BeforeDownload) then
  2431. APackage.BeforeDownload(APackage);
  2432. end;
  2433. procedure TBuildEngine.DoAfterDownload(APackage: TPackage);
  2434. begin
  2435. If Assigned(APackage.AfterDownload) then
  2436. APackage.AfterDownload(APackage);
  2437. If APackage.HasCommands then
  2438. ExecuteCommands(APackage.Commands,caAfterDownload);
  2439. end;
  2440. function TBuildEngine.NeedsCompile(APackage: TPackage): Boolean;
  2441. Var
  2442. I : Integer;
  2443. P : TPackage;
  2444. begin
  2445. ResolveDependencies(APackage.Dependencies,(APackage.Collection as TPackages));
  2446. Result:=False;
  2447. I:=0;
  2448. While (Not Result) and (I<APAckage.Dependencies.Count) do
  2449. begin
  2450. P:=TPackage(APAckage.Dependencies.Objects[i]);
  2451. // I'm not sure whether the target dir is OK here ??
  2452. Result:=Assigned(P) and NeedsCompile(P);
  2453. Inc(I);
  2454. end;
  2455. If Not Result then
  2456. begin
  2457. I:=0;
  2458. While (Not Result) and (I<APackage.Targets.Count) do
  2459. begin
  2460. Result:=NeedsCompile(APackage.Targets.TargetItems[i]);
  2461. Inc(I);
  2462. end;
  2463. end;
  2464. end;
  2465. procedure TBuildEngine.Download(APackage: TPackage);
  2466. begin
  2467. Log(vlInfo,SLogDownloadingPackage,[APackage.Name]);
  2468. DoBeforeDownload(APackage);
  2469. Writeln('Downloading : ',APackage.Name);
  2470. DoAfterDownload(APackage);
  2471. end;
  2472. procedure TBuildEngine.Compile(Packages: TPackages);
  2473. Var
  2474. I : Integer;
  2475. P : TPackage;
  2476. begin
  2477. If Assigned(BeforeCompile) then
  2478. BeforeCompile(Self);
  2479. For I:=0 to Packages.Count-1 do
  2480. begin
  2481. P:=Packages.PackageItems[i];
  2482. If PackageOK(P) then
  2483. If (P.State=tsNeutral) then
  2484. begin
  2485. If (FForceCompile or NeedsCompile(P)) then
  2486. begin
  2487. P.FTargetState:=tsCompiling;
  2488. FixDependencies(P);
  2489. Compile(P);
  2490. end;
  2491. P.FTargetState:=tsCompiled;
  2492. end;
  2493. end;
  2494. If Assigned(AfterCompile) then
  2495. AfterCompile(Self);
  2496. end;
  2497. procedure TBuildEngine.Install(Packages: TPackages);
  2498. Var
  2499. I : Integer;
  2500. P : TPackage;
  2501. begin
  2502. If Assigned(BeforeInstall) then
  2503. BeforeInstall(Self);
  2504. For I:=0 to Packages.Count-1 do
  2505. begin
  2506. P:=Packages.PackageItems[i];
  2507. If PackageOK(P) then
  2508. Install(P);
  2509. end;
  2510. If Assigned(AfterInstall) then
  2511. AfterInstall(Self);
  2512. end;
  2513. procedure TBuildEngine.Archive(Packages: TPackages);
  2514. Var
  2515. I : Integer;
  2516. P : TPackage;
  2517. begin
  2518. If Assigned(BeforeArchive) then
  2519. BeforeArchive(Self);
  2520. Log(vlDebug,'Build engine archiving.');
  2521. For I:=0 to Packages.Count-1 do
  2522. begin
  2523. P:=Packages.PackageItems[i];
  2524. If PackageOK(P) then
  2525. Archive(P);
  2526. end;
  2527. If Assigned(AfterArchive) then
  2528. AfterArchive(Self);
  2529. end;
  2530. procedure TBuildEngine.Clean(Packages: TPackages);
  2531. Var
  2532. I : Integer;
  2533. P : TPackage;
  2534. begin
  2535. If Assigned(BeforeClean) then
  2536. BeforeClean(Self);
  2537. Log(vldebug,'Build engine cleaning.');
  2538. For I:=0 to Packages.Count-1 do
  2539. begin
  2540. P:=Packages.PackageItems[i];
  2541. If PackageOK(P) then
  2542. Clean(P);
  2543. end;
  2544. If Assigned(AfterClean) then
  2545. AfterClean(Self);
  2546. end;
  2547. procedure TBuildEngine.Download(Packages: TPackages);
  2548. Var
  2549. I : Integer;
  2550. P : TPackage;
  2551. begin
  2552. If Assigned(BeforeDownload) then
  2553. BeforeDownload(Self);
  2554. For I:=0 to Packages.Count-1 do
  2555. begin
  2556. P:=Packages.PackageItems[i];
  2557. If PackageOK(P) then
  2558. Download(P);
  2559. end;
  2560. If Assigned(AfterDownload) then
  2561. AfterDownload(Self);
  2562. end;
  2563. { TTarget }
  2564. function TTarget.GetHasStrings(AIndex: integer): Boolean;
  2565. begin
  2566. Result:=False;
  2567. Case AIndex Of
  2568. 0 : Result:=FUnitPath<>Nil;
  2569. 1 : Result:=FObjectPath<>Nil;
  2570. 2 : Result:=FIncludePath<>Nil;
  2571. 3 : Result:=FDependencies<>Nil;
  2572. end;
  2573. end;
  2574. function TTarget.GetCommands: TCommands;
  2575. begin
  2576. If FCommands=Nil then
  2577. FCommands:=TCommands.Create(TCommand);
  2578. Result:=FCommands;
  2579. end;
  2580. function TTarget.GetHasCommands: Boolean;
  2581. begin
  2582. Result:=(FCommands<>Nil);
  2583. end;
  2584. function TTarget.GetStrings(AIndex: integer): TStrings;
  2585. Function EnsureStrings(Var S : TStrings) : TStrings;
  2586. begin
  2587. If (S=Nil) then
  2588. S:=TStringList.Create;
  2589. Result:=S;
  2590. end;
  2591. begin
  2592. Result:=Nil;
  2593. Case AIndex Of
  2594. 0 : Result:=EnsureStrings(FUnitPath);
  2595. 1 : Result:=EnsureStrings(FObjectPath);
  2596. 2 : Result:=EnsureStrings(FIncludePath);
  2597. 3 : Result:=EnsureStrings(FDependencies);
  2598. end;
  2599. end;
  2600. procedure TTarget.SetCommands(const AValue: TCommands);
  2601. begin
  2602. end;
  2603. procedure TTarget.SetStrings(AIndex: integer; const AValue: TStrings);
  2604. begin
  2605. GetStrings(AIndex).Assign(AValue);
  2606. end;
  2607. function TTarget.GetSourceFileName: String;
  2608. begin
  2609. Result:=Name+FExtension;
  2610. end;
  2611. function TTarget.GetUnitFileName: String;
  2612. begin
  2613. Result:=Name+UnitExt;
  2614. end;
  2615. function TTarget.GetObjectFileName: String;
  2616. begin
  2617. Result:=Name+ObjExt;
  2618. end;
  2619. function TTarget.GetRSTFileName: String;
  2620. begin
  2621. Result:=Name+RSText;
  2622. end;
  2623. function TTarget.GetProgramFileName(AnOS : TOS): String;
  2624. begin
  2625. if AnOS in [dos,win32,os2] then
  2626. Result:=Name+ExeExt
  2627. else
  2628. Result:=Name;
  2629. end;
  2630. constructor TTarget.Create(ACollection: TCollection);
  2631. begin
  2632. inherited Create(ACollection);
  2633. FInstall:=True;
  2634. end;
  2635. destructor TTarget.Destroy;
  2636. begin
  2637. FreeAndNil(FUnitPath);
  2638. FreeAndNil(FObjectPath);
  2639. FreeAndNil(FIncludePath);
  2640. FreeAndNil(FDependencies);
  2641. inherited Destroy;
  2642. end;
  2643. function TTarget.GetOutputFileName(AOs: TOS): String;
  2644. begin
  2645. Result:=Name;
  2646. if TargetType in UnitTargets then
  2647. Result:=Result+UnitExt
  2648. else if AOs in [Win32,dos,OS2] then
  2649. Result:=Result+ExeExt
  2650. end;
  2651. procedure TTarget.SetName(const AValue: String);
  2652. Var
  2653. D,N,E : String;
  2654. begin
  2655. N:=FixPath(AValue);
  2656. D:=ExtractFilePath(N);
  2657. E:=ExtractFileExt(N);
  2658. N:=ExtractFileName(N);
  2659. If (E<>'') then
  2660. N:=Copy(N,1,Length(N)-Length(E));
  2661. inherited SetName(N);
  2662. FExtension:=E;
  2663. FDirectory:=D;
  2664. end;
  2665. procedure TTarget.GetCleanFiles(List: TStrings; APrefix : String; AnOS : TOS);
  2666. begin
  2667. If (OS=[]) or (AnOS in OS) then
  2668. begin
  2669. List.Add(APrefix+ObjectFileName);
  2670. If (TargetType in [ttUnit,ttExampleUnit]) then
  2671. List.Add(APrefix+UnitFileName)
  2672. else If (TargetType in [ttProgram,ttExampleProgram]) then
  2673. List.Add(APrefix+GetProgramFileName(AnOS));
  2674. If ResourceStrings then
  2675. List.Add(APrefix+RSTFileName);
  2676. // Maybe add later ? AddStrings(List,CleanFiles);
  2677. end;
  2678. end;
  2679. procedure TTarget.GetInstallFiles(List: TStrings; APrefix : String; AnOS : TOS);
  2680. begin
  2681. If (OS=[]) or (AnOS in OS) then
  2682. begin
  2683. If Not (TargetType in [ttProgram,ttExampleProgram]) then
  2684. List.Add(APrefix+ObjectFileName);
  2685. If (TargetType in [ttUnit,ttExampleUnit]) then
  2686. List.Add(APrefix+UnitFileName)
  2687. else If (TargetType in [ttProgram,ttExampleProgram]) then
  2688. List.Add(APrefix+GetProgramFileName(AnOS));
  2689. If ResourceStrings then
  2690. List.Add(APrefix+RSTFileName);
  2691. // Maybe add later ? AddStrings(List,InstallFiles);
  2692. end;
  2693. end;
  2694. procedure TTarget.GetArchiveFiles(List: TStrings; APrefix : String; AnOS : TOS);
  2695. begin
  2696. If (OS=[]) or (AnOS in OS) then
  2697. begin
  2698. List.Add(APrefix+SourceFileName);
  2699. // Maybe add later ? AddStrings(List,ArchiveFiles);
  2700. end;
  2701. end;
  2702. { TCommands }
  2703. function TCommands.GetCommand(Dest : String): TCommand;
  2704. begin
  2705. Result:=TCommand(ItemByName(Dest));
  2706. end;
  2707. function TCommands.GetCommandItem(Index : Integer): TCommand;
  2708. begin
  2709. Result:=TCommand(Items[Index]);
  2710. end;
  2711. procedure TCommands.SetCommandItem(Index : Integer; const AValue: TCommand);
  2712. begin
  2713. Items[Index]:=AValue;
  2714. end;
  2715. Function TCommands.AddCommand(const Cmd: String) : TCommand;
  2716. begin
  2717. Result:=AddCommand(fdefaultAt,Cmd,'','','');
  2718. end;
  2719. function TCommands.AddCommand(const Cmd, Options: String): TCommand;
  2720. begin
  2721. Result:=AddCommand(fdefaultAt,Cmd,Options,'','');
  2722. end;
  2723. function TCommands.AddCommand(const Cmd, Options, Dest, Source: String
  2724. ): TCommand;
  2725. begin
  2726. Result:=AddCommand(fdefaultAt,Cmd,options,Dest,Source);
  2727. end;
  2728. Function TCommands.AddCommand(At: TCommandAt; const Cmd: String) : TCommand;
  2729. begin
  2730. Result:=AddCommand(At,Cmd,'','','');
  2731. end;
  2732. function TCommands.AddCommand(At: TCommandAt; const Cmd, Options: String
  2733. ): TCommand;
  2734. begin
  2735. Result:=AddCommand(At,Cmd,Options,'','');
  2736. end;
  2737. function TCommands.AddCommand(At: TCommandAt; const Cmd, Options, Dest,
  2738. Source: String): TCommand;
  2739. begin
  2740. Result:=Add as TCommand;
  2741. Result.Command:=Cmd;
  2742. Result.Options:=Options;
  2743. Result.At:=At;
  2744. Result.SourceFile:=Source;
  2745. Result.DestFile:=Dest;
  2746. end;
  2747. Var
  2748. DefInstaller : TInstaller = Nil;
  2749. DefDictionary : TDictionary = Nil;
  2750. Function Installer : TInstaller;
  2751. begin
  2752. If Not Assigned(DefInstaller) then
  2753. DefInstaller:=InstallerClass.Create(Nil);
  2754. Result:=DefInstaller;
  2755. end;
  2756. Function Defaults : TDefaults;
  2757. begin
  2758. Result:=Installer.Defaults;
  2759. end;
  2760. function Dictionary : TDictionary;
  2761. begin
  2762. If Not Assigned(DefDictionary) then
  2763. DefDictionary:=DictionaryClass.Create(Nil);
  2764. Result:=DefDictionary;
  2765. end;
  2766. { TValueItem }
  2767. constructor TValueItem.Create(AValue: String);
  2768. begin
  2769. FValue:=AValue;
  2770. end;
  2771. { TFunctionItem }
  2772. constructor TFunctionItem.Create(AFunc: TReplaceFunction);
  2773. begin
  2774. FFunc:=AFunc;
  2775. end;
  2776. { TDictionary }
  2777. constructor TDictionary.Create(AOwner: TComponent);
  2778. begin
  2779. inherited Create(AOwner);
  2780. FList:=TStringList.Create;
  2781. FList.Sorted:=True;
  2782. FList.Duplicates:=dupError;
  2783. end;
  2784. destructor TDictionary.Destroy;
  2785. Var
  2786. I : Integer;
  2787. begin
  2788. For I:=0 to Flist.Count-1 do
  2789. FList.Objects[i].Free;
  2790. FreeAndNil(FList);
  2791. inherited Destroy;
  2792. end;
  2793. procedure TDictionary.AddVariable(const AName, Value: String);
  2794. Var
  2795. I : Integer;
  2796. begin
  2797. I:=Flist.IndexOf(AName);
  2798. If I=-1 then
  2799. I:=FList.Add(Aname)
  2800. else
  2801. Flist.Objects[i].Free;
  2802. Flist.Objects[i]:=TValueItem.Create(Value);
  2803. end;
  2804. procedure TDictionary.AddFunction(const AName: String;
  2805. FReplacement: TReplaceFunction);
  2806. Var
  2807. I : Integer;
  2808. begin
  2809. I:=Flist.IndexOf(AName);
  2810. If I=-1 then
  2811. I:=Flist.Add(AName)
  2812. else
  2813. Flist.Objects[i].Free;
  2814. Flist.Objects[i]:=TFunctionItem.Create(FReplacement);
  2815. end;
  2816. procedure TDictionary.RemoveItem(const AName: String);
  2817. Var
  2818. I : Integer;
  2819. begin
  2820. I:=Flist.IndexOf(AName);
  2821. If (I<>-1) then
  2822. begin
  2823. FList.Objects[i].Free;
  2824. FList.Delete(I);
  2825. end;
  2826. end;
  2827. function TDictionary.GetValue(const AName: String): String;
  2828. begin
  2829. Result:=GetValue(AName,'');
  2830. end;
  2831. function TDictionary.GetValue(const AName,Args: String): String;
  2832. Var
  2833. O : TObject;
  2834. I : Integer;
  2835. begin
  2836. I:=Flist.IndexOf(AName);
  2837. If (I=-1) then
  2838. Raise EDictionaryError.CreateFmt(SErrNoDictionaryItem,[AName]);
  2839. O:=Flist.Objects[I];
  2840. If O is TValueItem then
  2841. Result:=Result+TValueItem(O).FValue
  2842. else
  2843. Result:=Result+TFunctionItem(O).FFunc(AName,Args);
  2844. end;
  2845. function TDictionary.ReplaceStrings(Const ASource: String): String;
  2846. Var
  2847. S,FN,FV : String;
  2848. I,P: Integer;
  2849. O : TObject;
  2850. begin
  2851. Result:='';
  2852. S:=ASource;
  2853. P:=Pos('$(',S);
  2854. While (P<>0) do
  2855. begin
  2856. Result:=Result+Copy(S,1,P-1);
  2857. Delete(S,1,P+1);
  2858. P:=Pos(')',S);
  2859. FN:=Copy(S,1,P-1);
  2860. Delete(S,1,P);
  2861. P:=Pos(' ',FN);
  2862. If (P<>0) then // function arguments ?
  2863. begin
  2864. FV:=FN;
  2865. FN:=Copy(FN,1,P);
  2866. System.Delete(FV,1,P);
  2867. end
  2868. else
  2869. FV:='';
  2870. Result:=Result+GetValue(FN,FV);
  2871. P:=Pos('$(',S);
  2872. end;
  2873. Result:=Result+S;
  2874. end;
  2875. Function Substitute(Const Source : String; Macros : Array of string) : String;
  2876. Var
  2877. I : Integer;
  2878. begin
  2879. I:=0;
  2880. While I<High(Macros) do
  2881. begin
  2882. Dictionary.AddVariable(Macros[i],Macros[I+1]);
  2883. Inc(I,2);
  2884. end;
  2885. Result:=Dictionary.ReplaceStrings(Source);
  2886. While I<High(Macros) do
  2887. begin
  2888. Dictionary.RemoveItem(Macros[i]);
  2889. Inc(I,2);
  2890. end;
  2891. end;
  2892. Initialization
  2893. OnGetApplicationName:=@GetFPMakeName;
  2894. Finalization
  2895. FreeAndNil(DefInstaller);
  2896. FreeAndNil(DefDictionary);
  2897. end.