dglobals.pp 51 KB

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