dglobals.pp 51 KB

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