dglobals.pp 54 KB

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