dglobals.pp 53 KB

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