dglobals.pp 48 KB

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