dglobals.pp 50 KB

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