fpclasschart.pp 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851
  1. {
  2. FPClass chart - Free Pascal class chart generation tool
  3. Copyright (c) 2008 - Michael Van Canneyt, [email protected]
  4. * Free Pascal class chart generation tool
  5. See the file COPYING, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. }
  11. {$mode objfpc}
  12. {$h+}
  13. program fpclasschart;
  14. uses
  15. SysUtils, Classes, Typinfo, Gettext, dom, xmlread,
  16. dGlobals, PasTree, PParser,PScanner, xmlwrite;
  17. resourcestring
  18. STitle = 'fpClassTree - Create class tree from pascal sources';
  19. SVersion = 'Version %s [%s]';
  20. SCopyright = '(c) 2008 - Michael Van Canneyt, [email protected]';
  21. SCmdLineHelp = 'See documentation for usage.';
  22. SCmdLineInvalidOption = 'Ignoring unknown option "%s"';
  23. SDone = 'Done.';
  24. SSkipMerge = 'Cannot merge %s into %s tree.';
  25. SErrNoSuchMergeFile = 'Merge file %s does not exist.';
  26. SMergedFile = 'Merged %d classes from file %s.';
  27. SClassesAdded = 'Added %d classes from %d files.';
  28. Const
  29. RootNames : Array[TPasObjKind] of string
  30. = ('Objects', 'Classes', 'Interfaces');
  31. type
  32. { TClassTreeEngine }
  33. TClassTreeEngine = class(TFPDocEngine)
  34. Private
  35. FClassTree : TXMLDocument;
  36. FTreeStart : TDomElement;
  37. FObjects : TStringList;
  38. FObjectKind : TPasObjKind;
  39. FParentObject : TPasClassType;
  40. function LookForElement(PE: TDomElement; AElement: TPasElement): TDomNode;
  41. function NodeMatch(N: TDomNode; AElement: TPasElement): Boolean;
  42. Function AddToClassTree(AElement : TPasElement; Var ACount : Integer) : TDomElement;
  43. public
  44. Constructor Create(AClassTree : TXMLDocument; AObjectKind : TPasObjKind);
  45. Destructor Destroy; override;
  46. Function BuildTree : Integer;
  47. function CreateElement(AClass: TPTreeElement; const AName: String;
  48. AParent: TPasElement; AVisibility :TPasMemberVisibility;
  49. const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement; override;
  50. end;
  51. { TClassChartFormatter }
  52. TClassMode = (cmNormal,cmSubClass,cmheadClass,cmFirstClass);
  53. TClassChartFormatter = Class (TObject)
  54. private
  55. FClassMode: TClassMode;
  56. FClassTree: TXMLDocument;
  57. FCurrentColCount: Integer;
  58. FCurrentRowCount: Integer;
  59. FFileName: String;
  60. FLargeHeadClassObjects: TStrings;
  61. FLevel: Integer;
  62. FMaxObjectsPerColumn: Integer;
  63. FStartColumnObjects: TStrings;
  64. Protected
  65. procedure FirstClass(E : TDomElement); virtual;
  66. procedure DoEmitClass(E : TDomElement); virtual;
  67. procedure DoHeadClass(E: TDomElement); virtual;
  68. procedure DoNextColumn(E: TDomElement); virtual;
  69. procedure EndSubClass(E: TDomElement; HasSiblings : Boolean); virtual;
  70. procedure StartSubClass(E: TDomElement); virtual;
  71. Procedure StartChart; virtual;
  72. Procedure EndChart; virtual;
  73. procedure EmitClass(E : TDomElement; HasSiblings : Boolean);
  74. Public
  75. Constructor Create (AXML : TXMLDocument); virtual;
  76. Destructor Destroy; override;
  77. Procedure CreateChart;
  78. Property CurrentColCount : Integer Read FCurrentColCount;
  79. Property CurrentRowCount : Integer Read FCurrentRowCount;
  80. Property ClassTree : TXMLDocument Read FClassTree;
  81. Property Level : Integer Read FLevel Write FLevel;
  82. Property ClassMode : TClassMode Read FClassMode;
  83. Published
  84. Property FileName : String Read FFileName Write FFilename;
  85. Property StartColumnObjects : TStrings Read FStartColumnObjects;
  86. Property LargeHeadClassObjects : TStrings Read FLargeHeadClassObjects;
  87. Property MaxObjectsPerColumn : Integer Read FMaxObjectsPerColumn Write FMaxObjectsPerColumn;
  88. end;
  89. { TChartFormatter }
  90. constructor TClassChartFormatter.Create(AXML: TXMLDocument);
  91. begin
  92. FClassTree:=AXML;
  93. MaxObjectsPerColumn:=60;
  94. FStartColumnObjects:=TStringList.Create;
  95. FLargeHeadClassObjects:=TStringList.Create;
  96. FLargeHeadClassObjects.Add('TPersistent');
  97. FLargeHeadClassObjects.Add('TComponent');
  98. end;
  99. destructor TClassChartFormatter.Destroy;
  100. begin
  101. FreeAndNil(FStartColumnObjects);
  102. FreeAndNil(FLargeHeadClassObjects);
  103. Inherited;
  104. end;
  105. procedure TClassChartFormatter.CreateChart;
  106. Var
  107. N : TDomNode;
  108. E : TDomElement;
  109. I : Integer;
  110. L : TFPList;
  111. begin
  112. (FStartColumnObjects as TStringList).Sorted:=False;
  113. (FLargeHeadClassObjects as TStringList).Sorted:=False;
  114. StartChart;
  115. try
  116. N:=FClassTree.DocumentElement.FirstChild;
  117. FCurrentColCount:=0;
  118. FCurrentRowCount:=0;
  119. FLevel:=0;
  120. L:=TFPList.Create;
  121. try
  122. While (N<>nil) do
  123. begin
  124. If (N.NodeType=ELEMENT_NODE) then
  125. L.Add(N);
  126. N:=N.NextSibling;
  127. end;
  128. If (L.Count>0) then
  129. begin
  130. FirstClass(TDomElement(L[0]));
  131. For I:=0 to L.Count-1 do
  132. EmitClass(TDomElement(L[i]),I<L.Count-1);
  133. end;
  134. finally
  135. L.Free;
  136. end;
  137. L:=TFPList.Create;
  138. try
  139. For I:=0 to FLargeHeadClassObjects.Count-1 do
  140. If Assigned(FLargeHeadClassObjects.Objects[i]) then
  141. L.Add(FLargeHeadClassObjects.Objects[i]);
  142. FLargeHeadClassObjects.Clear;
  143. For I:=0 to L.Count-1 do
  144. begin
  145. E:= TDomElement(L[i]);
  146. DoHeadClass(E);
  147. EmitClass(E,I<L.Count-1);
  148. end;
  149. finally
  150. L.Free;
  151. end;
  152. finally
  153. EndChart;
  154. end;
  155. end;
  156. procedure TClassChartFormatter.FirstClass(E : TDomElement);
  157. begin
  158. FClassMode:=cmFirstClass;
  159. end;
  160. procedure TClassChartFormatter.DoEmitClass(E : TDomElement);
  161. begin
  162. //Reset
  163. FClassMode:=cmNormal;
  164. end;
  165. procedure TClassChartFormatter.DoHeadClass(E : TDomElement);
  166. begin
  167. DoNextColumn(E);
  168. FClassMode:=cmHeadClass;
  169. // Do nothing
  170. end;
  171. procedure TClassChartFormatter.StartSubClass(E : TDomElement);
  172. begin
  173. FClassMode:=cmSubClass;
  174. end;
  175. procedure TClassChartFormatter.EndSubClass(E : TDomElement; HasSiblings : Boolean);
  176. begin
  177. FClassMode:=cmNormal;
  178. end;
  179. procedure TClassChartFormatter.DoNextColumn(E : TDomElement);
  180. begin
  181. Inc(FCurrentColCount);
  182. FCurrentRowCount:=0;
  183. end;
  184. procedure TClassChartFormatter.StartChart;
  185. begin
  186. // Do nothing
  187. end;
  188. procedure TClassChartFormatter.EndChart;
  189. begin
  190. // Do nothing
  191. end;
  192. procedure TClassChartFormatter.EmitClass(E : TDomElement; HasSiblings: Boolean);
  193. Var
  194. DidSub : Boolean;
  195. N : TDomNode;
  196. I : Integer;
  197. L : TFPList;
  198. begin
  199. Inc(Flevel);
  200. try
  201. I:=FStartColumnObjects.IndexOf(E.NodeName);
  202. if (-1<>I) or ((FCurrentRowCount>MaxObjectsPerColumn) and (FLevel=2)) then
  203. DoNextColumn(E)
  204. else
  205. begin
  206. I:=FLargeHeadClassObjects.IndexOf(E.NodeName);
  207. if (-1<>I) then
  208. begin
  209. FLargeHeadClassObjects.Objects[i]:=E;
  210. Exit; // Must be picked up later.
  211. end;
  212. end;
  213. DoEmitClass(E);
  214. N:=E.FirstChild;
  215. DidSub:=False;
  216. L:=TFPList.Create;
  217. try
  218. While (N<>Nil) do
  219. begin
  220. if (N.NodeType=ELEMENT_NODE) then
  221. L.Add(N);
  222. N:=N.NextSibling;
  223. end;
  224. If L.Count>0 then
  225. begin
  226. StartSubClass(TDomElement(L[0]));
  227. For I:=0 to L.Count-1 do
  228. begin
  229. EmitClass(TDomElement(L[i]),I<L.Count-1);
  230. FClassMode:=cmNormal;
  231. end;
  232. EndSubClass(E,HasSiblings);
  233. end;
  234. Finally
  235. L.Free;
  236. end;
  237. Inc(FCurrentRowCount);
  238. finally
  239. Dec(Flevel);
  240. end;
  241. end;
  242. Type
  243. { TPostScriptClassChartFormatter }
  244. TPostScriptClassChartFormatter = Class(TClassChartFormatter)
  245. FFile : Text;
  246. FMode : TClassMode;
  247. FIndent : Integer;
  248. Procedure EmitLine(S : String);
  249. Protected
  250. procedure DoEmitClass(E : TDomElement); override;
  251. procedure DoNextColumn(E: TDomElement); override;
  252. procedure DoHeadClass(E: TDomElement); override;
  253. procedure StartSubClass(E: TDomElement); override;
  254. procedure EndSubClass(E: TDomElement; HasSiblings : Boolean); override;
  255. Procedure StartChart; override;
  256. Procedure EndChart; override;
  257. end;
  258. { TPostScriptClassChartFormatter }
  259. procedure TPostScriptClassChartFormatter.EmitLine(S: String);
  260. begin
  261. Writeln(FFile,StringofChar(' ',Findent*2),S);
  262. end;
  263. procedure TPostScriptClassChartFormatter.DoEmitClass(E: TDomElement);
  264. begin
  265. Case ClassMode of
  266. cmFirstClass : EmitLine(Format('(%s) Ready drawlargebox',[E.NodeName]));
  267. cmNormal : EmitLine(Format('(%s) Ready newclass',[E.NodeName]));
  268. cmSubClass : EmitLine(Format('(%s) Ready newchildclass',[E.NodeName]));
  269. cmHeadClass : EmitLine(Format('(%s) Ready newlargeheadclass',[E.NodeName]));
  270. end;
  271. end;
  272. procedure TPostScriptClassChartFormatter.DoNextColumn(E: TDomElement);
  273. begin
  274. Inherited;
  275. FIndent:=0;
  276. EmitLine('newcolumn');
  277. end;
  278. procedure TPostScriptClassChartFormatter.DoHeadClass(E: TDomElement);
  279. begin
  280. // DoNextColumn(E);
  281. inherited DoHeadClass(E);
  282. end;
  283. procedure TPostScriptClassChartFormatter.EndSubClass(E: TDomElement; HasSiblings : Boolean);
  284. begin
  285. if HasSiblings then
  286. EmitLine('onelevelback')
  287. else
  288. EmitLine('onelevelbackempty');
  289. If FIndent>0 then
  290. Dec(Findent);
  291. end;
  292. procedure TPostScriptClassChartFormatter.StartSubClass(E: TDomElement);
  293. begin
  294. inherited StartSubClass(E);
  295. Inc(Findent);
  296. end;
  297. procedure TPostScriptClassChartFormatter.StartChart;
  298. begin
  299. Assign(FFile,FileName);
  300. Rewrite(FFile);
  301. end;
  302. procedure TPostScriptClassChartFormatter.EndChart;
  303. begin
  304. Close(FFile);
  305. end;
  306. type
  307. { TGraphVizClassChartFormatter }
  308. TGraphVizClassChartFormatter = class(TClassChartFormatter)
  309. FFile : Text;
  310. FMode : TClassMode;
  311. FIndent : integer;
  312. Procedure EmitLine(S : string);
  313. Protected
  314. procedure DoEmitClass(E : TDomElement); override;
  315. procedure DoNextColumn(E: TDomElement); override;
  316. procedure DoHeadClass(E: TDomElement); override;
  317. procedure StartSubClass(E: TDomElement); override;
  318. procedure EndSubClass(E: TDomElement; HasSiblings : Boolean); override;
  319. Procedure StartChart; override;
  320. Procedure EndChart; override;
  321. end;
  322. { TGraphVizClassChartFormatter }
  323. procedure TGraphVizClassChartFormatter.EmitLine(S: String);
  324. begin
  325. Writeln(FFile,StringofChar(' ',Findent*2),S);
  326. end;
  327. procedure TGraphVizClassChartFormatter.DoEmitClass(E: TDomElement);
  328. begin
  329. Case ClassMode of
  330. cmFirstClass : EmitLine(Format('%s -> %s', [E.ParentNode.NodeName, E.NodeName]));
  331. cmNormal : EmitLine(Format('%s -> %s', [E.ParentNode.NodeName, E.NodeName]));
  332. cmSubClass : EmitLine(Format('%s -> %s', [E.ParentNode.NodeName, E.NodeName]));
  333. cmHeadClass : EmitLine(Format('%s -> %s', [E.ParentNode.NodeName, E.NodeName]));
  334. end;
  335. end;
  336. procedure TGraphVizClassChartFormatter.DoNextColumn(E: TDomElement);
  337. begin
  338. Inherited;
  339. FIndent:=0;
  340. end;
  341. procedure TGraphVizClassChartFormatter.DoHeadClass(E: TDomElement);
  342. begin
  343. // DoNextColumn(E);
  344. inherited DoHeadClass(E);
  345. end;
  346. procedure TGraphVizClassChartFormatter.EndSubClass(E: TDomElement; HasSiblings : Boolean);
  347. begin
  348. If FIndent>0 then
  349. Dec(Findent);
  350. end;
  351. procedure TGraphVizClassChartFormatter.StartSubClass(E: TDomElement);
  352. begin
  353. inherited StartSubClass(E);
  354. Inc(Findent);
  355. end;
  356. procedure TGraphVizClassChartFormatter.StartChart;
  357. begin
  358. Assign(FFile,FileName);
  359. Rewrite(FFile);
  360. EmitLine('digraph G {');
  361. end;
  362. procedure TGraphVizClassChartFormatter.EndChart;
  363. begin
  364. EmitLine('}');
  365. Close(FFile);
  366. end;
  367. Type
  368. TOutputFormat = (ofXML,ofPostscript, ofGraphViz);
  369. Var
  370. OutputFormat : TOutputFormat = ofXML;
  371. const
  372. OSTarget: String = {$I %FPCTARGETOS%};
  373. CPUTarget: String = {$I %FPCTARGETCPU%};
  374. FPCVersion: String = {$I %FPCVERSION%};
  375. FPCDate: String = {$I %FPCDATE%};
  376. function TClassTreeEngine.CreateElement(AClass: TPTreeElement; const AName: String;
  377. AParent: TPasElement; AVisibility : TPasMemberVisibility;
  378. const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
  379. Var
  380. DN : TDocNode;
  381. begin
  382. Result := AClass.Create(AName, AParent);
  383. Result.Visibility:=AVisibility;
  384. if AClass.InheritsFrom(TPasModule) then
  385. CurModule := TPasModule(Result);
  386. If AClass.InheritsFrom(TPasClassType) then
  387. FObjects.AddObject(AName,Result);
  388. end;
  389. Constructor TClassTreeEngine.Create(AClassTree : TXMLDocument; AObjectKind : TPasObjKind);
  390. Var
  391. N : TDomNode;
  392. begin
  393. FClassTree:=AClassTree;
  394. FTreeStart:=FClassTree.DocumentElement;
  395. FPackage:=TPasPackage.Create('dummy',Nil);
  396. FObjectKind:=AObjectKind;
  397. FObjects:=TStringList.Create;
  398. Case FObjectkind of
  399. okObject : FParentObject:=TPasClassType.Create('TObject',FPackage);
  400. okClass : FParentObject:=TPasClassType.Create('TObject',FPackage);
  401. okInterface : FParentObject:=TPasClassType.Create('IInterface',FPackage);
  402. end;
  403. FParentObject.ObjKind:=FObjectKind;
  404. Inherited Create;
  405. end;
  406. destructor TClassTreeEngine.Destroy;
  407. begin
  408. FreeAndNil(FObjects);
  409. inherited Destroy;
  410. end;
  411. Function TClassTreeEngine.BuildTree : Integer;
  412. Var
  413. I : Integer;
  414. PC : TPasClassType;
  415. begin
  416. Result:=0;
  417. FObjects.Sorted:=True;
  418. For I:=0 to FObjects.Count-1 do
  419. begin
  420. PC:=TPasClassType(FObjects.Objects[i]);
  421. If (PC.ObjKind=FObjectKind) and Not PC.IsForward then
  422. AddToClassTree(PC as TPasElement,Result)
  423. end;
  424. end;
  425. Function TClassTreeEngine.NodeMatch(N : TDomNode; AElement : TPasElement) : Boolean;
  426. begin
  427. Result:=(N.NodeType=ELEMENT_NODE) and (CompareText(N.NodeName,AElement.Name)=0)
  428. end;
  429. Function TClassTreeEngine.LookForElement(PE : TDomElement; AElement : TPasElement) : TDomNode;
  430. Var
  431. N : TDomNode;
  432. begin
  433. Result:=PE.FirstChild;
  434. While (Result<>Nil) and Not NodeMatch(Result,AElement) do
  435. Result:=Result.NextSibling;
  436. If (Result=Nil) then
  437. begin
  438. N:=PE.FirstChild;
  439. While (Result=Nil) and (N<>Nil) do
  440. begin
  441. if (N.NodeType=ELEMENT_NODE) then
  442. begin
  443. Result:=LookForElement(N as TDomElement,AElement);
  444. end;
  445. N:=N.NextSibling;
  446. end;
  447. end
  448. end;
  449. Function TClassTreeEngine.AddToClassTree(AElement : TPasElement; Var ACount : Integer) : TDomElement;
  450. Var
  451. PC : TPasClassType;
  452. PE : TDomElement;
  453. M : TPasModule;
  454. N : TDomNode;
  455. begin
  456. PE:=Nil;
  457. If (AElement is TPasClassType) then
  458. begin
  459. PC:=AElement as TPasClassType;
  460. If not Assigned(PC.AncestorType) and (CompareText(PC.Name,FParentObject.Name)<>0) then
  461. PC.AncestorType:=FParentObject;
  462. If Assigned(PC.AncestorType) then
  463. PE:=AddToClassTree(PC.AncestorType,ACount);
  464. end;
  465. If (PE=Nil) then
  466. PE:=FTreeStart;
  467. N:=LookForElement(PE,AElement);
  468. If (N<>Nil) then
  469. Result:=N as TDomElement
  470. else
  471. begin
  472. Inc(ACount);
  473. Result:=FClassTree.CreateElement(AElement.Name);
  474. If Not (AElement is TPasUnresolvedTypeRef) then
  475. begin
  476. M:=AElement.GetModule;
  477. if Assigned(M) then
  478. Result['unit']:=M.Name;
  479. end;
  480. PE.AppendChild(Result);
  481. end;
  482. end;
  483. { ---------------------------------------------------------------------
  484. Main program. Document all units.
  485. ---------------------------------------------------------------------}
  486. Function MergeNodes(Doc : TXMLDocument;Dest,Source : TDomElement) : Integer;
  487. Var
  488. N : TDomNode;
  489. S,E : TDomElement;
  490. begin
  491. N:=Source.FirstChild;
  492. While (N<>Nil) do
  493. begin
  494. if (N.NodeType=ELEMENT_NODE) then
  495. begin
  496. S:=N as TDomElement;
  497. E:=Dest.FindNode(N.NodeName) as TDomElement;
  498. If (E=Nil) then
  499. begin
  500. E:=Doc.CreateElement(N.NodeName);
  501. If S['unit']<>'' then
  502. E['Unit']:=S['unit'];
  503. Dest.AppendChild(E);
  504. Inc(Result);
  505. end;
  506. Result:=Result+MergeNodes(Doc,E,S);
  507. end;
  508. N:=N.NextSibling;
  509. end;
  510. end;
  511. Function MergeTrees (Dest,Source : TXMLDocument) : Integer;
  512. Var
  513. S,D : TDomElement;
  514. Count : Integer;
  515. begin
  516. Result:=0;
  517. D:=Dest.DocumentElement;
  518. S:=Source.DocumentElement;
  519. If (S.NodeName=D.NodeName) then
  520. Result:=MergeNodes(Dest,D,S)
  521. else
  522. Writeln(StdErr,Format(SSkipMerge,[S.NodeName,D.NodeName]));
  523. end;
  524. Function AnalyseFiles(Const AOutputName : String; InputFiles,MergeFiles : TStrings; AObjectKind : TPasObjKind) : String;
  525. Var
  526. XML,XML2 : TXMLDocument;
  527. I,ACount : Integer;
  528. Engine: TClassTreeEngine;
  529. begin
  530. XML:=TXMLDocument.Create;
  531. Try
  532. //XML.
  533. XML.AppendChild(XML.CreateElement(RootNames[AObjectKind]));
  534. For I:=0 to MergeFiles.Count-1 do
  535. begin
  536. XMl2:=TXMLDocument.Create;
  537. ReadXMLFile(XML2,MergeFiles[i]);
  538. try
  539. ACount:=MergeTrees(XML,XML2);
  540. WriteLn(StdErr,Format(SMergedFile,[ACount,MergeFiles[i]]));
  541. Finally
  542. FreeAndNil(XML2);
  543. end;
  544. end;
  545. ACount:=0;
  546. For I:=0 to InputFiles.Count-1 do
  547. begin
  548. Engine := TClassTreeEngine.Create(XML,AObjectKind);
  549. Try
  550. ParseSource(Engine,InputFiles[I],OSTarget,CPUTarget);
  551. ACount:=ACount+Engine.BuildTree;
  552. Finally
  553. Engine.Free;
  554. end;
  555. end;
  556. Case OutputFormat of
  557. ofXML :
  558. WriteXMlFile(XML,AOutputName);
  559. ofPostScript :
  560. With TPostScriptClassChartFormatter.Create(XML) do
  561. try
  562. FileName:=AOutputName;
  563. CreateChart;
  564. finally
  565. Free;
  566. end;
  567. ofGraphViz :
  568. With TGraphVizClassChartFormatter.Create(XML) do
  569. try
  570. FileName:=AOutputName;
  571. CreateChart;
  572. finally
  573. Free;
  574. end;
  575. end;
  576. Writeln(StdErr,Format(SClassesAdded,[ACount,InputFiles.Count]));
  577. Finally
  578. XML.Free;
  579. end;
  580. end;
  581. { ---------------------------------------------------------------------
  582. Option management
  583. ---------------------------------------------------------------------}
  584. var
  585. cmdObjectKind : TPasObjKind;
  586. InputFiles,
  587. MergeFiles : TStringList;
  588. DocLang : String;
  589. PackageName,
  590. OutputName: String;
  591. procedure InitOptions;
  592. begin
  593. InputFiles := TStringList.Create;
  594. MergeFiles := TStringList.Create;
  595. end;
  596. procedure FreeOptions;
  597. begin
  598. MergeFiles.Free;
  599. InputFiles.Free;
  600. end;
  601. { ---------------------------------------------------------------------
  602. Usage
  603. ---------------------------------------------------------------------}
  604. Procedure Usage;
  605. begin
  606. Writeln('Usage : ',ExtractFileName(Paramstr(0)),' [options]');
  607. Writeln('Where [options] is one or more of :');
  608. Writeln(' --merge=filename Filename with object tree to merge.');
  609. Writeln(' --help Emit help.');
  610. Writeln(' --input=cmdline Input file to create skeleton for.');
  611. Writeln(' Use options are as for compiler.');
  612. Writeln(' --kind=objectkind Specify object kind. One of object, class, interface.');
  613. Writeln(' --lang=language Use selected language.');
  614. Writeln(' --output=filename Send output to file.');
  615. Writeln(' --format=name Kind of output to create: XML, PostScript, GraphViz.');
  616. end;
  617. procedure ParseOption(const s: String);
  618. procedure AddToFileList(List: TStringList; const FileName: String);
  619. var
  620. f: Text;
  621. s: String;
  622. begin
  623. if Copy(FileName, 1, 1) = '@' then
  624. begin
  625. Assign(f, Copy(FileName, 2, Length(FileName)));
  626. Reset(f);
  627. while not EOF(f) do
  628. begin
  629. ReadLn(f, s);
  630. List.Add(s);
  631. end;
  632. Close(f);
  633. end else
  634. List.Add(FileName);
  635. end;
  636. var
  637. i: Integer;
  638. Cmd, Arg: String;
  639. begin
  640. cmdObjectKind:=okClass;
  641. if (s = '-h') or (s = '--help') then
  642. begin
  643. Usage;
  644. Halt(0);
  645. end;
  646. i := Pos('=', s);
  647. if i > 0 then
  648. begin
  649. Cmd := Copy(s, 1, i - 1);
  650. Arg := Copy(s, i + 1, Length(s));
  651. end else
  652. begin
  653. Cmd := s;
  654. SetLength(Arg, 0);
  655. end;
  656. if (Cmd = '-i') or (Cmd = '--input') then
  657. AddToFileList(InputFiles, Arg)
  658. else if (Cmd = '-l') or (Cmd = '--lang') then
  659. DocLang := Arg
  660. else if (Cmd = '-o') or (Cmd = '--output') then
  661. OutputName := Arg
  662. else if (Cmd = '-k') or (Cmd = '--kind') then
  663. cmdObjectKind:=TPasObjKind(GetEnumValue(TypeInfo(TPasObjKind),'ok'+Arg))
  664. else if (Cmd = '-f') or (Cmd = '--format') then
  665. OutputFormat:=TOutputFormat(GetEnumValue(TypeInfo(TOutputFormat),'of'+Arg))
  666. else if Cmd = '--merge' then
  667. begin
  668. if FileExists(Arg) then
  669. MergeFiles.Add(Arg)
  670. else
  671. Writeln(StdErr,Format(SErrNoSuchMergeFile,[arg]));
  672. end
  673. else
  674. begin
  675. WriteLn(StdErr, Format(SCmdLineInvalidOption, [s]));
  676. Usage;
  677. Halt(1);
  678. end;
  679. end;
  680. Function ParseCommandLine : Integer;
  681. Const
  682. {$IFDEF Unix}
  683. MoFileTemplate = '/usr/local/share/locale/%s/LC_MESSAGES/makeskel.mo';
  684. {$ELSE}
  685. MoFileTemplate ='intl/makeskel.%s.mo';
  686. {$ENDIF}
  687. var
  688. MOFilename: string;
  689. i: Integer;
  690. begin
  691. Result:=0;
  692. if ParamCount=0 then
  693. begin
  694. Usage;
  695. Halt(0);
  696. end;
  697. DocLang:='';
  698. for i := 1 to ParamCount do
  699. ParseOption(ParamStr(i));
  700. If (DocLang<>'') then
  701. begin
  702. MOFilename:=Format(MOFileTemplate,[DocLang]);
  703. if FileExists(MOFilename) then
  704. gettext.TranslateResourceStrings(MoFileName)
  705. else
  706. writeln('NOTE: unable to find tranlation file ',MOFilename);
  707. // Translate internal documentation strings
  708. TranslateDocStrings(DocLang);
  709. end;
  710. end;
  711. { ---------------------------------------------------------------------
  712. Main Program
  713. ---------------------------------------------------------------------}
  714. Procedure Run;
  715. var
  716. E: Integer;
  717. begin
  718. WriteLn(STitle);
  719. WriteLn(Format(SVersion, [FPCVersion, FPCDate]));
  720. WriteLn(SCopyright);
  721. InitOptions;
  722. Try
  723. E:=ParseCommandLine;
  724. If E<>0 then
  725. Halt(E);
  726. WriteLn;
  727. AnalyseFiles(OutputName,InputFiles,MergeFiles,cmdObjectKind);
  728. WriteLn(StdErr,SDone);
  729. Finally
  730. FreeOptions;
  731. end;
  732. end;
  733. Begin
  734. Run;
  735. end.