dglobals.pp 51 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672
  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. for j := 0 to Module.InterfaceSection.Classes.Count - 1 do
  968. begin
  969. ClassDecl := TPasClassType(Module.InterfaceSection.Classes[j]);
  970. Write(ContentFile, CheckImplicitInterfaceLink(ClassDecl.PathName), ' ');
  971. if Assigned(ClassDecl.AncestorType) then
  972. begin
  973. // simple aliases to class types are coded as "alias(classtype)"
  974. Write(ContentFile, CheckImplicitInterfaceLink(ClassDecl.AncestorType.PathName));
  975. if ClassDecl.AncestorType is TPasAliasType then
  976. begin
  977. alias:= TPasAliasType(ClassDecl.AncestorType);
  978. if assigned(alias.desttype) and (alias.desttype is TPasClassType) then
  979. write(ContentFile,'(',alias.desttype.PathName,')');
  980. end;
  981. end
  982. else if ClassDecl.ObjKind = okClass then
  983. Write(ContentFile, '#rtl.System.TObject')
  984. else if ClassDecl.ObjKind = okInterface then
  985. Write(ContentFile, '#rtl.System.IUnknown');
  986. if ClassDecl.Interfaces.Count>0 then
  987. begin
  988. for k:=0 to ClassDecl.Interfaces.count-1 do
  989. begin
  990. write(contentfile,',',CheckImplicitInterfaceLink(TPasClassType(ClassDecl.Interfaces[k]).PathName));
  991. if TPasElement(ClassDecl.Interfaces[k]) is TPasAliasType then
  992. begin
  993. alias:= TPasAliasType(ClassDecl.Interfaces[k]);
  994. if assigned(alias.desttype) and (alias.desttype is TPasClassType) then
  995. write(ContentFile,'(',CheckImplicitInterfaceLink(alias.desttype.PathName),')');
  996. end;
  997. end;
  998. end;
  999. writeln(contentfile);
  1000. for k := 0 to ClassDecl.Members.Count - 1 do
  1001. begin
  1002. Member := TPasElement(ClassDecl.Members[k]);
  1003. Write(ContentFile, Chr(Ord(Member.Visibility) + Ord('0')));
  1004. SetLength(s, 0);
  1005. if Member.ClassType = TPasVariable then
  1006. Write(ContentFile, 'V')
  1007. else if Member.ClassType = TPasProperty then
  1008. begin
  1009. Write(ContentFile, 'P');
  1010. if Length(TPasProperty(Member).ReadAccessorName) > 0 then
  1011. s := s + 'r';
  1012. if Length(TPasProperty(Member).WriteAccessorName) > 0 then
  1013. s := s + 'w';
  1014. if Length(TPasProperty(Member).StoredAccessorName) > 0 then
  1015. s := s + 's';
  1016. end else
  1017. Write(ContentFile, 'M'); // Member must be a method
  1018. Write(ContentFile, Member.Name);
  1019. if Length(s) > 0 then
  1020. WriteLn(ContentFile, ' ', s)
  1021. else
  1022. WriteLn(ContentFile);
  1023. end;
  1024. end;
  1025. end;
  1026. end;
  1027. finally
  1028. Close(ContentFile);
  1029. end;
  1030. end;
  1031. function TFPDocEngine.CreateElement(AClass: TPTreeElement; const AName: String;
  1032. AParent: TPasElement; AVisibility: TPasMemberVisibility;
  1033. const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
  1034. begin
  1035. Result := AClass.Create(AName, AParent);
  1036. Result.Visibility := AVisibility;
  1037. if AClass.InheritsFrom(TPasModule) then
  1038. CurModule := TPasModule(Result);
  1039. Result.SourceFilename := ASourceFilename;
  1040. Result.SourceLinenumber := ASourceLinenumber;
  1041. end;
  1042. function TFPDocEngine.FindElement(const AName: String): TPasElement;
  1043. function FindInModule(AModule: TPasModule; const LocalName: String): TPasElement;
  1044. var
  1045. l: TFPList;
  1046. i: Integer;
  1047. begin
  1048. If assigned(AModule.InterfaceSection) and
  1049. Assigned(AModule.InterfaceSection.Declarations) then
  1050. begin
  1051. l:=AModule.InterfaceSection.Declarations;
  1052. for i := 0 to l.Count - 1 do
  1053. begin
  1054. Result := TPasElement(l[i]);
  1055. if CompareText(Result.Name, LocalName) = 0 then
  1056. exit;
  1057. end;
  1058. end;
  1059. Result := nil;
  1060. end;
  1061. var
  1062. i: Integer;
  1063. Module: TPasElement;
  1064. begin
  1065. Result := FindInModule(CurModule, AName);
  1066. if not Assigned(Result) then
  1067. for i := CurModule.InterfaceSection.UsesList.Count - 1 downto 0 do
  1068. begin
  1069. Module := TPasElement(CurModule.InterfaceSection.UsesList[i]);
  1070. if Module.ClassType = TPasModule then
  1071. begin
  1072. Result := FindInModule(TPasModule(Module), AName);
  1073. if Assigned(Result) then
  1074. exit;
  1075. end;
  1076. end;
  1077. end;
  1078. function TFPDocEngine.FindModule(const AName: String): TPasModule;
  1079. function FindInPackage(APackage: TPasPackage): TPasModule;
  1080. var
  1081. i: Integer;
  1082. begin
  1083. for i := 0 to APackage.Modules.Count - 1 do
  1084. begin
  1085. Result := TPasModule(APackage.Modules[i]);
  1086. if CompareText(Result.Name, AName) = 0 then
  1087. exit;
  1088. end;
  1089. Result := nil;
  1090. end;
  1091. var
  1092. i: Integer;
  1093. AInPutLine,OSTarget,CPUTarget : String;
  1094. begin
  1095. Result := FindInPackage(Package);
  1096. if not Assigned(Result) then
  1097. for i := FPackages.Count - 1 downto 0 do
  1098. begin
  1099. if TPasPackage(FPackages[i]) = Package then
  1100. continue;
  1101. Result := FindInPackage(TPasPackage(FPackages[i]));
  1102. if Assigned(Result) then
  1103. exit;
  1104. end;
  1105. if Not Assigned(Result) and Assigned(FOnParseUnit) then
  1106. begin
  1107. FOnParseUnit(Self,AName,AInputLine,OSTarget,CPUTarget);
  1108. If (AInPutLine<>'') then
  1109. Result:=ParseUsedUnit(AName,AInputLine,OSTarget,CPUTarget);
  1110. end;
  1111. end;
  1112. Function TFPDocEngine.ParseUsedUnit(AName,AInputLine,AOSTarget,ACPUTarget : String) : TPasModule;
  1113. Var
  1114. M : TPasModule;
  1115. begin
  1116. DoLog(SParsingUsedUnit,[AName,AInputLine]);
  1117. M:=CurModule;
  1118. CurModule:=Nil;
  1119. try
  1120. ParseSource(Self,AInputLine,AOSTarget,ACPUTarget,True);
  1121. Result:=CurModule;
  1122. finally
  1123. CurModule:=M;
  1124. end;
  1125. end;
  1126. procedure TFPDocEngine.AddLink(const APathName, ALinkTo: String);
  1127. begin
  1128. RootLinkNode.CreateChildren(APathName, ALinkTo);
  1129. end;
  1130. function TFPDocEngine.FindAbsoluteLink(const AName: String): String;
  1131. var
  1132. LinkNode: TLinkNode;
  1133. begin
  1134. LinkNode := RootLinkNode.FindChild(AName);
  1135. if Assigned(LinkNode) then
  1136. Result := LinkNode.Link
  1137. else
  1138. SetLength(Result, 0);
  1139. end;
  1140. function TFPDocEngine.ResolveLinkInPackages(AModule: TPasModule; const ALinkDest: String; Strict : Boolean = False): String;
  1141. Var
  1142. ThisPackage: TLinkNode;
  1143. begin
  1144. { Try all packages }
  1145. Result:='';
  1146. ThisPackage:=RootLinkNode.FirstChild;
  1147. while Assigned(ThisPackage) and (Result='') do
  1148. begin
  1149. Result:=ResolveLink(AModule, ThisPackage.Name + '.' + ALinkDest, Strict);
  1150. ThisPackage := ThisPackage.NextSibling;
  1151. end;
  1152. end;
  1153. function TFPDocEngine.ResolveLinkInUsedUnits(AModule: TPasModule; const ALinkDest: String; Strict : Boolean = False): String;
  1154. var
  1155. i: Integer;
  1156. UL: TFPList;
  1157. begin
  1158. Result:='';
  1159. UL:=AModule.InterfaceSection.UsesList;
  1160. I:=UL.Count-1;
  1161. While (Result='') and (I>=0) do
  1162. begin
  1163. Result:=ResolveLinkInPackages(AModule,TPasType(UL[i]).Name+'.'+ALinkDest, strict);
  1164. Dec(I);
  1165. end;
  1166. end;
  1167. function TFPDocEngine.ResolveLink(AModule: TPasModule; const ALinkDest: String; Strict : Boolean = False): String;
  1168. var
  1169. i: Integer;
  1170. begin
  1171. {
  1172. if Assigned(AModule) then
  1173. system.WriteLn('ResolveLink(', AModule.Name, ' - ', ALinkDest, ')... ')
  1174. else
  1175. system.WriteLn('ResolveLink(Nil - ', ALinkDest, ')... ');
  1176. }
  1177. if (ALinkDest='') then
  1178. Exit('');
  1179. if (ALinkDest[1] = '#') then
  1180. Result := FindAbsoluteLink(ALinkDest)
  1181. else if (AModule=Nil) then
  1182. Result:= FindAbsoluteLink(RootLinkNode.FirstChild.Name+'.'+ALinkDest)
  1183. else
  1184. begin
  1185. if Pos(AModule.Name,ALinkDest) = 1 then
  1186. Result := ResolveLink(AModule, AModule.packagename + '.' + ALinkDest, Strict)
  1187. else
  1188. Result := ResolveLink(AModule, AModule.PathName + '.' + ALinkDest, Strict);
  1189. if (Result='') then
  1190. begin
  1191. Result:=ResolveLinkInPackages(AModule,ALinkDest,Strict);
  1192. if (Result='') then
  1193. Result:=ResolveLinkInUsedUnits(Amodule,AlinkDest,Strict);
  1194. end;
  1195. end;
  1196. // Match on parent : class/enumerated/record/module
  1197. if (Result='') and not strict then
  1198. for i := Length(ALinkDest) downto 1 do
  1199. if ALinkDest[i] = '.' then
  1200. begin
  1201. Result := ResolveLink(AModule, Copy(ALinkDest, 1, i - 1), Strict);
  1202. exit;
  1203. end;
  1204. end;
  1205. procedure ReadXMLFileALT(OUT ADoc:TXMLDocument;const AFileName:ansistring);
  1206. var
  1207. Parser: TDOMParser;
  1208. Src: TXMLInputSource;
  1209. FileStream: TStream;
  1210. begin
  1211. ADoc := nil;
  1212. FileStream := TFileStream.Create(AFilename, fmOpenRead+fmShareDenyWrite);
  1213. try
  1214. Parser := TDOMParser.Create; // create a parser object
  1215. try
  1216. Src := TXMLInputSource.Create(FileStream); // and the input source
  1217. src.SystemId:=FileNameToUri(AFileName);
  1218. try
  1219. Parser.Options.PreserveWhitespace := True;
  1220. Parser.Parse(Src, ADoc);
  1221. finally
  1222. Src.Free; // cleanup
  1223. end;
  1224. finally
  1225. Parser.Free;
  1226. end;
  1227. finally
  1228. FileStream.Free;
  1229. end;
  1230. end;
  1231. procedure TFPDocEngine.AddDocFile(const AFilename: String;DontTrim:boolean=false);
  1232. function ReadNode(OwnerDocNode: TDocNode; Element: TDOMElement): TDocNode;
  1233. var
  1234. Subnode: TDOMNode;
  1235. begin
  1236. if OwnerDocNode = RootDocNode then
  1237. Result := OwnerDocNode.CreateChildren('#' + Element['name'])
  1238. else
  1239. Result := OwnerDocNode.CreateChildren(Element['name']);
  1240. Result.FNode := Element;
  1241. Result.FLink := Element['link'];
  1242. Result.FIsSkipped := Element['skip'] = '1';
  1243. Subnode := Element.FirstChild;
  1244. while Assigned(Subnode) do
  1245. begin
  1246. if Subnode.NodeType = ELEMENT_NODE then
  1247. begin
  1248. if Subnode.NodeName = 'short' then
  1249. Result.FShortDescr := TDOMElement(Subnode)
  1250. else if Subnode.NodeName = 'descr' then
  1251. Result.FDescr := TDOMElement(Subnode)
  1252. else if Subnode.NodeName = 'version' then
  1253. begin
  1254. Result.FVersion := TDOMElement(Subnode)
  1255. end
  1256. else if Subnode.NodeName = 'errors' then
  1257. Result.FErrorsDoc := TDOMElement(Subnode)
  1258. else if Subnode.NodeName = 'seealso' then
  1259. Result.FSeeAlso := TDOMElement(Subnode)
  1260. else if (Subnode.NodeName = 'example') and
  1261. not Assigned(Result.FirstExample) then
  1262. Result.FFirstExample := TDOMElement(Subnode)
  1263. else if (Subnode.NodeName = 'notes') then
  1264. Result.FNotes := TDOMElement(Subnode);
  1265. end;
  1266. Subnode := Subnode.NextSibling;
  1267. end;
  1268. end;
  1269. Procedure ReadTopics(TopicNode : TDocNode);
  1270. Var
  1271. SubNode : TDOMNode;
  1272. begin
  1273. SubNode:=TopicNode.FNode.FirstChilD;
  1274. While Assigned(SubNode) do
  1275. begin
  1276. If (SubNode.NodeType=ELEMENT_NODE) and (SubNode.NodeName='topic') then
  1277. With ReadNode(TopicNode,TDomElement(SubNode)) do
  1278. // We could allow recursion here, but we won't, because it doesn't work on paper.
  1279. FTopicNode:=True;
  1280. SubNode:=Subnode.NextSibling;
  1281. end;
  1282. end;
  1283. var
  1284. i: Integer;
  1285. Node, Subnode, Subsubnode: TDOMNode;
  1286. Element: TDOMElement;
  1287. Doc: TXMLDocument;
  1288. PackageDocNode, TopicNode,ModuleDocNode: TDocNode;
  1289. begin
  1290. if DontTrim then
  1291. ReadXMLFileALT(Doc, AFilename)
  1292. else
  1293. ReadXMLFile(Doc, AFilename);
  1294. DescrDocs.Add(Doc);
  1295. DescrDocNames.Add(AFilename);
  1296. Node := Doc.DocumentElement.FirstChild;
  1297. while Assigned(Node) do
  1298. begin
  1299. if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'package') then
  1300. begin
  1301. PackageDocNode := ReadNode(RootDocNode, TDOMElement(Node));
  1302. PackageDocNode.IncRefCount;
  1303. // Scan all 'module' elements within this package element
  1304. Subnode := Node.FirstChild;
  1305. while Assigned(Subnode) do
  1306. begin
  1307. if (Subnode.NodeType = ELEMENT_NODE) then
  1308. begin
  1309. If (Subnode.NodeName = 'module') then
  1310. begin
  1311. ModuleDocNode := ReadNode(PackageDocNode, TDOMElement(Subnode));
  1312. // Scan all 'element' elements within this module element
  1313. Subsubnode := Subnode.FirstChild;
  1314. while Assigned(Subsubnode) do
  1315. begin
  1316. if (Subsubnode.NodeType = ELEMENT_NODE) then
  1317. begin
  1318. if (Subsubnode.NodeName = 'element') then
  1319. ReadNode(ModuleDocNode, TDOMElement(Subsubnode))
  1320. else if (SubSubNode.NodeName='topic') then
  1321. begin
  1322. TopicNode:=ReadNode(ModuleDocNode,TDomElement(SubSubNode));
  1323. TopicNode.FTopicNode:=True;
  1324. ReadTopics(TopicNode);
  1325. end;
  1326. end;
  1327. Subsubnode := Subsubnode.NextSibling;
  1328. end;
  1329. end
  1330. else if (SubNode.NodeName='topic') then
  1331. begin
  1332. TopicNode:=ReadNode(PackageDocNode,TDomElement(SubNode));
  1333. TopicNode.FTopicNode:=True;
  1334. ReadTopics(TopicNode);
  1335. end;
  1336. end;
  1337. Subnode := Subnode.NextSibling;
  1338. end;
  1339. end;
  1340. Node := Node.NextSibling;
  1341. end;
  1342. end;
  1343. function TFPDocEngine.FindDocNode(AElement: TPasElement): TDocNode;
  1344. begin
  1345. Result:=Nil;
  1346. If Assigned(AElement) then
  1347. begin
  1348. if AElement.InheritsFrom(TPasUnresolvedTypeRef) then
  1349. Result := FindDocNode(AElement.GetModule, AElement.Name)
  1350. else
  1351. Result := RootDocNode.FindChild(AElement.PathName);
  1352. if (Result=Nil) and
  1353. WarnNoNode and
  1354. (Length(AElement.PathName)>0) and
  1355. (AElement.PathName[1]='#') then
  1356. DoLog(Format('No documentation node found for identifier : %s',[AElement.PathName]));
  1357. end;
  1358. end;
  1359. function TFPDocEngine.FindDocNode(ARefModule: TPasModule;
  1360. const AName: String): TDocNode;
  1361. var
  1362. CurPackage: TDocNode;
  1363. UnitList: TFPList;
  1364. i: Integer;
  1365. begin
  1366. if Length(AName) = 0 then
  1367. Result := nil
  1368. else
  1369. begin
  1370. if AName[1] = '#' then
  1371. Result := RootDocNode.FindChild(AName)
  1372. else
  1373. Result := RootDocNode.FindChild(Package.Name + '.' + AName);
  1374. if (not Assigned(Result)) and Assigned(ARefModule) then
  1375. Result := RootDocNode.FindChild(ARefModule.PathName + '.' + AName);
  1376. if (not Assigned(Result)) and (AName[1] <> '#') then
  1377. begin
  1378. CurPackage := RootDocNode.FirstChild;
  1379. while Assigned(CurPackage) do
  1380. begin
  1381. Result := RootDocNode.FindChild(CurPackage.Name + '.' + AName);
  1382. if Assigned(Result) then
  1383. break;
  1384. CurPackage := CurPackage.NextSibling;
  1385. end;
  1386. if not Assigned(Result) then
  1387. begin
  1388. { Okay, then we have to try all imported units of the current module }
  1389. UnitList := CurModule.InterfaceSection.UsesList;
  1390. for i := UnitList.Count - 1 downto 0 do
  1391. begin
  1392. { Try all packages }
  1393. CurPackage := RootDocNode.FirstChild;
  1394. while Assigned(CurPackage) do
  1395. begin
  1396. Result := RootDocNode.FindChild(CurPackage.Name + '.' +
  1397. TPasType(UnitList[i]).Name + '.' + AName);
  1398. if Assigned(Result) then
  1399. break;
  1400. CurPackage := CurPackage.NextSibling;
  1401. end;
  1402. end;
  1403. end;
  1404. end;
  1405. end;
  1406. end;
  1407. function TFPDocEngine.FindShortDescr(AElement: TPasElement): TDOMElement;
  1408. var
  1409. DocNode,N: TDocNode;
  1410. begin
  1411. DocNode := FindDocNode(AElement);
  1412. if Assigned(DocNode) then
  1413. begin
  1414. N:=FindLinkedNode(DocNode);
  1415. If (N<>Nil) then
  1416. DocNode:=N;
  1417. Result := DocNode.ShortDescr;
  1418. end
  1419. else
  1420. Result := nil;
  1421. end;
  1422. function TFPDocEngine.FindLinkedNode(ANode : TDocNode) : TDocNode;
  1423. Var
  1424. S: String;
  1425. begin
  1426. If (ANode.Link='') then
  1427. Result:=Nil
  1428. else
  1429. Result:=FindDocNode(CurModule,ANode.Link);
  1430. end;
  1431. function TFPDocEngine.FindShortDescr(ARefModule: TPasModule;
  1432. const AName: String): TDOMElement;
  1433. var
  1434. N,DocNode: TDocNode;
  1435. begin
  1436. DocNode := FindDocNode(ARefModule, AName);
  1437. if Assigned(DocNode) then
  1438. begin
  1439. N:=FindLinkedNode(DocNode);
  1440. If (N<>Nil) then
  1441. DocNode:=N;
  1442. Result := DocNode.ShortDescr;
  1443. end
  1444. else
  1445. Result := nil;
  1446. end;
  1447. function TFPDocEngine.GetExampleFilename(const ExElement: TDOMElement): String;
  1448. var
  1449. i: Integer;
  1450. fn : String;
  1451. begin
  1452. Result:='';
  1453. for i := 0 to DescrDocs.Count - 1 do
  1454. begin
  1455. Fn:=ExElement['file'];
  1456. if (FN<>'') and (TDOMDocument(DescrDocs[i]) = ExElement.OwnerDocument) then
  1457. begin
  1458. Result := ExtractFilePath(DescrDocNames[i]) + FN;
  1459. if (ExtractFileExt(Result)='') then
  1460. Result:=Result+'.pp';
  1461. end;
  1462. end;
  1463. end;
  1464. { Global helpers }
  1465. procedure TranslateDocStrings(const Lang: String);
  1466. Const
  1467. {$ifdef unix}
  1468. DefDir = '/usr/local/share/locale';
  1469. {$else}
  1470. DefDir = 'intl';
  1471. {$endif}
  1472. var
  1473. mo: TMOFile;
  1474. dir : string;
  1475. begin
  1476. dir:=modir;
  1477. If Dir='' then
  1478. Dir:=DefDir;
  1479. Dir:=IncludeTrailingPathDelimiter(Dir);
  1480. {$IFDEF Unix}
  1481. mo := TMOFile.Create(Format(Dir+'%s/LC_MESSAGES/dglobals.mo', [Lang]));
  1482. {$ELSE}
  1483. mo := TMOFile.Create(Format(Dir+'dglobals.%s.mo', [Lang]));
  1484. {$ENDIF}
  1485. try
  1486. TranslateResourceStrings(mo);
  1487. finally
  1488. mo.Free;
  1489. end;
  1490. end;
  1491. Function IsLinkNode(Node : TDomNode) : Boolean;
  1492. begin
  1493. Result:=Assigned(Node) and (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'link');
  1494. end;
  1495. Function IsExampleNode(Example : TDomNode) : Boolean;
  1496. begin
  1497. Result:=Assigned(Example) and (Example.NodeType = ELEMENT_NODE) and (Example.NodeName = 'example')
  1498. end;
  1499. function IsLinkAbsolute(ALink: String): boolean;
  1500. var
  1501. i: integer;
  1502. begin
  1503. Result := false;
  1504. for i := low(AbsoluteLinkPrefixes) to high(AbsoluteLinkPrefixes) do
  1505. if CompareText(AbsoluteLinkPrefixes[i], copy(ALink,1,length(AbsoluteLinkPrefixes[i])))=0 then begin
  1506. Result := true;
  1507. break;
  1508. end;
  1509. end;
  1510. initialization
  1511. LEOL:=Length(LineEnding);
  1512. end.