dglobals.pp 53 KB

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