dglobals.pp 51 KB

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