dglobals.pp 48 KB

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