dglobals.pp 53 KB

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