dglobals.pp 32 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198
  1. {
  2. $Id$
  3. FPDoc - Free Pascal Documentation Tool
  4. Copyright (C) 2000 - 2002 by
  5. Areca Systems GmbH / Sebastian Guenther, [email protected]
  6. * Global declarations
  7. * Link list management
  8. * Document node tree
  9. * Main engine
  10. See the file COPYING, included in this distribution,
  11. for details about the copyright.
  12. This program is distributed in the hope that it will be useful,
  13. but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  15. }
  16. {$MODE objfpc}
  17. {$H+}
  18. unit dGlobals;
  19. interface
  20. uses Classes, DOM, PasTree, PParser;
  21. resourcestring
  22. // Output strings
  23. SDocPackageTitle = 'Reference for package ''%s''';
  24. SDocPrograms = 'Programs';
  25. SDocUnits = 'Units';
  26. SDocUnitTitle = 'Reference for unit ''%s''';
  27. SDocInterfaceSection = 'Interface section';
  28. SDocImplementationSection = 'Implementation section';
  29. SDocUsedUnits = 'Used units';
  30. SDocUsedUnitsByUnitXY = 'Used units by unit ''%s''';
  31. SDocConstsTypesVars = 'Constants, types and variables';
  32. SDocResStrings = 'Resource strings';
  33. SDocTypes = 'Types';
  34. SDocConstants = 'Constants';
  35. SDocClasses = 'Classes';
  36. SDocProceduresAndFunctions = 'Procedures and functions';
  37. SDocVariables = 'Variables';
  38. SDocUnitOverview = 'Overview of unit ''%s''';
  39. SDocOverview = 'Overview';
  40. SDocSearch = 'Search';
  41. SDocDeclaration = 'Declaration';
  42. SDocDescription = 'Description';
  43. SDocErrors = 'Errors';
  44. SDocSeeAlso = 'See also';
  45. SDocExample = 'Example';
  46. SDocArguments = 'Arguments';
  47. SDocFunctionResult = 'Function result';
  48. SDocRemark = 'Remark: ';
  49. SDocMethodOverview = 'Method overview';
  50. SDocPropertyOverview = 'Property overview';
  51. SDocPage = 'Page';
  52. SDocMethod = 'Method';
  53. SDocProperty = 'Property';
  54. SDocAccess = 'Access';
  55. SDocInheritance = 'Inheritance';
  56. SDocProperties = 'Properties';
  57. SDocMethods = 'Methods';
  58. SDocEvents = 'Events';
  59. SDocByName = 'by Name';
  60. SDocValue = 'Value';
  61. SDocExplanation = 'Explanation';
  62. SDocProcedure = 'Procedure';
  63. SDocValuesForEnum = 'Enumeration values for type %s';
  64. SDocSourcePosition = 'Source position: %s line %d';
  65. SDocSynopsis = 'Synopsis';
  66. SDocVisibility = 'Visibility';
  67. // Topics
  68. SDocRelatedTopics = 'Related topics';
  69. SDocUp = 'Up';
  70. SDocNext = 'Next';
  71. SDocPrevious = 'Previous';
  72. Const
  73. SVisibility: array[TPasMemberVisibility] of string =
  74. ('Default', 'Private', 'Protected', 'Public',
  75. 'Published', 'Automated');
  76. type
  77. // Assumes a list of TObject instances and frees them on destruction
  78. TObjectList = class(TList)
  79. public
  80. destructor Destroy; override;
  81. end;
  82. { Link entry tree
  83. TFPDocEngine stores the root of the entry tree in its property
  84. "RootLinkNode". The root has one child node for each package, for which
  85. documentation links are available. The children of a package node
  86. are module nodes; and the children of a module node are the top-level
  87. declarations of this module; the next level in the tree stores e.g. record
  88. members, and so on...
  89. }
  90. TLinkNode = class
  91. private
  92. FFirstChild, FNextSibling: TLinkNode;
  93. FName: String;
  94. FLink: String;
  95. public
  96. constructor Create(const AName, ALink: String);
  97. destructor Destroy; override;
  98. function FindChild(const APathName: String): TLinkNode;
  99. function CreateChildren(const APathName, ALinkTo: String): TLinkNode;
  100. // Properties for tree structure
  101. property FirstChild: TLinkNode read FFirstChild;
  102. property NextSibling: TLinkNode read FNextSibling;
  103. // Link properties
  104. property Name: String read FName;
  105. property Link: String read FLink;
  106. end;
  107. { Documentation entry tree
  108. TFPDocEngine stores the root of the entry tree in its property
  109. "RootDocNode". The root has one child node for each package, for which
  110. documentation is being provided by the user. The children of a package node
  111. are module nodes; and the children of a module node are the top-level
  112. declarations of this module; the next level in the tree stores e.g. record
  113. members, and so on...
  114. }
  115. TDocNode = class
  116. private
  117. FFirstChild, FNextSibling: TDocNode;
  118. FName: String;
  119. FNode: TDOMElement;
  120. FIsSkipped: Boolean;
  121. FShortDescr: TDOMElement;
  122. FDescr: TDOMElement;
  123. FErrorsDoc: TDOMElement;
  124. FSeeAlso: TDOMElement;
  125. FFirstExample: TDOMElement;
  126. FLink: String;
  127. FTopicNode : Boolean;
  128. public
  129. constructor Create(const AName: String; ANode: TDOMElement);
  130. destructor Destroy; override;
  131. function FindChild(const APathName: String): TDocNode;
  132. function CreateChildren(const APathName: String): TDocNode;
  133. // Properties for tree structure
  134. property FirstChild: TDocNode read FFirstChild;
  135. property NextSibling: TDocNode read FNextSibling;
  136. // Basic properties
  137. property Name: String read FName;
  138. property Node: TDOMElement read FNode;
  139. // Data fetched from the XML document
  140. property IsSkipped: Boolean read FIsSkipped;
  141. property ShortDescr: TDOMElement read FShortDescr;
  142. property Descr: TDOMElement read FDescr;
  143. property ErrorsDoc: TDOMElement read FErrorsDoc;
  144. property SeeAlso: TDOMElement read FSeeAlso;
  145. property FirstExample: TDOMElement read FFirstExample;
  146. property Link: String read FLink;
  147. Property TopicNode : Boolean Read FTopicNode;
  148. end;
  149. // The main FPDoc engine
  150. TFPDocEngine = class(TPasTreeContainer)
  151. protected
  152. DescrDocs: TObjectList; // List of XML documents
  153. DescrDocNames: TStringList; // Names of the XML documents
  154. FRootLinkNode: TLinkNode;
  155. FRootDocNode: TDocNode;
  156. FPackages: TList; // List of TFPPackage objects
  157. CurModule: TPasModule;
  158. CurPackageDocNode: TDocNode;
  159. public
  160. constructor Create;
  161. destructor Destroy; override;
  162. procedure SetPackageName(const APackageName: String);
  163. procedure ReadContentFile(const AFilename, ALinkPrefix: String);
  164. procedure WriteContentFile(const AFilename: String);
  165. function CreateElement(AClass: TPTreeElement; const AName: String;
  166. AParent: TPasElement; AVisibility: TPasMemberVisibility;
  167. const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
  168. override;
  169. function FindElement(const AName: String): TPasElement; override;
  170. function FindModule(const AName: String): TPasModule; override;
  171. // Link tree support
  172. procedure AddLink(const APathName, ALinkTo: String);
  173. function FindAbsoluteLink(const AName: String): String;
  174. function ResolveLink(AModule: TPasModule; const ALinkDest: String): String;
  175. // Documentation file support
  176. procedure AddDocFile(const AFilename: String);
  177. // Documentation retrieval
  178. function FindDocNode(AElement: TPasElement): TDocNode;
  179. function FindDocNode(ARefModule: TPasModule; const AName: String): TDocNode;
  180. function FindShortDescr(AElement: TPasElement): TDOMElement;
  181. function FindShortDescr(ARefModule: TPasModule;
  182. const AName: String): TDOMElement;
  183. function GetExampleFilename(const ExElement: TDOMElement): String;
  184. property RootLinkNode: TLinkNode read FRootLinkNode;
  185. property RootDocNode: TDocNode read FRootDocNode;
  186. property Package: TPasPackage read FPackage;
  187. Output: String;
  188. HasContentFile: Boolean;
  189. HidePrivate: Boolean; // Hide private class members in output?
  190. HideProtected: Boolean; // Hide protected class members in output?
  191. WarnNoNode : Boolean; // Warn if no description node found for element.
  192. end;
  193. procedure TranslateDocStrings(const Lang: String);
  194. implementation
  195. uses SysUtils, Gettext, XMLRead;
  196. { TObjectList }
  197. destructor TObjectList.Destroy;
  198. var
  199. i: Integer;
  200. begin
  201. for i := 0 to Count - 1 do
  202. TObject(Items[i]).Free;
  203. inherited Destroy;
  204. end;
  205. { TLinkNode }
  206. constructor TLinkNode.Create(const AName, ALink: String);
  207. begin
  208. inherited Create;
  209. FName := AName;
  210. FLink := ALink;
  211. end;
  212. destructor TLinkNode.Destroy;
  213. begin
  214. if Assigned(FirstChild) then
  215. FirstChild.Free;
  216. if Assigned(NextSibling) then
  217. NextSibling.Free;
  218. inherited Destroy;
  219. end;
  220. function TLinkNode.FindChild(const APathName: String): TLinkNode;
  221. var
  222. DotPos: Integer;
  223. ChildName: String;
  224. Child: TLinkNode;
  225. begin
  226. if Length(APathName) = 0 then
  227. Result := Self
  228. else
  229. begin
  230. DotPos := Pos('.', APathName);
  231. if DotPos = 0 then
  232. ChildName := APathName
  233. else
  234. ChildName := Copy(APathName, 1, DotPos - 1);
  235. Child := FirstChild;
  236. while Assigned(Child) do
  237. begin
  238. if CompareText(Child.Name, ChildName) = 0 then
  239. begin
  240. if DotPos = 0 then
  241. Result := Child
  242. else
  243. Result := Child.FindChild(
  244. Copy(APathName, DotPos + 1, Length(APathName)));
  245. exit;
  246. end;
  247. Child := Child.NextSibling;
  248. end;
  249. Result := nil;
  250. end;
  251. end;
  252. function TLinkNode.CreateChildren(const APathName, ALinkTo: String): TLinkNode;
  253. var
  254. DotPos: Integer;
  255. ChildName: String;
  256. Child, LastChild: TLinkNode;
  257. begin
  258. if Length(APathName) = 0 then
  259. Result := Self
  260. else
  261. begin
  262. DotPos := Pos('.', APathName);
  263. if DotPos = 0 then
  264. ChildName := APathName
  265. else
  266. ChildName := Copy(APathName, 1, DotPos - 1);
  267. Child := FirstChild;
  268. LastChild := nil;
  269. while Assigned(Child) do
  270. begin
  271. if CompareText(Child.Name, ChildName) = 0 then
  272. begin
  273. if DotPos = 0 then
  274. Result := Child
  275. else
  276. Result := Child.CreateChildren(
  277. Copy(APathName, DotPos + 1, Length(APathName)), ALinkTo);
  278. exit;
  279. end;
  280. LastChild := Child;
  281. Child := Child.NextSibling;
  282. end;
  283. { No child found, let's create one if we are at the end of the path }
  284. if DotPos > 0 then
  285. // !!!: better throw an exception
  286. WriteLn('Link path does not exist: ', APathName);
  287. Result := TLinkNode.Create(ChildName, ALinkTo);
  288. if Assigned(LastChild) then
  289. LastChild.FNextSibling := Result
  290. else
  291. FFirstChild := Result;
  292. end;
  293. end;
  294. { TDocNode }
  295. constructor TDocNode.Create(const AName: String; ANode: TDOMElement);
  296. begin
  297. inherited Create;
  298. FName := AName;
  299. FNode := ANode;
  300. end;
  301. destructor TDocNode.Destroy;
  302. begin
  303. if Assigned(FirstChild) then
  304. FirstChild.Free;
  305. if Assigned(NextSibling) then
  306. NextSibling.Free;
  307. inherited Destroy;
  308. end;
  309. function TDocNode.FindChild(const APathName: String): TDocNode;
  310. var
  311. DotPos: Integer;
  312. ChildName: String;
  313. Child: TDocNode;
  314. begin
  315. if Length(APathName) = 0 then
  316. Result := Self
  317. else
  318. begin
  319. DotPos := Pos('.', APathName);
  320. if DotPos = 0 then
  321. ChildName := APathName
  322. else
  323. ChildName := Copy(APathName, 1, DotPos - 1);
  324. Child := FirstChild;
  325. while Assigned(Child) do
  326. begin
  327. if CompareText(Child.Name, ChildName) = 0 then
  328. begin
  329. if DotPos = 0 then
  330. Result := Child
  331. else
  332. Result := Child.FindChild(
  333. Copy(APathName, DotPos + 1, Length(APathName)));
  334. exit;
  335. end;
  336. Child := Child.NextSibling;
  337. end;
  338. Result := nil;
  339. end;
  340. end;
  341. function TDocNode.CreateChildren(const APathName: String): TDocNode;
  342. var
  343. DotPos: Integer;
  344. ChildName: String;
  345. Child: TDocNode;
  346. begin
  347. if Length(APathName) = 0 then
  348. Result := Self
  349. else
  350. begin
  351. DotPos := Pos('.', APathName);
  352. if DotPos = 0 then
  353. ChildName := APathName
  354. else
  355. ChildName := Copy(APathName, 1, DotPos - 1);
  356. Child := FirstChild;
  357. while Assigned(Child) do
  358. begin
  359. if CompareText(Child.Name, ChildName) = 0 then
  360. begin
  361. if DotPos = 0 then
  362. Result := Child
  363. else
  364. Result := Child.CreateChildren(
  365. Copy(APathName, DotPos + 1, Length(APathName)));
  366. exit;
  367. end;
  368. Child := Child.NextSibling;
  369. end;
  370. // No child found, let's create one
  371. Result := TDocNode.Create(ChildName, nil);
  372. if Assigned(FirstChild) then
  373. begin
  374. Result.FNextSibling := FirstChild;
  375. FFirstChild := Result;
  376. end else
  377. FFirstChild := Result;
  378. if DotPos > 0 then
  379. Result := Result.CreateChildren(
  380. Copy(APathName, DotPos + 1, Length(APathName)));
  381. end;
  382. end;
  383. { TFPDocEngine }
  384. constructor TFPDocEngine.Create;
  385. begin
  386. inherited Create;
  387. DescrDocs := TObjectList.Create;
  388. DescrDocNames := TStringList.Create;
  389. FRootLinkNode := TLinkNode.Create('', '');
  390. FRootDocNode := TDocNode.Create('', nil);
  391. HidePrivate := True;
  392. FPackages := TList.Create;
  393. end;
  394. destructor TFPDocEngine.Destroy;
  395. var
  396. i: Integer;
  397. begin
  398. for i := 0 to FPackages.Count - 1 do
  399. TPasPackage(FPackages[i]).Release;
  400. FPackages.Free;
  401. FRootDocNode.Free;
  402. FRootLinkNode.Free;
  403. DescrDocNames.Free;
  404. DescrDocs.Free;
  405. inherited Destroy;
  406. end;
  407. procedure TFPDocEngine.SetPackageName(const APackageName: String);
  408. begin
  409. ASSERT(not Assigned(Package));
  410. FPackage := TPasPackage(inherited CreateElement(TPasPackage,
  411. '#' + APackageName, nil, '', 0));
  412. FPackages.Add(FPackage);
  413. CurPackageDocNode := RootDocNode.FindChild('#' + APackageName);
  414. end;
  415. procedure TFPDocEngine.ReadContentFile(const AFilename, ALinkPrefix: String);
  416. var
  417. f: Text;
  418. procedure ReadLinkTree;
  419. var
  420. s: String;
  421. PrevSpaces, ThisSpaces, i, StackIndex: Integer;
  422. CurParent, PrevSibling, NewNode: TLinkNode;
  423. ParentStack, SiblingStack: array[0..7] of TLinkNode;
  424. begin
  425. PrevSpaces := 0;
  426. CurParent := RootLinkNode;
  427. PrevSibling := nil;
  428. StackIndex := 0;
  429. while True do
  430. begin
  431. ReadLn(f, s);
  432. if Length(s) = 0 then
  433. break;
  434. ThisSpaces := 0;
  435. while s[ThisSpaces + 1] = ' ' do
  436. Inc(ThisSpaces);
  437. if ThisSpaces <> PrevSpaces then
  438. begin
  439. if ThisSpaces > PrevSpaces then
  440. begin
  441. { Dive down one level }
  442. ParentStack[StackIndex] := CurParent;
  443. SiblingStack[StackIndex] := PrevSibling;
  444. Inc(StackIndex);
  445. CurParent := PrevSibling;
  446. PrevSibling := nil;
  447. end else
  448. while PrevSpaces > ThisSpaces do
  449. begin
  450. Dec(StackIndex);
  451. CurParent := ParentStack[StackIndex];
  452. PrevSibling := SiblingStack[StackIndex];
  453. Dec(PrevSpaces);
  454. end;
  455. PrevSpaces := ThisSpaces;
  456. end;
  457. i := ThisSpaces + 1;
  458. while s[i] <> ' ' do
  459. Inc(i);
  460. NewNode := TLinkNode.Create(Copy(s, ThisSpaces + 1, i - ThisSpaces - 1),
  461. ALinkPrefix + Copy(s, i + 1, Length(s)));
  462. if Assigned(PrevSibling) then
  463. PrevSibling.FNextSibling := NewNode
  464. else
  465. CurParent.FFirstChild := NewNode;
  466. PrevSibling := NewNode;
  467. end;
  468. end;
  469. procedure ReadClasses;
  470. function CreateClass(const AName: String): TPasClassType;
  471. var
  472. DotPos, DotPos2, i: Integer;
  473. s: String;
  474. Package: TPasPackage;
  475. Module: TPasModule;
  476. begin
  477. // Find or create package
  478. DotPos := Pos('.', AName);
  479. s := Copy(AName, 1, DotPos - 1);
  480. Package := nil;
  481. for i := 0 to FPackages.Count - 1 do
  482. if CompareText(TPasPackage(FPackages[i]).Name, s) = 0 then
  483. begin
  484. Package := TPasPackage(FPackages[i]);
  485. break;
  486. end;
  487. if not Assigned(Package) then
  488. begin
  489. Package := TPasPackage(inherited CreateElement(TPasPackage, s, nil,
  490. '', 0));
  491. FPackages.Add(Package);
  492. end;
  493. // Find or create module
  494. DotPos2 := DotPos;
  495. repeat
  496. Inc(DotPos2);
  497. until AName[DotPos2] = '.';
  498. s := Copy(AName, DotPos + 1, DotPos2 - DotPos - 1);
  499. Module := nil;
  500. for i := 0 to Package.Modules.Count - 1 do
  501. if CompareText(TPasModule(Package.Modules[i]).Name, s) = 0 then
  502. begin
  503. Module := TPasModule(Package.Modules[i]);
  504. break;
  505. end;
  506. if not Assigned(Module) then
  507. begin
  508. Module := TPasModule.Create(s, Package);
  509. Module.InterfaceSection := TPasSection.Create('', Module);
  510. Package.Modules.Add(Module);
  511. end;
  512. // Create node for class
  513. Result := TPasClassType.Create(Copy(AName, DotPos2 + 1, Length(AName)),
  514. Module.InterfaceSection);
  515. Result.ObjKind := okClass;
  516. Module.InterfaceSection.Declarations.Add(Result);
  517. Module.InterfaceSection.Classes.Add(Result);
  518. end;
  519. var
  520. s, Name: String;
  521. CurClass: TPasClassType;
  522. i: Integer;
  523. Member: TPasElement;
  524. begin
  525. CurClass := nil;
  526. while True do
  527. begin
  528. ReadLn(f, s);
  529. if Length(s) = 0 then
  530. break;
  531. if s[1] = '#' then
  532. begin
  533. // New class
  534. i := Pos(' ', s);
  535. CurClass := CreateClass(Copy(s, 1, i - 1));
  536. end else
  537. begin
  538. i := Pos(' ', s);
  539. if i = 0 then
  540. Name := Copy(s, 3, Length(s))
  541. else
  542. Name := Copy(s, 3, i - 3);
  543. case s[2] of
  544. 'M':
  545. Member := TPasProcedure.Create(Name, CurClass);
  546. 'P':
  547. begin
  548. Member := TPasProperty.Create(Name, CurClass);
  549. if i > 0 then
  550. while i <= Length(s) do
  551. begin
  552. case s[i] of
  553. 'r':
  554. TPasProperty(Member).ReadAccessorName := '<dummy>';
  555. 'w':
  556. TPasProperty(Member).WriteAccessorName := '<dummy>';
  557. 's':
  558. TPasProperty(Member).StoredAccessorName := '<dummy>';
  559. end;
  560. Inc(i);
  561. end;
  562. end;
  563. 'V':
  564. Member := TPasVariable.Create(Name, CurClass);
  565. else
  566. raise Exception.Create('Invalid member type: ' + s[2]);
  567. end;
  568. CurClass.Members.Add(Member);
  569. end;
  570. end;
  571. end;
  572. var
  573. s: String;
  574. begin
  575. Assign(f, AFilename);
  576. Reset(f);
  577. while not EOF(f) do
  578. begin
  579. ReadLn(f, s);
  580. if (Length(s) = 0) or (s[1] = '#') then
  581. continue;
  582. if s = ':link tree' then
  583. ReadLinkTree
  584. else if s = ':classes' then
  585. ReadClasses
  586. else
  587. repeat
  588. ReadLn(f, s);
  589. until EOF(f) or (Length(s) = 0);
  590. end;
  591. Close(f);
  592. end;
  593. procedure TFPDocEngine.WriteContentFile(const AFilename: String);
  594. var
  595. ContentFile: Text;
  596. procedure ProcessLinkNode(ALinkNode: TLinkNode; const AIdent: String);
  597. var
  598. ChildNode: TLinkNode;
  599. begin
  600. WriteLn(ContentFile, AIdent, ALinkNode.Name, ' ', ALinkNode.Link);
  601. ChildNode := ALinkNode.FirstChild;
  602. while Assigned(ChildNode) do
  603. begin
  604. ProcessLinkNode(ChildNode, AIdent + ' ');
  605. ChildNode := ChildNode.NextSibling;
  606. end;
  607. end;
  608. var
  609. LinkNode: TLinkNode;
  610. i, j, k: Integer;
  611. Module: TPasModule;
  612. ClassDecl: TPasClassType;
  613. Member: TPasElement;
  614. s: String;
  615. begin
  616. Assign(ContentFile, AFilename);
  617. Rewrite(ContentFile);
  618. try
  619. WriteLn(ContentFile, '# FPDoc Content File');
  620. WriteLn(ContentFile, ':link tree');
  621. LinkNode := RootLinkNode.FirstChild;
  622. while Assigned(LinkNode) do
  623. begin
  624. if LinkNode.Name = Package.Name then
  625. begin
  626. ProcessLinkNode(LinkNode, '');
  627. end;
  628. LinkNode := LinkNode.NextSibling;
  629. end;
  630. if Assigned(Package) then
  631. begin
  632. WriteLn(ContentFile);
  633. WriteLn(ContentFile, ':classes');
  634. for i := 0 to Package.Modules.Count - 1 do
  635. begin
  636. Module := TPasModule(Package.Modules[i]);
  637. for j := 0 to Module.InterfaceSection.Classes.Count - 1 do
  638. begin
  639. ClassDecl := TPasClassType(Module.InterfaceSection.Classes[j]);
  640. Write(ContentFile, ClassDecl.PathName, ' ');
  641. if Assigned(ClassDecl.AncestorType) then
  642. WriteLn(ContentFile, ClassDecl.AncestorType.PathName)
  643. else if ClassDecl.ObjKind = okClass then
  644. WriteLn(ContentFile, '.TObject');
  645. for k := 0 to ClassDecl.Members.Count - 1 do
  646. begin
  647. Member := TPasElement(ClassDecl.Members[k]);
  648. Write(ContentFile, Chr(Ord(Member.Visibility) + Ord('0')));
  649. SetLength(s, 0);
  650. if Member.ClassType = TPasVariable then
  651. Write(ContentFile, 'V')
  652. else if Member.ClassType = TPasProperty then
  653. begin
  654. Write(ContentFile, 'P');
  655. if Length(TPasProperty(Member).ReadAccessorName) > 0 then
  656. s := s + 'r';
  657. if Length(TPasProperty(Member).WriteAccessorName) > 0 then
  658. s := s + 'w';
  659. if Length(TPasProperty(Member).StoredAccessorName) > 0 then
  660. s := s + 's';
  661. end else
  662. Write(ContentFile, 'M'); // Member must be a method
  663. Write(ContentFile, Member.Name);
  664. if Length(s) > 0 then
  665. WriteLn(ContentFile, ' ', s)
  666. else
  667. WriteLn(ContentFile);
  668. end;
  669. end;
  670. end;
  671. end;
  672. finally
  673. Close(ContentFile);
  674. end;
  675. end;
  676. function TFPDocEngine.CreateElement(AClass: TPTreeElement; const AName: String;
  677. AParent: TPasElement; AVisibility: TPasMemberVisibility;
  678. const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
  679. begin
  680. Result := AClass.Create(AName, AParent);
  681. Result.Visibility := AVisibility;
  682. if AClass.InheritsFrom(TPasModule) then
  683. CurModule := TPasModule(Result);
  684. Result.SourceFilename := ASourceFilename;
  685. Result.SourceLinenumber := ASourceLinenumber;
  686. end;
  687. function TFPDocEngine.FindElement(const AName: String): TPasElement;
  688. function FindInModule(AModule: TPasModule; const LocalName: String): TPasElement;
  689. var
  690. l: TList;
  691. i: Integer;
  692. begin
  693. l := AModule.InterfaceSection.Declarations;
  694. for i := 0 to l.Count - 1 do
  695. begin
  696. Result := TPasElement(l[i]);
  697. if CompareText(Result.Name, LocalName) = 0 then
  698. exit;
  699. end;
  700. Result := nil;
  701. end;
  702. var
  703. i: Integer;
  704. //ModuleName, LocalName: String;
  705. Module: TPasElement;
  706. begin
  707. {!!!: Don't know if we ever will have to use the following:
  708. i := Pos('.', AName);
  709. if i <> 0 then
  710. begin
  711. WriteLn('Dot found in name: ', AName);
  712. Result := nil;
  713. end else
  714. begin}
  715. Result := FindInModule(CurModule, AName);
  716. if not Assigned(Result) then
  717. for i := CurModule.InterfaceSection.UsesList.Count - 1 downto 0 do
  718. begin
  719. Module := TPasElement(CurModule.InterfaceSection.UsesList[i]);
  720. if Module.ClassType = TPasModule then
  721. begin
  722. Result := FindInModule(TPasModule(Module), AName);
  723. if Assigned(Result) then
  724. exit;
  725. end;
  726. end;
  727. {end;}
  728. end;
  729. function TFPDocEngine.FindModule(const AName: String): TPasModule;
  730. function FindInPackage(APackage: TPasPackage): TPasModule;
  731. var
  732. i: Integer;
  733. begin
  734. for i := 0 to APackage.Modules.Count - 1 do
  735. begin
  736. Result := TPasModule(APackage.Modules[i]);
  737. if CompareText(Result.Name, AName) = 0 then
  738. exit;
  739. end;
  740. Result := nil;
  741. end;
  742. var
  743. i: Integer;
  744. begin
  745. Result := FindInPackage(Package);
  746. if not Assigned(Result) then
  747. for i := FPackages.Count - 1 downto 0 do
  748. begin
  749. if TPasPackage(FPackages[i]) = Package then
  750. continue;
  751. Result := FindInPackage(TPasPackage(FPackages[i]));
  752. if Assigned(Result) then
  753. exit;
  754. end;
  755. end;
  756. procedure TFPDocEngine.AddLink(const APathName, ALinkTo: String);
  757. begin
  758. RootLinkNode.CreateChildren(APathName, ALinkTo);
  759. end;
  760. function TFPDocEngine.FindAbsoluteLink(const AName: String): String;
  761. var
  762. LinkNode: TLinkNode;
  763. begin
  764. LinkNode := RootLinkNode.FindChild(AName);
  765. if Assigned(LinkNode) then
  766. Result := LinkNode.Link
  767. else
  768. SetLength(Result, 0);
  769. end;
  770. function TFPDocEngine.ResolveLink(AModule: TPasModule;
  771. const ALinkDest: String): String;
  772. var
  773. i: Integer;
  774. ThisPackage: TLinkNode;
  775. UnitList: TList;
  776. begin
  777. //WriteLn('ResolveLink(', ALinkDest, ')... ');
  778. if Length(ALinkDest) = 0 then
  779. begin
  780. SetLength(Result, 0);
  781. exit;
  782. end;
  783. if (ALinkDest[1] = '#') or (not assigned(AModule)) then
  784. Result := FindAbsoluteLink(ALinkDest)
  785. else
  786. begin
  787. Result := ResolveLink(AModule, AModule.PathName + '.' + ALinkDest);
  788. if Length(Result) > 0 then
  789. exit;
  790. { Try all packages }
  791. SetLength(Result, 0);
  792. ThisPackage := RootLinkNode.FirstChild;
  793. while Assigned(ThisPackage) do
  794. begin
  795. Result := ResolveLink(AModule, ThisPackage.Name + '.' + ALinkDest);
  796. if Length(Result) > 0 then
  797. exit;
  798. ThisPackage := ThisPackage.NextSibling;
  799. end;
  800. if Length(Result) = 0 then
  801. begin
  802. { Okay, then we have to try all imported units of the current module }
  803. UnitList := AModule.InterfaceSection.UsesList;
  804. for i := UnitList.Count - 1 downto 0 do
  805. begin
  806. { Try all packages }
  807. ThisPackage := RootLinkNode.FirstChild;
  808. while Assigned(ThisPackage) do
  809. begin
  810. Result := ResolveLink(AModule, ThisPackage.Name + '.' +
  811. TPasType(UnitList[i]).Name + '.' + ALinkDest);
  812. if Length(Result) > 0 then
  813. exit;
  814. ThisPackage := ThisPackage.NextSibling;
  815. end;
  816. end;
  817. end;
  818. end;
  819. if Length(Result) = 0 then
  820. for i := Length(ALinkDest) downto 1 do
  821. if ALinkDest[i] = '.' then
  822. begin
  823. Result := ResolveLink(AModule, Copy(ALinkDest, 1, i - 1));
  824. exit;
  825. end;
  826. end;
  827. procedure TFPDocEngine.AddDocFile(const AFilename: String);
  828. function ReadNode(OwnerDocNode: TDocNode; Element: TDOMElement): TDocNode;
  829. var
  830. Subnode: TDOMNode;
  831. begin
  832. if OwnerDocNode = RootDocNode then
  833. Result := OwnerDocNode.CreateChildren('#' + Element['name'])
  834. else
  835. Result := OwnerDocNode.CreateChildren(Element['name']);
  836. Result.FNode := Element;
  837. Result.FLink := Element['link'];
  838. Result.FIsSkipped := Element['skip'] = '1';
  839. Subnode := Element.FirstChild;
  840. while Assigned(Subnode) do
  841. begin
  842. if Subnode.NodeType = ELEMENT_NODE then
  843. begin
  844. if Subnode.NodeName = 'short' then
  845. Result.FShortDescr := TDOMElement(Subnode)
  846. else if Subnode.NodeName = 'descr' then
  847. Result.FDescr := TDOMElement(Subnode)
  848. else if Subnode.NodeName = 'errors' then
  849. Result.FErrorsDoc := TDOMElement(Subnode)
  850. else if Subnode.NodeName = 'seealso' then
  851. Result.FSeeAlso := TDOMElement(Subnode)
  852. else if (Subnode.NodeName = 'example') and
  853. not Assigned(Result.FirstExample) then
  854. Result.FFirstExample := TDOMElement(Subnode);
  855. end;
  856. Subnode := Subnode.NextSibling;
  857. end;
  858. end;
  859. Procedure ReadTopics(TopicNode : TDocNode);
  860. Var
  861. SubNode : TDOMNode;
  862. begin
  863. SubNode:=TopicNode.FNode.FirstChilD;
  864. While Assigned(SubNode) do
  865. begin
  866. If (SubNode.NodeType=ELEMENT_NODE) and (SubNode.NodeName='topic') then
  867. With ReadNode(TopicNode,TDomElement(SubNode)) do
  868. // We could allow recursion here, but we won't, because it doesn't work on paper.
  869. FTopicNode:=True;
  870. SubNode:=Subnode.NextSibling;
  871. end;
  872. end;
  873. var
  874. i: Integer;
  875. Node, Subnode, Subsubnode: TDOMNode;
  876. Element: TDOMElement;
  877. Doc: TXMLDocument;
  878. PackageDocNode, TopicNode,ModuleDocNode: TDocNode;
  879. begin
  880. ReadXMLFile(Doc, AFilename);
  881. DescrDocs.Add(Doc);
  882. DescrDocNames.Add(AFilename);
  883. Node := Doc.DocumentElement.FirstChild;
  884. while Assigned(Node) do
  885. begin
  886. if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'package') then
  887. begin
  888. PackageDocNode := ReadNode(RootDocNode, TDOMElement(Node));
  889. // Scan all 'module' elements within this package element
  890. Subnode := Node.FirstChild;
  891. while Assigned(Subnode) do
  892. begin
  893. if (Subnode.NodeType = ELEMENT_NODE) then
  894. begin
  895. If (Subnode.NodeName = 'module') then
  896. begin
  897. ModuleDocNode := ReadNode(PackageDocNode, TDOMElement(Subnode));
  898. // Scan all 'element' elements within this module element
  899. Subsubnode := Subnode.FirstChild;
  900. while Assigned(Subsubnode) do
  901. begin
  902. if (Subsubnode.NodeType = ELEMENT_NODE) then
  903. begin
  904. if (Subsubnode.NodeName = 'element') then
  905. ReadNode(ModuleDocNode, TDOMElement(Subsubnode))
  906. else if (SubSubNode.NodeName='topic') then
  907. begin
  908. TopicNode:=ReadNode(ModuleDocNode,TDomElement(SubSubNode));
  909. TopicNode.FTopicNode:=True;
  910. ReadTopics(TopicNode);
  911. end;
  912. end;
  913. Subsubnode := Subsubnode.NextSibling;
  914. end;
  915. end
  916. else if (SubNode.NodeName='topic') then
  917. begin
  918. TopicNode:=ReadNode(PackageDocNode,TDomElement(SubNode));
  919. TopicNode.FTopicNode:=True;
  920. ReadTopics(TopicNode);
  921. end;
  922. end;
  923. Subnode := Subnode.NextSibling;
  924. end;
  925. end;
  926. Node := Node.NextSibling;
  927. end;
  928. end;
  929. function TFPDocEngine.FindDocNode(AElement: TPasElement): TDocNode;
  930. begin
  931. Result:=Nil;
  932. If Assigned(AElement) then
  933. begin
  934. if AElement.InheritsFrom(TPasUnresolvedTypeRef) then
  935. Result := FindDocNode(AElement.GetModule, AElement.Name)
  936. else
  937. Result := RootDocNode.FindChild(AElement.PathName);
  938. if (Result=Nil) and
  939. WarnNoNode and
  940. (Length(AElement.PathName)>0) and
  941. (AElement.PathName[1]='#') then
  942. Writeln('No documentation node found for identifier : ',AElement.PathName);
  943. end;
  944. end;
  945. function TFPDocEngine.FindDocNode(ARefModule: TPasModule;
  946. const AName: String): TDocNode;
  947. var
  948. CurPackage: TDocNode;
  949. UnitList: TList;
  950. i: Integer;
  951. begin
  952. if Length(AName) = 0 then
  953. Result := nil
  954. else
  955. begin
  956. if AName[1] = '#' then
  957. Result := RootDocNode.FindChild(AName)
  958. else
  959. Result := RootDocNode.FindChild(Package.Name + '.' + AName);
  960. if (not Assigned(Result)) and Assigned(ARefModule) then
  961. Result := RootDocNode.FindChild(ARefModule.PathName + '.' + AName);
  962. if (not Assigned(Result)) and (AName[1] <> '#') then
  963. begin
  964. CurPackage := RootDocNode.FirstChild;
  965. while Assigned(CurPackage) do
  966. begin
  967. Result := RootDocNode.FindChild(CurPackage.Name + '.' + AName);
  968. if Assigned(Result) then
  969. break;
  970. CurPackage := CurPackage.NextSibling;
  971. end;
  972. if not Assigned(Result) then
  973. begin
  974. { Okay, then we have to try all imported units of the current module }
  975. UnitList := CurModule.InterfaceSection.UsesList;
  976. for i := UnitList.Count - 1 downto 0 do
  977. begin
  978. { Try all packages }
  979. CurPackage := RootDocNode.FirstChild;
  980. while Assigned(CurPackage) do
  981. begin
  982. Result := RootDocNode.FindChild(CurPackage.Name + '.' +
  983. TPasType(UnitList[i]).Name + '.' + AName);
  984. if Assigned(Result) then
  985. break;
  986. CurPackage := CurPackage.NextSibling;
  987. end;
  988. end;
  989. end;
  990. end;
  991. end;
  992. end;
  993. function TFPDocEngine.FindShortDescr(AElement: TPasElement): TDOMElement;
  994. var
  995. DocNode: TDocNode;
  996. begin
  997. DocNode := FindDocNode(AElement);
  998. if Assigned(DocNode) then
  999. Result := DocNode.ShortDescr
  1000. else
  1001. Result := nil;
  1002. end;
  1003. function TFPDocEngine.FindShortDescr(ARefModule: TPasModule;
  1004. const AName: String): TDOMElement;
  1005. var
  1006. DocNode: TDocNode;
  1007. begin
  1008. DocNode := FindDocNode(ARefModule, AName);
  1009. if Assigned(DocNode) then
  1010. Result := DocNode.ShortDescr
  1011. else
  1012. Result := nil;
  1013. end;
  1014. function TFPDocEngine.GetExampleFilename(const ExElement: TDOMElement): String;
  1015. var
  1016. i: Integer;
  1017. begin
  1018. for i := 0 to DescrDocs.Count - 1 do
  1019. if TDOMDocument(DescrDocs[i]) = ExElement.OwnerDocument then
  1020. begin
  1021. Result := ExtractFilePath(DescrDocNames[i]) + ExElement['file'];
  1022. if (ExtractFileExt(Result)='') then
  1023. Result:=Result+'.pp';
  1024. exit;
  1025. end;
  1026. SetLength(Result, 0);
  1027. end;
  1028. { Global helpers }
  1029. procedure TranslateDocStrings(const Lang: String);
  1030. var
  1031. mo: TMOFile;
  1032. begin
  1033. {$IFDEF Unix}
  1034. mo := TMOFile.Create(Format('/usr/local/share/locale/%s/LC_MESSAGES/dglobals.mo', [Lang]));
  1035. {$ELSE}
  1036. mo := TMOFile.Create(Format('intl/dglobals.%s.mo', [Lang]));
  1037. {$ENDIF}
  1038. try
  1039. TranslateResourceStrings(mo);
  1040. finally
  1041. mo.Free;
  1042. end;
  1043. end;
  1044. end.
  1045. {
  1046. $Log$
  1047. Revision 1.6 2005-01-09 15:59:50 michael
  1048. + Split out latex writer to linear and latex writer
  1049. Revision 1.5 2004/08/28 18:47:48 michael
  1050. + Removed temporary warning about reading of doc file
  1051. Revision 1.4 2004/08/28 18:03:23 michael
  1052. + Added warning if docnode not found (option --warn-no-node
  1053. Revision 1.3 2004/06/06 10:53:02 michael
  1054. + Added Topic support
  1055. Revision 1.2 2003/11/28 12:51:37 sg
  1056. * Added support for source references
  1057. Revision 1.1 2003/03/17 23:03:20 michael
  1058. + Initial import in CVS
  1059. Revision 1.13 2003/03/13 22:02:13 sg
  1060. * New version with many bugfixes and our own parser (now independent of the
  1061. compiler source)
  1062. Revision 1.12 2002/11/15 19:44:18 sg
  1063. * Cosmetic changes
  1064. Revision 1.11 2002/10/12 17:00:45 michael
  1065. + Changes to be able to disable private/protected nodes in skeleton
  1066. Revision 1.10 2002/05/24 00:13:22 sg
  1067. * much improved new version, including many linking and output fixes
  1068. Revision 1.9 2002/03/25 23:16:24 sg
  1069. * fixed missing storing of documenation data for the DocNode of a module
  1070. (so e.g. the Unit Overview is working again)
  1071. Revision 1.8 2002/03/12 10:58:35 sg
  1072. * reworked linking engine and internal structure
  1073. Revision 1.7 2002/01/20 11:19:55 michael
  1074. + Added link attribute and property to TFPelement
  1075. Revision 1.6 2001/12/17 22:16:02 sg
  1076. * Added TFPDocEngine.HideProtected
  1077. }