dglobals.pp 55 KB

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