dglobals.pp 47 KB

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