dglobals.pp 53 KB

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