fpclasschart.pp 21 KB

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