dglobals.pp 46 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564
  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, StrUtils;
  20. Var
  21. LEOL : Integer;
  22. modir : string;
  23. resourcestring
  24. // Output strings
  25. SDocPackageTitle = 'Reference for package ''%s''';
  26. SDocPrograms = 'Programs';
  27. SDocUnits = 'Units';
  28. SDocUnitTitle = 'Reference for unit ''%s''';
  29. SDocInterfaceSection = 'Interface section';
  30. SDocImplementationSection = 'Implementation section';
  31. SDocUsedUnits = 'Used units';
  32. SDocUsedUnitsByUnitXY = 'Used units by unit ''%s''';
  33. SDocConstsTypesVars = 'Constants, types and variables';
  34. SDocResStrings = 'Resource strings';
  35. SDocTypes = 'Types';
  36. SDocConstants = 'Constants';
  37. SDocClasses = 'Classes';
  38. SDocProceduresAndFunctions = 'Procedures and functions';
  39. SDocVariables = 'Variables';
  40. SDocIdentifierIndex = 'Index';
  41. SDocModuleIndex = 'Index of all identifiers in unit ''%s''';
  42. SDocPackageIndex = 'Index of all identifiers in package ''%s''';
  43. SDocUnitOverview = 'Overview of unit ''%s''';
  44. SDocOverview = 'Overview';
  45. SDocSearch = 'Search';
  46. SDocDeclaration = 'Declaration';
  47. SDocDescription = 'Description';
  48. SDocErrors = 'Errors';
  49. SDocVersion = 'Version info';
  50. SDocSeeAlso = 'See also';
  51. SDocExample = 'Example';
  52. SDocArguments = 'Arguments';
  53. SDocFunctionResult = 'Function result';
  54. SDocRemark = 'Remark: ';
  55. SDocMethodOverview = 'Method overview';
  56. SDocPropertyOverview = 'Property overview';
  57. SDocInterfacesOverview = 'Interfaces overview';
  58. SDocPage = 'Page';
  59. SDocMethod = 'Method';
  60. SDocProperty = 'Property';
  61. SDocAccess = 'Access';
  62. SDocInheritance = 'Inheritance';
  63. SDocProperties = 'Properties';
  64. SDocMethods = 'Methods';
  65. SDocEvents = 'Events';
  66. SDocByName = 'by Name';
  67. SDocValue = 'Value';
  68. SDocExplanation = 'Explanation';
  69. SDocProcedure = 'Procedure';
  70. SDocValuesForEnum = 'Enumeration values for type %s';
  71. SDocSourcePosition = 'Source position: %s line %d';
  72. SDocSynopsis = 'Synopsis';
  73. SDocVisibility = 'Visibility';
  74. SDocOpaque = 'Opaque type';
  75. SDocDateGenerated = 'Documentation generated on: %s';
  76. // Topics
  77. SDocRelatedTopics = 'Related topics';
  78. SDocUp = 'Up';
  79. SDocNext = 'Next';
  80. SDocPrevious = 'Previous';
  81. // Various backend constants
  82. SDocChapter = 'Chapter';
  83. SDocSection = 'Section';
  84. SDocSubSection = 'Subsection';
  85. SDocTable = 'Table';
  86. SDocListing = 'Listing';
  87. // Man page usage
  88. SManUsageManSection = 'Use ASection as the man page section';
  89. SManUsageNoUnitPrefix = 'Do not prefix man pages with unit name.';
  90. SManUsageWriterDescr = 'UNIX man page output.';
  91. SManUsagePackageDescription = 'Use descr as the description of man pages';
  92. // HTML usage
  93. SHTMLUsageFooter = 'Append xhtml from file as footer to html page';
  94. SHTMLUsageFooterDate = 'Append footer with date. fmt is Optional format for FormatDateTime';
  95. SHTMLUsageCharset = 'Set the HTML character set';
  96. SHTMLHtmlSearch = 'Add search page with given name to the menu bar';
  97. SHTMLIndexColcount = 'Use N columns in the identifier index pages';
  98. SHTMLImageUrl = 'Prefix image URLs with url';
  99. // CHM usage
  100. SCHMUsageTOC = 'Use [File] as the table of contents. Usually a .hhc file.';
  101. SCHMUsageIndex = 'Use [File] as the index. Usually a .hhk file.';
  102. SCHMUsageDefPage = 'Set the "Home" page relative to where it lives in the chm. i.e. "/index.html"';
  103. SCHMUsageOtrFiles= 'A txt file containing a list of files to be added relative to the working directory.';
  104. SCHMUsageCSSFile = 'Filename of a .css file to be included in the chm.';
  105. SCHMUsageAutoTOC = 'Automatically generate a Table of Contents. Ignores --toc-file';
  106. SCHMUsageAutoIDX = 'Automatically generate an Index. Ignores --index-file';
  107. SCHMUsageMakeSearch = 'Automatically generate a Search Index from filenames that match *.htm*';
  108. // Linear usage
  109. SLinearUsageDupLinkedDocsP1 = 'Duplicate linked element documentation in';
  110. SLinearUsageDupLinkedDocsP2 = 'descendant classes.';
  111. STitle = 'FPDoc - Free Pascal Documentation Tool';
  112. SVersion = 'Version %s [%s]';
  113. SCopyright = '(c) 2000 - 2003 Areca Systems GmbH / Sebastian Guenther, [email protected]';
  114. SCmdLineHelp = 'Usage: %s [options]';
  115. SUsageOption010 = '--content Create content file for package cross-references';
  116. SUsageOption020 = '--cputarget=value Set the target CPU for the scanner.';
  117. SUsageOption030 = '--descr=name use name as description file. ';
  118. SUsageOption040 = ' This option is allowed more than once';
  119. SUsageOption050 = '--format=fmt Select output format.';
  120. SUsageOption060 = '--help Show this help.';
  121. SUsageOption070 = '--hide-protected Do not show protected methods in overview';
  122. SUsageOption080 = '--import=file Import content file for package cross-references';
  123. SUsageOption090 = '--input=cmd use cmd as input for the parser.';
  124. SUsageOption100 = ' At least one input option is required.';
  125. SUsageOption110 = '--lang=lng Select output language.';
  126. SUsageOption120 = '--ostarget=value Set the target OS for the scanner.';
  127. SUsageOption130 = '--output=name use name as the output name.';
  128. SUsageOption140 = ' Each backend interpretes this as needed.';
  129. SUsageOption150 = '--package=name Set the package name for which to create output';
  130. SUsageOption160 = '--show-private Show private methods.';
  131. SUsageOption170 = '--warn-no-node Warn if no documentation node was found.';
  132. SUsageOption180 = '--mo-dir=dir Set directory where language files reside to dir';
  133. SUsageOption190 = '--parse-impl (Experimental) try to parse implementation too';
  134. SUsageFormats = 'The following output formats are supported by this fpdoc:';
  135. SUsageBackendHelp = 'Specify an output format, combined with --help to get more help for this backend.';
  136. SUsageFormatSpecific = 'Output format "%s" supports the following options:';
  137. SCmdLineInvalidOption = 'Ignoring unknown option "%s"';
  138. SCmdLineInvalidFormat = 'Invalid format "%s" specified';
  139. SCmdLineOutputOptionMissing = 'Need an output filename, please specify one with --output=<filename>';
  140. SWritingPages = 'Writing %d pages...';
  141. SNeedPackageName = 'No package name specified. Please specify one using the --package option.';
  142. SDone = 'Done.';
  143. SErrCouldNotCreateOutputDir = 'Could not create output directory "%s"';
  144. SErrCouldNotCreateFile = 'Could not create file "%s": %s';
  145. SSeeURL = '(See %s)'; // For linear text writers.
  146. Const
  147. SVisibility: array[TPasMemberVisibility] of string =
  148. ('Default', 'Private', 'Protected', 'Public',
  149. 'Published', 'Automated','Strict Private','Strict Protected');
  150. type
  151. // Assumes a list of TObject instances and frees them on destruction
  152. TObjectList = class(TList)
  153. public
  154. destructor Destroy; override;
  155. end;
  156. { Link entry tree
  157. TFPDocEngine stores the root of the entry tree in its property
  158. "RootLinkNode". The root has one child node for each package, for which
  159. documentation links are available. The children of a package node
  160. are module nodes; and the children of a module node are the top-level
  161. declarations of this module; the next level in the tree stores e.g. record
  162. members, and so on...
  163. }
  164. TLinkNode = class
  165. private
  166. FFirstChild, FNextSibling: TLinkNode;
  167. FName: String;
  168. FLink: String;
  169. public
  170. constructor Create(const AName, ALink: String);
  171. destructor Destroy; override;
  172. function FindChild(const APathName: String): TLinkNode;
  173. function CreateChildren(const APathName, ALinkTo: String): TLinkNode;
  174. // Properties for tree structure
  175. property FirstChild: TLinkNode read FFirstChild;
  176. property NextSibling: TLinkNode read FNextSibling;
  177. // Link properties
  178. property Name: String read FName;
  179. property Link: String read FLink;
  180. end;
  181. { Documentation entry tree
  182. TFPDocEngine stores the root of the entry tree in its property
  183. "RootDocNode". The root has one child node for each package, for which
  184. documentation is being provided by the user. The children of a package node
  185. are module nodes; and the children of a module node are the top-level
  186. declarations of this module; the next level in the tree stores e.g. record
  187. members, and so on...
  188. }
  189. { TDocNode }
  190. TDocNode = class
  191. private
  192. FFirstChild, FNextSibling: TDocNode;
  193. FName: String;
  194. FNode: TDOMElement;
  195. FIsSkipped: Boolean;
  196. FShortDescr: TDOMElement;
  197. FDescr: TDOMElement;
  198. FErrorsDoc: TDOMElement;
  199. FSeeAlso: TDOMElement;
  200. FFirstExample: TDOMElement;
  201. FLink: String;
  202. FTopicNode : Boolean;
  203. FRefCount : Integer;
  204. FVersion: TDomElement;
  205. public
  206. constructor Create(const AName: String; ANode: TDOMElement);
  207. destructor Destroy; override;
  208. Function IncRefcount : Integer;
  209. function FindChild(const APathName: String): TDocNode;
  210. function CreateChildren(const APathName: String): TDocNode;
  211. // Properties for tree structure
  212. property FirstChild: TDocNode read FFirstChild;
  213. property NextSibling: TDocNode read FNextSibling;
  214. // Basic properties
  215. property Name: String read FName;
  216. property Node: TDOMElement read FNode;
  217. // Data fetched from the XML document
  218. property IsSkipped: Boolean read FIsSkipped;
  219. property ShortDescr: TDOMElement read FShortDescr;
  220. property Descr: TDOMElement read FDescr;
  221. property ErrorsDoc: TDOMElement read FErrorsDoc;
  222. Property Version : TDomElement Read FVersion;
  223. property SeeAlso: TDOMElement read FSeeAlso;
  224. property FirstExample: TDOMElement read FFirstExample;
  225. property Link: String read FLink;
  226. Property TopicNode : Boolean Read FTopicNode;
  227. Property RefCount : Integer Read FRefCount;
  228. end;
  229. // The main FPDoc engine
  230. { TFPDocEngine }
  231. TFPDocEngine = class(TPasTreeContainer)
  232. private
  233. protected
  234. DescrDocs: TObjectList; // List of XML documents
  235. DescrDocNames: TStringList; // Names of the XML documents
  236. FRootLinkNode: TLinkNode;
  237. FRootDocNode: TDocNode;
  238. FPackages: TList; // List of TFPPackage objects
  239. CurModule: TPasModule;
  240. CurPackageDocNode: TDocNode;
  241. public
  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. constructor Create;
  248. destructor Destroy; override;
  249. procedure SetPackageName(const APackageName: String);
  250. procedure ReadContentFile(const AFilename, ALinkPrefix: String);
  251. procedure WriteContentFile(const AFilename: String);
  252. function CreateElement(AClass: TPTreeElement; const AName: String;
  253. AParent: TPasElement; AVisibility: TPasMemberVisibility;
  254. const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
  255. override;
  256. function FindElement(const AName: String): TPasElement; override;
  257. function FindModule(const AName: String): TPasModule; override;
  258. // Link tree support
  259. procedure AddLink(const APathName, ALinkTo: String);
  260. function FindAbsoluteLink(const AName: String): String;
  261. function ResolveLink(AModule: TPasModule; const ALinkDest: String): String;
  262. function FindLinkedNode(ANode: TDocNode): TDocNode;
  263. // Documentation file support
  264. procedure AddDocFile(const AFilename: String);
  265. // Documentation retrieval
  266. function FindDocNode(AElement: TPasElement): TDocNode;
  267. function FindDocNode(ARefModule: TPasModule; const AName: String): TDocNode;
  268. function FindShortDescr(AElement: TPasElement): TDOMElement;
  269. function FindShortDescr(ARefModule: TPasModule;
  270. const AName: String): TDOMElement;
  271. function GetExampleFilename(const ExElement: TDOMElement): String;
  272. property RootLinkNode: TLinkNode read FRootLinkNode;
  273. property RootDocNode: TDocNode read FRootDocNode;
  274. property Package: TPasPackage read FPackage;
  275. end;
  276. procedure TranslateDocStrings(const Lang: String);
  277. Function IsLinkNode(Node : TDomNode) : Boolean;
  278. Function IsExampleNode(Example : TDomNode) : Boolean;
  279. // returns true is link is an absolute URI
  280. Function IsLinkAbsolute(ALink: String): boolean;
  281. implementation
  282. uses SysUtils, Gettext, XMLRead;
  283. const
  284. AbsoluteLinkPrefixes : array[0..2] of string = ('/', 'http://', 'ms-its:');
  285. { TObjectList }
  286. destructor TObjectList.Destroy;
  287. var
  288. i: Integer;
  289. begin
  290. for i := 0 to Count - 1 do
  291. TObject(Items[i]).Free;
  292. inherited Destroy;
  293. end;
  294. { TLinkNode }
  295. constructor TLinkNode.Create(const AName, ALink: String);
  296. begin
  297. inherited Create;
  298. FName := AName;
  299. FLink := ALink;
  300. end;
  301. destructor TLinkNode.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 TLinkNode.FindChild(const APathName: String): TLinkNode;
  310. var
  311. DotPos: Integer;
  312. ChildName: String;
  313. Child: TLinkNode;
  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 TLinkNode.CreateChildren(const APathName, ALinkTo: String): TLinkNode;
  342. var
  343. DotPos: Integer;
  344. ChildName: String;
  345. Child, LastChild: TLinkNode;
  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. LastChild := nil;
  358. while Assigned(Child) do
  359. begin
  360. if CompareText(Child.Name, ChildName) = 0 then
  361. begin
  362. if DotPos = 0 then
  363. Result := Child
  364. else
  365. Result := Child.CreateChildren(
  366. Copy(APathName, DotPos + 1, Length(APathName)), ALinkTo);
  367. exit;
  368. end;
  369. LastChild := Child;
  370. Child := Child.NextSibling;
  371. end;
  372. { No child found, let's create one if we are at the end of the path }
  373. if DotPos > 0 then
  374. // !!!: better throw an exception
  375. WriteLn('Link path does not exist: ', APathName);
  376. Result := TLinkNode.Create(ChildName, ALinkTo);
  377. if Assigned(LastChild) then
  378. LastChild.FNextSibling := Result
  379. else
  380. FFirstChild := Result;
  381. end;
  382. end;
  383. { TDocNode }
  384. constructor TDocNode.Create(const AName: String; ANode: TDOMElement);
  385. begin
  386. inherited Create;
  387. FName := AName;
  388. FNode := ANode;
  389. end;
  390. destructor TDocNode.Destroy;
  391. begin
  392. if Assigned(FirstChild) then
  393. FirstChild.Free;
  394. if Assigned(NextSibling) then
  395. NextSibling.Free;
  396. inherited Destroy;
  397. end;
  398. Function TDocNode.IncRefcount : Integer;
  399. begin
  400. Inc(FRefCount);
  401. Result:=FRefCount;
  402. end;
  403. function TDocNode.FindChild(const APathName: String): TDocNode;
  404. var
  405. DotPos: Integer;
  406. ChildName: String;
  407. Child: TDocNode;
  408. begin
  409. if Length(APathName) = 0 then
  410. Result := Self
  411. else
  412. begin
  413. DotPos := Pos('.', APathName);
  414. if DotPos = 0 then
  415. ChildName := APathName
  416. else
  417. ChildName := Copy(APathName, 1, DotPos - 1);
  418. Child := FirstChild;
  419. while Assigned(Child) do
  420. begin
  421. if CompareText(Child.Name, ChildName) = 0 then
  422. begin
  423. if DotPos = 0 then
  424. Result := Child
  425. else
  426. Result := Child.FindChild(
  427. Copy(APathName, DotPos + 1, Length(APathName)));
  428. exit;
  429. end;
  430. Child := Child.NextSibling;
  431. end;
  432. Result := nil;
  433. end;
  434. end;
  435. function TDocNode.CreateChildren(const APathName: String): TDocNode;
  436. var
  437. DotPos: Integer;
  438. ChildName: String;
  439. Child: TDocNode;
  440. begin
  441. if Length(APathName) = 0 then
  442. Result := Self
  443. else
  444. begin
  445. DotPos := Pos('.', APathName);
  446. if DotPos = 0 then
  447. ChildName := APathName
  448. else
  449. ChildName := Copy(APathName, 1, DotPos - 1);
  450. Child := FirstChild;
  451. while Assigned(Child) do
  452. begin
  453. if CompareText(Child.Name, ChildName) = 0 then
  454. begin
  455. if DotPos = 0 then
  456. Result := Child
  457. else
  458. Result := Child.CreateChildren(
  459. Copy(APathName, DotPos + 1, Length(APathName)));
  460. exit;
  461. end;
  462. Child := Child.NextSibling;
  463. end;
  464. // No child found, let's create one
  465. Result := TDocNode.Create(ChildName, nil);
  466. if Assigned(FirstChild) then
  467. begin
  468. Result.FNextSibling := FirstChild;
  469. FFirstChild := Result;
  470. end else
  471. FFirstChild := Result;
  472. if DotPos > 0 then
  473. Result := Result.CreateChildren(
  474. Copy(APathName, DotPos + 1, Length(APathName)));
  475. end;
  476. end;
  477. { TFPDocEngine }
  478. constructor TFPDocEngine.Create;
  479. begin
  480. inherited Create;
  481. DescrDocs := TObjectList.Create;
  482. DescrDocNames := TStringList.Create;
  483. FRootLinkNode := TLinkNode.Create('', '');
  484. FRootDocNode := TDocNode.Create('', nil);
  485. HidePrivate := True;
  486. InterfaceOnly:=True;
  487. FPackages := TList.Create;
  488. end;
  489. destructor TFPDocEngine.Destroy;
  490. var
  491. i: Integer;
  492. begin
  493. for i := 0 to FPackages.Count - 1 do
  494. TPasPackage(FPackages[i]).Release;
  495. FPackages.Free;
  496. FRootDocNode.Free;
  497. FRootLinkNode.Free;
  498. DescrDocNames.Free;
  499. DescrDocs.Free;
  500. inherited Destroy;
  501. end;
  502. procedure TFPDocEngine.SetPackageName(const APackageName: String);
  503. begin
  504. ASSERT(not Assigned(Package));
  505. FPackage := TPasPackage(inherited CreateElement(TPasPackage,
  506. '#' + APackageName, nil, '', 0));
  507. FPackages.Add(FPackage);
  508. CurPackageDocNode := RootDocNode.FindChild('#' + APackageName);
  509. If Assigned(CurPackageDocNode) then
  510. CurPackageDocNode.IncRefCount;
  511. end;
  512. procedure TFPDocEngine.ReadContentFile(const AFilename, ALinkPrefix: String);
  513. var
  514. f: Text;
  515. inheritanceinfo : TStringlist;
  516. procedure ReadLinkTree;
  517. var
  518. s: String;
  519. PrevSpaces, ThisSpaces, i, StackIndex: Integer;
  520. CurParent, PrevSibling, NewNode: TLinkNode;
  521. ParentStack, SiblingStack: array[0..7] of TLinkNode;
  522. begin
  523. PrevSpaces := 0;
  524. CurParent := RootLinkNode;
  525. PrevSibling := CurParent.FirstChild;
  526. if assigned(PrevSibling) then
  527. while assigned(PrevSibling.NextSibling) do
  528. PrevSibling := PrevSibling.NextSibling;
  529. StackIndex := 0;
  530. while True do
  531. begin
  532. ReadLn(f, s);
  533. if Length(s) = 0 then
  534. break;
  535. ThisSpaces := 0;
  536. while s[ThisSpaces + 1] = ' ' do
  537. Inc(ThisSpaces);
  538. if ThisSpaces <> PrevSpaces then
  539. begin
  540. if ThisSpaces > PrevSpaces then
  541. begin
  542. { Dive down one level }
  543. ParentStack[StackIndex] := CurParent;
  544. SiblingStack[StackIndex] := PrevSibling;
  545. Inc(StackIndex);
  546. CurParent := PrevSibling;
  547. PrevSibling := nil;
  548. end else
  549. while PrevSpaces > ThisSpaces do
  550. begin
  551. Dec(StackIndex);
  552. CurParent := ParentStack[StackIndex];
  553. PrevSibling := SiblingStack[StackIndex];
  554. Dec(PrevSpaces);
  555. end;
  556. PrevSpaces := ThisSpaces;
  557. end;
  558. i := ThisSpaces + 1;
  559. while s[i] <> ' ' do
  560. Inc(i);
  561. NewNode := TLinkNode.Create(Copy(s, ThisSpaces + 1, i - ThisSpaces - 1),
  562. ALinkPrefix + Copy(s, i + 1, Length(s)));
  563. if Assigned(PrevSibling) then
  564. PrevSibling.FNextSibling := NewNode
  565. else
  566. CurParent.FFirstChild := NewNode;
  567. PrevSibling := NewNode;
  568. end;
  569. end;
  570. function ResolvePackageModule(AName:String;var pkg:TPasPackage;var module:TPasModule;createnew:boolean):String;
  571. var
  572. DotPos, DotPos2, i,j: Integer;
  573. s: String;
  574. HPackage: TPasPackage;
  575. begin
  576. pkg:=nil; module:=nil; result:='';
  577. // Find or create package
  578. DotPos := Pos('.', AName);
  579. s := Copy(AName, 1, DotPos - 1);
  580. HPackage := nil;
  581. for i := 0 to FPackages.Count - 1 do
  582. if CompareText(TPasPackage(FPackages[i]).Name, s) = 0 then
  583. begin
  584. HPackage := TPasPackage(FPackages[i]);
  585. break;
  586. end;
  587. if not Assigned(HPackage) then
  588. begin
  589. if not CreateNew then
  590. exit;
  591. HPackage := TPasPackage(inherited CreateElement(TPasPackage, s, nil,
  592. '', 0));
  593. FPackages.Add(HPackage);
  594. end;
  595. // Find or create module
  596. DotPos2 := DotPos;
  597. repeat
  598. Inc(DotPos2);
  599. until AName[DotPos2] = '.';
  600. s := Copy(AName, DotPos + 1, DotPos2 - DotPos - 1);
  601. Module := nil;
  602. for i := 0 to HPackage.Modules.Count - 1 do
  603. if CompareText(TPasModule(HPackage.Modules[i]).Name, s) = 0 then
  604. begin
  605. Module := TPasModule(HPackage.Modules[i]);
  606. break;
  607. end;
  608. if not Assigned(Module) then
  609. begin
  610. if not CreateNew then
  611. exit;
  612. Module := TPasModule.Create(s, HPackage);
  613. Module.InterfaceSection := TInterfaceSection.Create('', Module);
  614. HPackage.Modules.Add(Module);
  615. end;
  616. pkg:=hpackage;
  617. result:=Copy(AName, DotPos2 + 1, length(AName)-dotpos2);
  618. end;
  619. function SearchInList(clslist:TList;s:string):TPasElement;
  620. var i : integer;
  621. ClassEl: TPasElement;
  622. begin
  623. result:=nil;
  624. for i:=0 to clslist.count-1 do
  625. begin
  626. ClassEl := TPasElement(clslist[i]);
  627. if CompareText(ClassEl.Name,s) =0 then
  628. exit(Classel);
  629. end;
  630. end;
  631. function ResolveClassType(AName:String):TPasClassType;
  632. var
  633. pkg : TPasPackage;
  634. module : TPasModule;
  635. s : string;
  636. begin
  637. Result:=nil;
  638. s:=ResolvePackageModule(AName,pkg,module,False);
  639. if not assigned(module) then
  640. exit;
  641. result:=TPasClassType(SearchInList(Module.InterfaceSection.Classes,s));
  642. end;
  643. function ResolveAliasType(AName:String):TPasAliasType;
  644. var
  645. pkg : TPasPackage;
  646. module : TPasModule;
  647. s : string;
  648. begin
  649. Result:=nil;
  650. s:=ResolvePackageModule(AName,pkg,module,False);
  651. if not assigned(module) then
  652. exit;
  653. result:=TPasAliasType(SearchInList(Module.InterfaceSection.Types,s));
  654. if not (result is TPasAliasType) then
  655. result:=nil;
  656. end;
  657. procedure ReadClasses;
  658. function CreateClass(const AName: String;InheritanceStr:String): TPasClassType;
  659. var
  660. DotPos, DotPos2, i,j: Integer;
  661. s: String;
  662. HPackage: TPasPackage;
  663. Module: TPasModule;
  664. begin
  665. s:= ResolvePackageModule(AName,HPackage,Module,True);
  666. // Create node for class
  667. Result := TPasClassType.Create(s, Module.InterfaceSection);
  668. Result.ObjKind := okClass;
  669. Module.InterfaceSection.Declarations.Add(Result);
  670. Module.InterfaceSection.Classes.Add(Result);
  671. // defer processing inheritancestr till all classes are loaded.
  672. if inheritancestr<>'' then
  673. InheritanceInfo.AddObject(Inheritancestr,result);
  674. end;
  675. procedure splitalias(var instr:string;out outstr:string);
  676. var i,j:integer;
  677. begin
  678. if length(instr)=0 then exit;
  679. instr:=trim(instr);
  680. i:=pos('(',instr);
  681. if i>0 then
  682. begin
  683. j:=length(instr)-i;
  684. if instr[length(instr)]=')' then
  685. dec(j);
  686. outstr:=copy(instr,i+1,j);
  687. delete(instr,i,j+2);
  688. end
  689. end;
  690. Function ResolveAndLinkClass(clname:String;IsClass:boolean;cls:TPasClassType):TPasClassType;
  691. begin
  692. result:=TPasClassType(ResolveClassType(clname));
  693. if assigned(result) and not (cls=result) then // save from tobject=implicit tobject
  694. begin
  695. result.addref;
  696. if IsClass then
  697. begin
  698. cls.ancestortype:=result;
  699. // writeln(cls.name, ' has as ancestor ',result.pathname);
  700. end
  701. else
  702. begin
  703. cls.interfaces.add(result);
  704. // writeln(cls.name, ' implements ',result.pathname);
  705. end;
  706. end
  707. else
  708. if cls<>result then
  709. writeln(cls.name,'''s dependancy ' ,clname,' could not be resolved');
  710. end;
  711. function CreateAliasType (alname,clname : string;parentclass:TPasClassType; out cl2 :TPasClassType):TPasAliasType;
  712. // create alias clname = alname
  713. var
  714. pkg : TPasPackage;
  715. module : TPasModule;
  716. s : string;
  717. begin
  718. Result:=nil;
  719. s:=ResolvePackageModule(Alname,pkg,module,True);
  720. if not assigned(module) then
  721. exit;
  722. cl2:=TPasClassType(ResolveClassType(alname));
  723. if assigned( cl2) and not (parentclass=cl2) then
  724. begin
  725. result:=ResolveAliasType(clname);
  726. if assigned(result) then
  727. begin
  728. writeln('found alias ',clname,' (',s,') ',result.classname);
  729. end
  730. else
  731. begin
  732. writeln('new alias ',clname,' (',s,') ');
  733. cl2.addref;
  734. Result := TPasAliasType(CreateElement(TPasAliasType,s,module.interfacesection,vispublic,'',0));
  735. TPasAliasType(Result).DestType := cl2;
  736. end
  737. end
  738. end;
  739. procedure ProcessInheritanceStrings(inhInfo:TStringList);
  740. var i,j : integer;
  741. cls : TPasClassType;
  742. cls2: TPasClassType;
  743. clname,
  744. alname : string;
  745. inhclass : TStringList;
  746. begin
  747. inhclass:=TStringList.Create;
  748. inhclass.delimiter:=',';
  749. if InhInfo.Count>0 then
  750. for i:=0 to InhInfo.Count-1 do
  751. begin
  752. cls:=TPasClassType(InhInfo.Objects[i]);
  753. inhclass.clear;
  754. inhclass.delimitedtext:=InhInfo[i];
  755. for j:= 0 to inhclass.count-1 do
  756. begin
  757. //writeln('processing',inhclass[j]);
  758. clname:=inhclass[j];
  759. splitalias(clname,alname);
  760. if alname<>'' then // the class//interface we refered to is an alias
  761. begin
  762. // writeln('Found alias pair ',clname,' = ',alname);
  763. if not assigned(CreateAliasType(alname,clname,cls,cls2)) then
  764. writeln('creating alias failed!');
  765. end
  766. else
  767. cls2:=ResolveAndLinkClass(clname,j=0,cls);
  768. end;
  769. end;
  770. end;
  771. var
  772. s, Name: String;
  773. CurClass: TPasClassType;
  774. i: Integer;
  775. Member: TPasElement;
  776. begin
  777. inheritanceinfo :=TStringlist.Create;
  778. Try
  779. CurClass := nil;
  780. while True do
  781. begin
  782. ReadLn(f, s);
  783. if Length(s) = 0 then
  784. break;
  785. if s[1] = '#' then
  786. begin
  787. // New class
  788. i := Pos(' ', s);
  789. CurClass := CreateClass(Copy(s, 1, i - 1), copy(s,i+1,length(s)));
  790. end else
  791. begin
  792. i := Pos(' ', s);
  793. if i = 0 then
  794. Name := Copy(s, 3, Length(s))
  795. else
  796. Name := Copy(s, 3, i - 3);
  797. case s[2] of
  798. 'M':
  799. Member := TPasProcedure.Create(Name, CurClass);
  800. 'P':
  801. begin
  802. Member := TPasProperty.Create(Name, CurClass);
  803. if i > 0 then
  804. while i <= Length(s) do
  805. begin
  806. case s[i] of
  807. 'r':
  808. TPasProperty(Member).ReadAccessorName := '<dummy>';
  809. 'w':
  810. TPasProperty(Member).WriteAccessorName := '<dummy>';
  811. 's':
  812. TPasProperty(Member).StoredAccessorName := '<dummy>';
  813. end;
  814. Inc(i);
  815. end;
  816. end;
  817. 'V':
  818. Member := TPasVariable.Create(Name, CurClass);
  819. else
  820. raise Exception.Create('Invalid member type: ' + s[2]);
  821. end;
  822. CurClass.Members.Add(Member);
  823. end;
  824. end;
  825. ProcessInheritanceStrings(Inheritanceinfo);
  826. finally
  827. inheritanceinfo.Free;
  828. end;
  829. end;
  830. var
  831. s: String;
  832. begin
  833. if not FileExists(AFileName) then
  834. raise EInOutError.Create('File not found: ' + AFileName);
  835. Assign(f, AFilename);
  836. Reset(f);
  837. while not EOF(f) do
  838. begin
  839. ReadLn(f, s);
  840. if (Length(s) = 0) or (s[1] = '#') then
  841. continue;
  842. if s = ':link tree' then
  843. ReadLinkTree
  844. else if s = ':classes' then
  845. ReadClasses
  846. else
  847. repeat
  848. ReadLn(f, s);
  849. until EOF(f) or (Length(s) = 0);
  850. end;
  851. Close(f);
  852. end;
  853. procedure TFPDocEngine.WriteContentFile(const AFilename: String);
  854. var
  855. ContentFile: Text;
  856. procedure ProcessLinkNode(ALinkNode: TLinkNode; const AIdent: String);
  857. var
  858. ChildNode: TLinkNode;
  859. begin
  860. WriteLn(ContentFile, AIdent, ALinkNode.Name, ' ', ALinkNode.Link);
  861. ChildNode := ALinkNode.FirstChild;
  862. while Assigned(ChildNode) do
  863. begin
  864. ProcessLinkNode(ChildNode, AIdent + ' ');
  865. ChildNode := ChildNode.NextSibling;
  866. end;
  867. end;
  868. function CheckImplicitInterfaceLink(const s : String):String;
  869. begin
  870. if uppercase(s)='IUNKNOWN' then
  871. Result:='#rtl.System.IUnknown'
  872. else
  873. Result:=s;
  874. end;
  875. var
  876. LinkNode: TLinkNode;
  877. i, j, k: Integer;
  878. Module: TPasModule;
  879. Alias : TPasAliasType;
  880. ClassDecl: TPasClassType;
  881. Member: TPasElement;
  882. s: String;
  883. begin
  884. Assign(ContentFile, AFilename);
  885. Rewrite(ContentFile);
  886. try
  887. WriteLn(ContentFile, '# FPDoc Content File');
  888. WriteLn(ContentFile, ':link tree');
  889. LinkNode := RootLinkNode.FirstChild;
  890. while Assigned(LinkNode) do
  891. begin
  892. if LinkNode.Name = Package.Name then
  893. begin
  894. ProcessLinkNode(LinkNode, '');
  895. end;
  896. LinkNode := LinkNode.NextSibling;
  897. end;
  898. if Assigned(Package) then
  899. begin
  900. WriteLn(ContentFile);
  901. WriteLn(ContentFile, ':classes');
  902. for i := 0 to Package.Modules.Count - 1 do
  903. begin
  904. Module := TPasModule(Package.Modules[i]);
  905. for j := 0 to Module.InterfaceSection.Classes.Count - 1 do
  906. begin
  907. ClassDecl := TPasClassType(Module.InterfaceSection.Classes[j]);
  908. Write(ContentFile, CheckImplicitInterfaceLink(ClassDecl.PathName), ' ');
  909. if Assigned(ClassDecl.AncestorType) then
  910. begin
  911. // simple aliases to class types are coded as "alias(classtype)"
  912. Write(ContentFile, CheckImplicitInterfaceLink(ClassDecl.AncestorType.PathName));
  913. if ClassDecl.AncestorType is TPasAliasType then
  914. begin
  915. alias:= TPasAliasType(ClassDecl.AncestorType);
  916. if assigned(alias.desttype) and (alias.desttype is TPasClassType) then
  917. write(ContentFile,'(',alias.desttype.PathName,')');
  918. end;
  919. end
  920. else if ClassDecl.ObjKind = okClass then
  921. Write(ContentFile, '#rtl.System.TObject')
  922. else if ClassDecl.ObjKind = okInterface then
  923. Write(ContentFile, '#rtl.System.IUnknown');
  924. if ClassDecl.Interfaces.Count>0 then
  925. begin
  926. for k:=0 to ClassDecl.Interfaces.count-1 do
  927. begin
  928. write(contentfile,',',CheckImplicitInterfaceLink(TPasClassType(ClassDecl.Interfaces[k]).PathName));
  929. if TPasElement(ClassDecl.Interfaces[k]) is TPasAliasType then
  930. begin
  931. alias:= TPasAliasType(ClassDecl.Interfaces[k]);
  932. if assigned(alias.desttype) and (alias.desttype is TPasClassType) then
  933. write(ContentFile,'(',CheckImplicitInterfaceLink(alias.desttype.PathName),')');
  934. end;
  935. end;
  936. end;
  937. writeln(contentfile);
  938. for k := 0 to ClassDecl.Members.Count - 1 do
  939. begin
  940. Member := TPasElement(ClassDecl.Members[k]);
  941. Write(ContentFile, Chr(Ord(Member.Visibility) + Ord('0')));
  942. SetLength(s, 0);
  943. if Member.ClassType = TPasVariable then
  944. Write(ContentFile, 'V')
  945. else if Member.ClassType = TPasProperty then
  946. begin
  947. Write(ContentFile, 'P');
  948. if Length(TPasProperty(Member).ReadAccessorName) > 0 then
  949. s := s + 'r';
  950. if Length(TPasProperty(Member).WriteAccessorName) > 0 then
  951. s := s + 'w';
  952. if Length(TPasProperty(Member).StoredAccessorName) > 0 then
  953. s := s + 's';
  954. end else
  955. Write(ContentFile, 'M'); // Member must be a method
  956. Write(ContentFile, Member.Name);
  957. if Length(s) > 0 then
  958. WriteLn(ContentFile, ' ', s)
  959. else
  960. WriteLn(ContentFile);
  961. end;
  962. end;
  963. end;
  964. end;
  965. finally
  966. Close(ContentFile);
  967. end;
  968. end;
  969. function TFPDocEngine.CreateElement(AClass: TPTreeElement; const AName: String;
  970. AParent: TPasElement; AVisibility: TPasMemberVisibility;
  971. const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
  972. begin
  973. Result := AClass.Create(AName, AParent);
  974. Result.Visibility := AVisibility;
  975. if AClass.InheritsFrom(TPasModule) then
  976. CurModule := TPasModule(Result);
  977. Result.SourceFilename := ASourceFilename;
  978. Result.SourceLinenumber := ASourceLinenumber;
  979. end;
  980. function TFPDocEngine.FindElement(const AName: String): TPasElement;
  981. function FindInModule(AModule: TPasModule; const LocalName: String): TPasElement;
  982. var
  983. l: TList;
  984. i: Integer;
  985. begin
  986. If assigned(AModule.InterfaceSection) and
  987. Assigned(AModule.InterfaceSection.Declarations) then
  988. begin
  989. l:=AModule.InterfaceSection.Declarations;
  990. for i := 0 to l.Count - 1 do
  991. begin
  992. Result := TPasElement(l[i]);
  993. if CompareText(Result.Name, LocalName) = 0 then
  994. exit;
  995. end;
  996. end;
  997. Result := nil;
  998. end;
  999. var
  1000. i: Integer;
  1001. //ModuleName, LocalName: String;
  1002. Module: TPasElement;
  1003. begin
  1004. {!!!: Don't know if we ever will have to use the following:
  1005. i := Pos('.', AName);
  1006. if i <> 0 then
  1007. begin
  1008. WriteLn('Dot found in name: ', AName);
  1009. Result := nil;
  1010. end else
  1011. begin}
  1012. Result := FindInModule(CurModule, AName);
  1013. if not Assigned(Result) then
  1014. for i := CurModule.InterfaceSection.UsesList.Count - 1 downto 0 do
  1015. begin
  1016. Module := TPasElement(CurModule.InterfaceSection.UsesList[i]);
  1017. if Module.ClassType = TPasModule then
  1018. begin
  1019. Result := FindInModule(TPasModule(Module), AName);
  1020. if Assigned(Result) then
  1021. exit;
  1022. end;
  1023. end;
  1024. {end;}
  1025. end;
  1026. function TFPDocEngine.FindModule(const AName: String): TPasModule;
  1027. function FindInPackage(APackage: TPasPackage): TPasModule;
  1028. var
  1029. i: Integer;
  1030. begin
  1031. for i := 0 to APackage.Modules.Count - 1 do
  1032. begin
  1033. Result := TPasModule(APackage.Modules[i]);
  1034. if CompareText(Result.Name, AName) = 0 then
  1035. exit;
  1036. end;
  1037. Result := nil;
  1038. end;
  1039. var
  1040. i: Integer;
  1041. begin
  1042. Result := FindInPackage(Package);
  1043. if not Assigned(Result) then
  1044. for i := FPackages.Count - 1 downto 0 do
  1045. begin
  1046. if TPasPackage(FPackages[i]) = Package then
  1047. continue;
  1048. Result := FindInPackage(TPasPackage(FPackages[i]));
  1049. if Assigned(Result) then
  1050. exit;
  1051. end;
  1052. end;
  1053. procedure TFPDocEngine.AddLink(const APathName, ALinkTo: String);
  1054. begin
  1055. RootLinkNode.CreateChildren(APathName, ALinkTo);
  1056. end;
  1057. function TFPDocEngine.FindAbsoluteLink(const AName: String): String;
  1058. var
  1059. LinkNode: TLinkNode;
  1060. begin
  1061. LinkNode := RootLinkNode.FindChild(AName);
  1062. if Assigned(LinkNode) then
  1063. Result := LinkNode.Link
  1064. else
  1065. SetLength(Result, 0);
  1066. end;
  1067. function TFPDocEngine.ResolveLink(AModule: TPasModule;
  1068. const ALinkDest: String): String;
  1069. var
  1070. i: Integer;
  1071. ThisPackage: TLinkNode;
  1072. UnitList: TList;
  1073. function CanWeExit(AResult: string): boolean;
  1074. var
  1075. s: string;
  1076. begin
  1077. s := StringReplace(Lowercase(ALinkDest), '.', '_', [rfReplaceAll]);
  1078. Result := pos(s, AResult) > 0;
  1079. end;
  1080. begin
  1081. //system.WriteLn('ResolveLink(', AModule.Name, ' - ', ALinkDest, ')... ');
  1082. if Length(ALinkDest) = 0 then
  1083. begin
  1084. SetLength(Result, 0);
  1085. exit;
  1086. end;
  1087. if (ALinkDest[1] = '#') or (not assigned(AModule)) then
  1088. Result := FindAbsoluteLink(ALinkDest)
  1089. else
  1090. begin
  1091. if Pos(AModule.Name, ALinkDest) = 1 then
  1092. begin
  1093. Result := ResolveLink(AModule, amodule.packagename + '.' + ALinkDest);
  1094. if CanWeExit(Result) then
  1095. Exit;
  1096. end
  1097. else
  1098. begin
  1099. Result := ResolveLink(AModule, AModule.PathName + '.' + ALinkDest);
  1100. if CanWeExit(Result) then
  1101. Exit;
  1102. end;
  1103. { Try all packages }
  1104. SetLength(Result, 0);
  1105. ThisPackage := RootLinkNode.FirstChild;
  1106. while Assigned(ThisPackage) do
  1107. begin
  1108. Result := ResolveLink(AModule, ThisPackage.Name + '.' + ALinkDest);
  1109. if CanWeExit(Result) then
  1110. Exit;
  1111. ThisPackage := ThisPackage.NextSibling;
  1112. end;
  1113. if not CanWeExit(Result) then
  1114. begin
  1115. { Okay, then we have to try all imported units of the current module }
  1116. UnitList := AModule.InterfaceSection.UsesList;
  1117. for i := UnitList.Count - 1 downto 0 do
  1118. begin
  1119. { Try all packages }
  1120. ThisPackage := RootLinkNode.FirstChild;
  1121. while Assigned(ThisPackage) do
  1122. begin
  1123. Result := ResolveLink(AModule, ThisPackage.Name + '.' +
  1124. TPasType(UnitList[i]).Name + '.' + ALinkDest);
  1125. if CanWeExit(Result) then
  1126. Exit;
  1127. ThisPackage := ThisPackage.NextSibling;
  1128. end;
  1129. end;
  1130. end;
  1131. end;
  1132. if Length(Result) = 0 then
  1133. for i := Length(ALinkDest) downto 1 do
  1134. if ALinkDest[i] = '.' then
  1135. begin
  1136. Result := ResolveLink(AModule, Copy(ALinkDest, 1, i - 1));
  1137. exit;
  1138. end;
  1139. end;
  1140. procedure TFPDocEngine.AddDocFile(const AFilename: String);
  1141. function ReadNode(OwnerDocNode: TDocNode; Element: TDOMElement): TDocNode;
  1142. var
  1143. Subnode: TDOMNode;
  1144. begin
  1145. if OwnerDocNode = RootDocNode then
  1146. Result := OwnerDocNode.CreateChildren('#' + Element['name'])
  1147. else
  1148. Result := OwnerDocNode.CreateChildren(Element['name']);
  1149. Result.FNode := Element;
  1150. Result.FLink := Element['link'];
  1151. Result.FIsSkipped := Element['skip'] = '1';
  1152. Subnode := Element.FirstChild;
  1153. while Assigned(Subnode) do
  1154. begin
  1155. if Subnode.NodeType = ELEMENT_NODE then
  1156. begin
  1157. if Subnode.NodeName = 'short' then
  1158. Result.FShortDescr := TDOMElement(Subnode)
  1159. else if Subnode.NodeName = 'descr' then
  1160. Result.FDescr := TDOMElement(Subnode)
  1161. else if Subnode.NodeName = 'version' then
  1162. begin
  1163. Result.FVersion := TDOMElement(Subnode)
  1164. end
  1165. else if Subnode.NodeName = 'errors' then
  1166. Result.FErrorsDoc := TDOMElement(Subnode)
  1167. else if Subnode.NodeName = 'seealso' then
  1168. Result.FSeeAlso := TDOMElement(Subnode)
  1169. else if (Subnode.NodeName = 'example') and
  1170. not Assigned(Result.FirstExample) then
  1171. Result.FFirstExample := TDOMElement(Subnode);
  1172. end;
  1173. Subnode := Subnode.NextSibling;
  1174. end;
  1175. end;
  1176. Procedure ReadTopics(TopicNode : TDocNode);
  1177. Var
  1178. SubNode : TDOMNode;
  1179. begin
  1180. SubNode:=TopicNode.FNode.FirstChilD;
  1181. While Assigned(SubNode) do
  1182. begin
  1183. If (SubNode.NodeType=ELEMENT_NODE) and (SubNode.NodeName='topic') then
  1184. With ReadNode(TopicNode,TDomElement(SubNode)) do
  1185. // We could allow recursion here, but we won't, because it doesn't work on paper.
  1186. FTopicNode:=True;
  1187. SubNode:=Subnode.NextSibling;
  1188. end;
  1189. end;
  1190. var
  1191. i: Integer;
  1192. Node, Subnode, Subsubnode: TDOMNode;
  1193. Element: TDOMElement;
  1194. Doc: TXMLDocument;
  1195. PackageDocNode, TopicNode,ModuleDocNode: TDocNode;
  1196. begin
  1197. ReadXMLFile(Doc, AFilename);
  1198. DescrDocs.Add(Doc);
  1199. DescrDocNames.Add(AFilename);
  1200. Node := Doc.DocumentElement.FirstChild;
  1201. while Assigned(Node) do
  1202. begin
  1203. if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'package') then
  1204. begin
  1205. PackageDocNode := ReadNode(RootDocNode, TDOMElement(Node));
  1206. PackageDocNode.IncRefCount;
  1207. // Scan all 'module' elements within this package element
  1208. Subnode := Node.FirstChild;
  1209. while Assigned(Subnode) do
  1210. begin
  1211. if (Subnode.NodeType = ELEMENT_NODE) then
  1212. begin
  1213. If (Subnode.NodeName = 'module') then
  1214. begin
  1215. ModuleDocNode := ReadNode(PackageDocNode, TDOMElement(Subnode));
  1216. // Scan all 'element' elements within this module element
  1217. Subsubnode := Subnode.FirstChild;
  1218. while Assigned(Subsubnode) do
  1219. begin
  1220. if (Subsubnode.NodeType = ELEMENT_NODE) then
  1221. begin
  1222. if (Subsubnode.NodeName = 'element') then
  1223. ReadNode(ModuleDocNode, TDOMElement(Subsubnode))
  1224. else if (SubSubNode.NodeName='topic') then
  1225. begin
  1226. TopicNode:=ReadNode(ModuleDocNode,TDomElement(SubSubNode));
  1227. TopicNode.FTopicNode:=True;
  1228. ReadTopics(TopicNode);
  1229. end;
  1230. end;
  1231. Subsubnode := Subsubnode.NextSibling;
  1232. end;
  1233. end
  1234. else if (SubNode.NodeName='topic') then
  1235. begin
  1236. TopicNode:=ReadNode(PackageDocNode,TDomElement(SubNode));
  1237. TopicNode.FTopicNode:=True;
  1238. ReadTopics(TopicNode);
  1239. end;
  1240. end;
  1241. Subnode := Subnode.NextSibling;
  1242. end;
  1243. end;
  1244. Node := Node.NextSibling;
  1245. end;
  1246. end;
  1247. function TFPDocEngine.FindDocNode(AElement: TPasElement): TDocNode;
  1248. begin
  1249. Result:=Nil;
  1250. If Assigned(AElement) then
  1251. begin
  1252. if AElement.InheritsFrom(TPasUnresolvedTypeRef) then
  1253. Result := FindDocNode(AElement.GetModule, AElement.Name)
  1254. else
  1255. Result := RootDocNode.FindChild(AElement.PathName);
  1256. if (Result=Nil) and
  1257. WarnNoNode and
  1258. (Length(AElement.PathName)>0) and
  1259. (AElement.PathName[1]='#') then
  1260. Writeln('No documentation node found for identifier : ',AElement.PathName);
  1261. end;
  1262. end;
  1263. function TFPDocEngine.FindDocNode(ARefModule: TPasModule;
  1264. const AName: String): TDocNode;
  1265. var
  1266. CurPackage: TDocNode;
  1267. UnitList: TList;
  1268. i: Integer;
  1269. begin
  1270. if Length(AName) = 0 then
  1271. Result := nil
  1272. else
  1273. begin
  1274. if AName[1] = '#' then
  1275. Result := RootDocNode.FindChild(AName)
  1276. else
  1277. Result := RootDocNode.FindChild(Package.Name + '.' + AName);
  1278. if (not Assigned(Result)) and Assigned(ARefModule) then
  1279. Result := RootDocNode.FindChild(ARefModule.PathName + '.' + AName);
  1280. if (not Assigned(Result)) and (AName[1] <> '#') then
  1281. begin
  1282. CurPackage := RootDocNode.FirstChild;
  1283. while Assigned(CurPackage) do
  1284. begin
  1285. Result := RootDocNode.FindChild(CurPackage.Name + '.' + AName);
  1286. if Assigned(Result) then
  1287. break;
  1288. CurPackage := CurPackage.NextSibling;
  1289. end;
  1290. if not Assigned(Result) then
  1291. begin
  1292. { Okay, then we have to try all imported units of the current module }
  1293. UnitList := CurModule.InterfaceSection.UsesList;
  1294. for i := UnitList.Count - 1 downto 0 do
  1295. begin
  1296. { Try all packages }
  1297. CurPackage := RootDocNode.FirstChild;
  1298. while Assigned(CurPackage) do
  1299. begin
  1300. Result := RootDocNode.FindChild(CurPackage.Name + '.' +
  1301. TPasType(UnitList[i]).Name + '.' + AName);
  1302. if Assigned(Result) then
  1303. break;
  1304. CurPackage := CurPackage.NextSibling;
  1305. end;
  1306. end;
  1307. end;
  1308. end;
  1309. end;
  1310. end;
  1311. function TFPDocEngine.FindShortDescr(AElement: TPasElement): TDOMElement;
  1312. var
  1313. DocNode,N: TDocNode;
  1314. begin
  1315. DocNode := FindDocNode(AElement);
  1316. if Assigned(DocNode) then
  1317. begin
  1318. N:=FindLinkedNode(DocNode);
  1319. If (N<>Nil) then
  1320. DocNode:=N;
  1321. Result := DocNode.ShortDescr;
  1322. end
  1323. else
  1324. Result := nil;
  1325. end;
  1326. function TFPDocEngine.FindLinkedNode(ANode : TDocNode) : TDocNode;
  1327. Var
  1328. S: String;
  1329. begin
  1330. If (ANode.Link='') then
  1331. Result:=Nil
  1332. else
  1333. Result:=FindDocNode(CurModule,ANode.Link);
  1334. end;
  1335. function TFPDocEngine.FindShortDescr(ARefModule: TPasModule;
  1336. const AName: String): TDOMElement;
  1337. var
  1338. N,DocNode: TDocNode;
  1339. begin
  1340. DocNode := FindDocNode(ARefModule, AName);
  1341. if Assigned(DocNode) then
  1342. begin
  1343. N:=FindLinkedNode(DocNode);
  1344. If (N<>Nil) then
  1345. DocNode:=N;
  1346. Result := DocNode.ShortDescr;
  1347. end
  1348. else
  1349. Result := nil;
  1350. end;
  1351. function TFPDocEngine.GetExampleFilename(const ExElement: TDOMElement): String;
  1352. var
  1353. i: Integer;
  1354. fn : String;
  1355. begin
  1356. Result:='';
  1357. for i := 0 to DescrDocs.Count - 1 do
  1358. begin
  1359. Fn:=ExElement['file'];
  1360. if (FN<>'') and (TDOMDocument(DescrDocs[i]) = ExElement.OwnerDocument) then
  1361. begin
  1362. Result := ExtractFilePath(DescrDocNames[i]) + FN;
  1363. if (ExtractFileExt(Result)='') then
  1364. Result:=Result+'.pp';
  1365. end;
  1366. end;
  1367. end;
  1368. { Global helpers }
  1369. procedure TranslateDocStrings(const Lang: String);
  1370. Const
  1371. {$ifdef unix}
  1372. DefDir = '/usr/local/share/locale';
  1373. {$else}
  1374. DefDir = 'intl';
  1375. {$endif}
  1376. var
  1377. mo: TMOFile;
  1378. dir : string;
  1379. begin
  1380. dir:=modir;
  1381. If Dir='' then
  1382. Dir:=DefDir;
  1383. Dir:=IncludeTrailingPathDelimiter(Dir);
  1384. {$IFDEF Unix}
  1385. mo := TMOFile.Create(Format(Dir+'%s/LC_MESSAGES/dglobals.mo', [Lang]));
  1386. {$ELSE}
  1387. mo := TMOFile.Create(Format(Dir+'dglobals.%s.mo', [Lang]));
  1388. {$ENDIF}
  1389. try
  1390. TranslateResourceStrings(mo);
  1391. finally
  1392. mo.Free;
  1393. end;
  1394. end;
  1395. Function IsLinkNode(Node : TDomNode) : Boolean;
  1396. begin
  1397. Result:=Assigned(Node) and (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'link');
  1398. end;
  1399. Function IsExampleNode(Example : TDomNode) : Boolean;
  1400. begin
  1401. Result:=Assigned(Example) and (Example.NodeType = ELEMENT_NODE) and (Example.NodeName = 'example')
  1402. end;
  1403. function IsLinkAbsolute(ALink: String): boolean;
  1404. var
  1405. i: integer;
  1406. begin
  1407. Result := false;
  1408. for i := low(AbsoluteLinkPrefixes) to high(AbsoluteLinkPrefixes) do
  1409. if CompareText(AbsoluteLinkPrefixes[i], copy(ALink,1,length(AbsoluteLinkPrefixes[i])))=0 then begin
  1410. Result := true;
  1411. break;
  1412. end;
  1413. end;
  1414. initialization
  1415. LEOL:=Length(LineEnding);
  1416. end.