dglobals.pp 50 KB

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