dglobals.pp 51 KB

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