dglobals.pp 50 KB

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