2
0

dglobals.pp 37 KB

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