dglobals.pp 35 KB

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