dglobals.pp 47 KB

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