dglobals.pp 46 KB

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