dglobals.pp 50 KB

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