dglobals.pp 53 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728
  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. SDocPage = 'Page';
  64. SDocMethod = 'Method';
  65. SDocProperty = 'Property';
  66. SDocAccess = 'Access';
  67. SDocInheritance = 'Inheritance';
  68. SDocProperties = 'Properties';
  69. SDocMethods = 'Methods';
  70. SDocEvents = 'Events';
  71. SDocByName = 'by Name';
  72. SDocValue = 'Value';
  73. SDocExplanation = 'Explanation';
  74. SDocProcedure = 'Procedure';
  75. SDocValuesForEnum = 'Enumeration values for type %s';
  76. SDocSourcePosition = 'Source position: %s line %d';
  77. SDocSynopsis = 'Synopsis';
  78. SDocVisibility = 'Visibility';
  79. SDocOpaque = 'Opaque type';
  80. SDocDateGenerated = 'Documentation generated on: %s';
  81. // The next line requires leading/trailing space due to XML comment layout:
  82. SDocGeneratedByComment = ' Generated using FPDoc - (c) 2000-2012 FPC contributors and Sebastian Guenther, [email protected] ';
  83. SDocNotes = 'Notes';
  84. // Topics
  85. SDocRelatedTopics = 'Related topics';
  86. SDocUp = 'Up';
  87. SDocNext = 'Next';
  88. SDocPrevious = 'Previous';
  89. // Various backend constants
  90. SDocChapter = 'Chapter';
  91. SDocSection = 'Section';
  92. SDocSubSection = 'Subsection';
  93. SDocTable = 'Table';
  94. SDocListing = 'Listing';
  95. // Man page usage
  96. SManUsageManSection = 'Use ASection as the man page section';
  97. SManUsageNoUnitPrefix = 'Do not prefix man pages with unit name.';
  98. SManUsageWriterDescr = 'UNIX man page output.';
  99. SManUsagePackageDescription = 'Use descr as the description of man pages';
  100. // HTML usage
  101. SHTMLUsageFooter = 'Append xhtml from file as footer to html page';
  102. SHTMLUsageFooterDate = 'Append footer with date. fmt is Optional format for FormatDateTime';
  103. SHTMLUsageCharset = 'Set the HTML character set';
  104. SHTMLHtmlSearch = 'Add search page with given name to the menu bar';
  105. SHTMLIndexColcount = 'Use N columns in the identifier index pages';
  106. SHTMLImageUrl = 'Prefix image URLs with url';
  107. SHTMLDisableMenuBrackets = 'Disable ''['' and '']'' characters around menu items at the top of the page. Useful for custom css';
  108. // CHM usage
  109. SCHMUsageTOC = 'Use [File] as the table of contents. Usually a .hhc file.';
  110. SCHMUsageIndex = 'Use [File] as the index. Usually a .hhk file.';
  111. SCHMUsageDefPage = 'Set the "Home" page relative to where it lives in the chm. i.e. "/index.html"';
  112. SCHMUsageOtrFiles= 'A txt file containing a list of files to be added relative to the working directory.';
  113. SCHMUsageCSSFile = 'Filename of a .css file to be included in the chm.';
  114. SCHMUsageAutoTOC = 'Automatically generate a Table of Contents. Ignores --toc-file';
  115. SCHMUsageAutoIDX = 'Automatically generate an Index. Ignores --index-file';
  116. SCHMUsageMakeSearch = 'Automatically generate a Search Index from filenames that match *.htm*';
  117. SCHMUsageChmTitle= 'Title of the chm. Defaults to the value from --package';
  118. // Linear usage
  119. SLinearUsageDupLinkedDocsP1 = 'Duplicate linked element documentation in';
  120. SLinearUsageDupLinkedDocsP2 = 'descendant classes.';
  121. STitle = 'FPDoc - Free Pascal Documentation Tool';
  122. SVersion = 'Version %s [%s]';
  123. SCopyright1 = '(c) 2000 - 2003 Areca Systems GmbH / Sebastian Guenther, [email protected]';
  124. SCopyright2 = '(c) 2005 - 2012 various FPC contributors';
  125. SCmdLineHelp = 'Usage: %s [options]';
  126. SUsageOption010 = '--content Create content file for package cross-references';
  127. SUsageOption020 = '--cputarget=value Set the target CPU for the scanner.';
  128. SUsageOption030 = '--descr=file use file as description file, e.g.: ';
  129. SUsageOption035 = ' --descr=c:\WIP\myzipperdoc.xml';
  130. SUsageOption040 = ' This option is allowed more than once';
  131. SUsageOption050 = '--descr-dir=Dir Add All XML files in Dir to list of description files';
  132. SUsageOption060 = '--format=fmt Select output format.';
  133. SUsageOption070 = '--help Show this help.';
  134. SUsageOption080 = '--hide-protected Do not show protected methods in overview';
  135. SUsageOption090 = '--import=file Import content file for package cross-references';
  136. SUsageOption100 = '--input=cmd use cmd as input for the parser, e.g.:';
  137. SUsageOption110 = ' --input=C:\fpc\packages\paszlib\src\zipper.pp';
  138. SUsageOption120 = ' At least one input option is required.';
  139. SUsageOption130 = '--input-dir=Dir Add All *.pp and *.pas files in Dir to list of input files';
  140. SUsageOption140 = '--lang=lng Select output language.';
  141. SUsageOption150 = '--ostarget=value Set the target OS for the scanner.';
  142. SUsageOption160 = '--output=name use name as the output name.';
  143. SUsageOption170 = ' Each backend interpretes this as needed.';
  144. SUsageOption180 = '--package=name Set the package name for which to create output,';
  145. SUsageOption190 = ' e.g. --package=fcl';
  146. SUsageOption200 = '--project=file Use file as project file';
  147. SUsageOption210 = '--show-private Show private methods.';
  148. SUsageOption220 = '--warn-no-node Warn if no documentation node was found.';
  149. SUsageOption230 = '--mo-dir=dir Set directory where language files reside to dir';
  150. SUsageOption240 = '--parse-impl (Experimental) try to parse implementation too';
  151. SUsageOption250 = '--dont-trim Do not trim XML contents. Useful for preserving';
  152. SUsageOption260 = ' formatting inside e.g <pre> tags';
  153. SUsageOption270 = '--write-project=file';
  154. SUsageOption280 = ' Do not write documentation, create project file instead';
  155. SUsageOption290 = '--verbose Write more information on the screen';
  156. SUsageOption300 = '--dry-run Only parse sources and XML, do not create output';
  157. SUsageOption310 = '--write-project=file';
  158. SUsageOption320 = ' Write all command-line options to a project file';
  159. SUsageFormats = 'The following output formats are supported by this fpdoc:';
  160. SUsageBackendHelp = 'Specify an output format, combined with --help to get more help for this backend.';
  161. SUsageFormatSpecific = 'Output format "%s" supports the following options:';
  162. SCmdLineInvalidOption = 'Ignoring unknown option "%s"';
  163. SCmdLineInvalidFormat = 'Invalid format "%s" specified';
  164. SCmdLineOutputOptionMissing = 'Need an output filename, please specify one with --output=<filename>';
  165. SWritingPages = 'Writing %d pages...';
  166. SNeedPackageName = 'No package name specified. Please specify one using the --package option.';
  167. SAvailablePackages = 'Available packages: ';
  168. SDone = 'Done.';
  169. SErrCouldNotCreateOutputDir = 'Could not create output directory "%s"';
  170. SErrCouldNotCreateFile = 'Could not create file "%s": %s';
  171. SSeeURL = '(See %s)'; // For linear text writers.
  172. SParsingUsedUnit = 'Parsing used unit "%s" with commandLine "%s"';
  173. Const
  174. SVisibility: array[TPasMemberVisibility] of string =
  175. ('Default', 'Private', 'Protected', 'Public',
  176. 'Published', 'Automated','Strict Private','Strict Protected');
  177. type
  178. // Assumes a list of TObject instances and frees them on destruction
  179. TObjectList = class(TFPList)
  180. public
  181. destructor Destroy; override;
  182. end;
  183. TPasExternalClassType = Class(TPasClassType);
  184. TPasExternalModule = Class(TPasModule);
  185. { Link entry tree
  186. TFPDocEngine stores the root of the entry tree in its property
  187. "RootLinkNode". The root has one child node for each package, for which
  188. documentation links are available. The children of a package node
  189. are module nodes; and the children of a module node are the top-level
  190. declarations of this module; the next level in the tree stores e.g. record
  191. members, and so on...
  192. }
  193. TLinkNode = class
  194. private
  195. FFirstChild, FNextSibling: TLinkNode;
  196. FName: String;
  197. FLink: String;
  198. public
  199. constructor Create(const AName, ALink: String);
  200. destructor Destroy; override;
  201. function FindChild(const APathName: String): TLinkNode;
  202. function CreateChildren(const APathName, ALinkTo: String): TLinkNode;
  203. // Properties for tree structure
  204. property FirstChild: TLinkNode read FFirstChild;
  205. property NextSibling: TLinkNode read FNextSibling;
  206. // Link properties
  207. property Name: String read FName;
  208. property Link: String read FLink;
  209. end;
  210. { Documentation entry tree
  211. TFPDocEngine stores the root of the entry tree in its property
  212. "RootDocNode". The root has one child node for each package, for which
  213. documentation is being provided by the user. The children of a package node
  214. are module nodes; and the children of a module node are the top-level
  215. declarations of this module; the next level in the tree stores e.g. record
  216. members, and so on...
  217. }
  218. { TDocNode }
  219. TDocNode = class
  220. private
  221. FFirstChild, FNextSibling: TDocNode;
  222. FName: String;
  223. FNode: TDOMElement;
  224. FIsSkipped: Boolean;
  225. FShortDescr: TDOMElement;
  226. FDescr: TDOMElement;
  227. FErrorsDoc: TDOMElement;
  228. FSeeAlso: TDOMElement;
  229. FFirstExample: TDOMElement;
  230. FNotes : TDomElement;
  231. FLink: String;
  232. FTopicNode : Boolean;
  233. FRefCount : Integer;
  234. FVersion: TDomElement;
  235. public
  236. constructor Create(const AName: String; ANode: TDOMElement);
  237. destructor Destroy; override;
  238. Function IncRefcount : Integer;
  239. function FindChild(const APathName: String): TDocNode;
  240. function CreateChildren(const APathName: String): TDocNode;
  241. // Properties for tree structure
  242. property FirstChild: TDocNode read FFirstChild;
  243. property NextSibling: TDocNode read FNextSibling;
  244. // Basic properties
  245. property Name: String read FName;
  246. property Node: TDOMElement read FNode;
  247. // Data fetched from the XML document
  248. property IsSkipped: Boolean read FIsSkipped;
  249. property ShortDescr: TDOMElement read FShortDescr;
  250. property Descr: TDOMElement read FDescr;
  251. property ErrorsDoc: TDOMElement read FErrorsDoc;
  252. Property Version : TDomElement Read FVersion;
  253. property SeeAlso: TDOMElement read FSeeAlso;
  254. property FirstExample: TDOMElement read FFirstExample;
  255. property Notes : TDOMElement read FNotes;
  256. property Link: String read FLink;
  257. Property TopicNode : Boolean Read FTopicNode;
  258. Property RefCount : Integer Read FRefCount;
  259. end;
  260. // The main FPDoc engine
  261. TFPDocLogLevel = (dleWarnNoNode);
  262. TFPDocLogLevels = set of TFPDocLogLevel;
  263. TOnParseUnitEvent = Procedure (Sender : TObject; Const AUnitName : String; Out AInputFile,OSTarget,CPUTarget : String) of Object;
  264. { TFPDocEngine }
  265. TFPDocEngine = class(TPasTreeContainer)
  266. private
  267. FDocLogLevels: TFPDocLogLevels;
  268. FOnParseUnit: TOnParseUnitEvent;
  269. function ResolveLinkInPackages(AModule: TPasModule; const ALinkDest: String; Strict: Boolean=False): String;
  270. function ResolveLinkInUsedUnits(AModule: TPasModule; const ALinkDest: String; Strict: Boolean=False): String;
  271. protected
  272. FAlwaysVisible : TStringList;
  273. DescrDocs: TObjectList; // List of XML documents
  274. DescrDocNames: TStringList; // Names of the XML documents
  275. FRootLinkNode: TLinkNode;
  276. FRootDocNode: TDocNode;
  277. FPackages: TFPList; // List of TFPPackage objects
  278. CurModule: TPasModule;
  279. CurPackageDocNode: TDocNode;
  280. function ParseUsedUnit(AName, AInputLine,AOSTarget,ACPUTarget: String): TPasModule; virtual;
  281. Function LogEvent(E : TFPDocLogLevel) : Boolean;
  282. Procedure DoLog(Const Msg : String);overload;
  283. Procedure DoLog(Const Fmt : String; Args : Array of const);overload;
  284. public
  285. Output: String;
  286. HasContentFile: Boolean;
  287. HidePrivate: Boolean; // Hide private class members in output?
  288. HideProtected: Boolean; // Hide protected class members in output?
  289. WarnNoNode : Boolean; // Warn if no description node found for element.
  290. constructor Create;
  291. destructor Destroy; override;
  292. procedure SetPackageName(const APackageName: String);
  293. procedure ReadContentFile(const AFilename, ALinkPrefix: String);
  294. procedure WriteContentFile(const AFilename: String);
  295. function CreateElement(AClass: TPTreeElement; const AName: String;
  296. AParent: TPasElement; AVisibility: TPasMemberVisibility;
  297. const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
  298. override;
  299. function FindElement(const AName: String): TPasElement; override;
  300. function FindModule(const AName: String): TPasModule; override;
  301. Function HintsToStr(Hints : TPasMemberHints) : String;
  302. // Link tree support
  303. procedure AddLink(const APathName, ALinkTo: String);
  304. function FindAbsoluteLink(const AName: String): String;
  305. function ResolveLink(AModule: TPasModule; const ALinkDest: String; Strict : Boolean = False): String;
  306. function FindLinkedNode(ANode: TDocNode): TDocNode;
  307. Function ShowElement(El : TPasElement) : Boolean; inline;
  308. // Call this before documenting.
  309. Procedure StartDocumenting; virtual;
  310. // Documentation file support
  311. procedure AddDocFile(const AFilename: String;DontTrim:boolean=false);
  312. // Documentation retrieval
  313. function FindDocNode(AElement: TPasElement): TDocNode;
  314. function FindDocNode(ARefModule: TPasModule; const AName: String): TDocNode;
  315. function FindShortDescr(AElement: TPasElement): TDOMElement;
  316. function FindShortDescr(ARefModule: TPasModule; const AName: String): TDOMElement;
  317. function GetExampleFilename(const ExElement: TDOMElement): String;
  318. property RootLinkNode: TLinkNode read FRootLinkNode;
  319. property RootDocNode: TDocNode read FRootDocNode;
  320. Property DocLogLevels : TFPDocLogLevels Read FDocLogLevels Write FDocLogLevels;
  321. Property OnParseUnit : TOnParseUnitEvent Read FOnParseUnit Write FOnParseUnit;
  322. end;
  323. procedure TranslateDocStrings(const Lang: String);
  324. Function IsLinkNode(Node : TDomNode) : Boolean;
  325. Function IsExampleNode(Example : TDomNode) : Boolean;
  326. // returns true is link is an absolute URI
  327. Function IsLinkAbsolute(ALink: String): boolean;
  328. implementation
  329. uses SysUtils, Gettext, XMLRead;
  330. const
  331. AbsoluteLinkPrefixes : array[0..2] of string = ('/', 'http://', 'ms-its:');
  332. { TObjectList }
  333. destructor TObjectList.Destroy;
  334. var
  335. i: Integer;
  336. begin
  337. for i := 0 to Count - 1 do
  338. TObject(Items[i]).Free;
  339. inherited Destroy;
  340. end;
  341. { TLinkNode }
  342. constructor TLinkNode.Create(const AName, ALink: String);
  343. begin
  344. inherited Create;
  345. FName := AName;
  346. FLink := ALink;
  347. end;
  348. destructor TLinkNode.Destroy;
  349. begin
  350. if Assigned(FirstChild) then
  351. FirstChild.Free;
  352. if Assigned(NextSibling) then
  353. NextSibling.Free;
  354. inherited Destroy;
  355. end;
  356. function TLinkNode.FindChild(const APathName: String): TLinkNode;
  357. var
  358. DotPos: Integer;
  359. ChildName: String;
  360. Child: TLinkNode;
  361. begin
  362. if Length(APathName) = 0 then
  363. Result := Self
  364. else
  365. begin
  366. DotPos := Pos('.', APathName);
  367. if DotPos = 0 then
  368. ChildName := APathName
  369. else
  370. ChildName := Copy(APathName, 1, DotPos - 1);
  371. Child := FirstChild;
  372. while Assigned(Child) do
  373. begin
  374. if CompareText(Child.Name, ChildName) = 0 then
  375. begin
  376. if DotPos = 0 then
  377. Result := Child
  378. else
  379. Result := Child.FindChild(
  380. Copy(APathName, DotPos + 1, Length(APathName)));
  381. exit;
  382. end;
  383. Child := Child.NextSibling;
  384. end;
  385. Result := nil;
  386. end;
  387. end;
  388. function TLinkNode.CreateChildren(const APathName, ALinkTo: String): TLinkNode;
  389. var
  390. DotPos: Integer;
  391. ChildName: String;
  392. Child, LastChild: TLinkNode;
  393. begin
  394. if Length(APathName) = 0 then
  395. Result := Self
  396. else
  397. begin
  398. DotPos := Pos('.', APathName);
  399. if DotPos = 0 then
  400. ChildName := APathName
  401. else
  402. ChildName := Copy(APathName, 1, DotPos - 1);
  403. Child := FirstChild;
  404. LastChild := nil;
  405. while Assigned(Child) do
  406. begin
  407. if CompareText(Child.Name, ChildName) = 0 then
  408. begin
  409. if DotPos = 0 then
  410. Result := Child
  411. else
  412. Result := Child.CreateChildren(
  413. Copy(APathName, DotPos + 1, Length(APathName)), ALinkTo);
  414. exit;
  415. end;
  416. LastChild := Child;
  417. Child := Child.NextSibling;
  418. end;
  419. { No child found, let's create one if we are at the end of the path }
  420. if DotPos > 0 then
  421. Raise Exception.CreateFmt('Link path does not exist: %s',[APathName]);
  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. inherited Destroy;
  562. end;
  563. procedure TFPDocEngine.SetPackageName(const APackageName: String);
  564. begin
  565. ASSERT(not Assigned(Package));
  566. FPackage := TPasPackage(inherited CreateElement(TPasPackage,
  567. '#' + APackageName, nil, '', 0));
  568. FPackages.Add(FPackage);
  569. CurPackageDocNode := RootDocNode.FindChild('#' + APackageName);
  570. If Assigned(CurPackageDocNode) then
  571. CurPackageDocNode.IncRefCount;
  572. end;
  573. procedure TFPDocEngine.ReadContentFile(const AFilename, ALinkPrefix: String);
  574. var
  575. f: Text;
  576. inheritanceinfo : TStringlist;
  577. procedure ReadLinkTree;
  578. var
  579. s: String;
  580. PrevSpaces, ThisSpaces, i, StackIndex: Integer;
  581. CurParent, PrevSibling, NewNode: TLinkNode;
  582. ParentStack, SiblingStack: array[0..7] of TLinkNode;
  583. begin
  584. PrevSpaces := 0;
  585. CurParent := RootLinkNode;
  586. PrevSibling := CurParent.FirstChild;
  587. if assigned(PrevSibling) then
  588. while assigned(PrevSibling.NextSibling) do
  589. PrevSibling := PrevSibling.NextSibling;
  590. StackIndex := 0;
  591. while True do
  592. begin
  593. ReadLn(f, s);
  594. if Length(s) = 0 then
  595. break;
  596. ThisSpaces := 0;
  597. while s[ThisSpaces + 1] = ' ' do
  598. Inc(ThisSpaces);
  599. if ThisSpaces <> PrevSpaces then
  600. begin
  601. if ThisSpaces > PrevSpaces then
  602. begin
  603. { Dive down one level }
  604. ParentStack[StackIndex] := CurParent;
  605. SiblingStack[StackIndex] := PrevSibling;
  606. Inc(StackIndex);
  607. CurParent := PrevSibling;
  608. PrevSibling := nil;
  609. end else
  610. while PrevSpaces > ThisSpaces do
  611. begin
  612. Dec(StackIndex);
  613. CurParent := ParentStack[StackIndex];
  614. PrevSibling := SiblingStack[StackIndex];
  615. Dec(PrevSpaces);
  616. end;
  617. PrevSpaces := ThisSpaces;
  618. end;
  619. i := ThisSpaces + 1;
  620. while s[i] <> ' ' do
  621. Inc(i);
  622. NewNode := TLinkNode.Create(Copy(s, ThisSpaces + 1, i - ThisSpaces - 1),
  623. ALinkPrefix + Copy(s, i + 1, Length(s)));
  624. if pos(' ',newnode.link)>0 then
  625. writeln(stderr,'Bad format imported node: name="',newnode.name,'" link="',newnode.link,'"');
  626. if Assigned(PrevSibling) then
  627. PrevSibling.FNextSibling := NewNode
  628. else
  629. CurParent.FFirstChild := NewNode;
  630. PrevSibling := NewNode;
  631. end;
  632. end;
  633. function ResolvePackageModule(AName:String;var pkg:TPasPackage;var module:TPasModule;createnew:boolean):String;
  634. var
  635. DotPos, DotPos2, i,j: Integer;
  636. s: String;
  637. HPackage: TPasPackage;
  638. begin
  639. pkg:=nil; module:=nil; result:='';
  640. // Find or create package
  641. DotPos := Pos('.', AName);
  642. s := Copy(AName, 1, DotPos - 1);
  643. HPackage := nil;
  644. for i := 0 to FPackages.Count - 1 do
  645. if CompareText(TPasPackage(FPackages[i]).Name, s) = 0 then
  646. begin
  647. HPackage := TPasPackage(FPackages[i]);
  648. break;
  649. end;
  650. if not Assigned(HPackage) then
  651. begin
  652. if not CreateNew then
  653. exit;
  654. HPackage := TPasPackage(inherited CreateElement(TPasPackage, s, nil,
  655. '', 0));
  656. FPackages.Add(HPackage);
  657. end;
  658. // Find or create module
  659. DotPos2 := DotPos;
  660. repeat
  661. Inc(DotPos2);
  662. until AName[DotPos2] = '.';
  663. s := Copy(AName, DotPos + 1, DotPos2 - DotPos - 1);
  664. Module := nil;
  665. for i := 0 to HPackage.Modules.Count - 1 do
  666. if CompareText(TPasModule(HPackage.Modules[i]).Name, s) = 0 then
  667. begin
  668. Module := TPasModule(HPackage.Modules[i]);
  669. break;
  670. end;
  671. if not Assigned(Module) then
  672. begin
  673. if not CreateNew then
  674. exit;
  675. Module := TPasExternalModule.Create(s, HPackage);
  676. Module.InterfaceSection := TInterfaceSection.Create('', Module);
  677. HPackage.Modules.Add(Module);
  678. end;
  679. pkg:=hpackage;
  680. result:=Copy(AName, DotPos2 + 1, length(AName)-dotpos2);
  681. end;
  682. function SearchInList(clslist:TFPList;s:string):TPasElement;
  683. var i : integer;
  684. ClassEl: TPasElement;
  685. begin
  686. result:=nil;
  687. for i:=0 to clslist.count-1 do
  688. begin
  689. ClassEl := TPasElement(clslist[i]);
  690. if CompareText(ClassEl.Name,s) =0 then
  691. exit(Classel);
  692. end;
  693. end;
  694. function ResolveClassType(AName:String):TPasClassType;
  695. var
  696. pkg : TPasPackage;
  697. module : TPasModule;
  698. s : string;
  699. begin
  700. Result:=nil;
  701. s:=ResolvePackageModule(AName,pkg,module,False);
  702. if not assigned(module) then
  703. exit;
  704. result:=TPasClassType(SearchInList(Module.InterfaceSection.Classes,s));
  705. end;
  706. function ResolveAliasType(AName:String):TPasAliasType;
  707. var
  708. pkg : TPasPackage;
  709. module : TPasModule;
  710. s : string;
  711. begin
  712. Result:=nil;
  713. s:=ResolvePackageModule(AName,pkg,module,False);
  714. if not assigned(module) then
  715. exit;
  716. result:=TPasAliasType(SearchInList(Module.InterfaceSection.Types,s));
  717. if not (result is TPasAliasType) then
  718. result:=nil;
  719. end;
  720. procedure ReadClasses;
  721. function CreateClass(const AName: String;InheritanceStr:String): TPasClassType;
  722. var
  723. DotPos, DotPos2, i,j: Integer;
  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. i: Integer;
  1312. Node, Subnode, Subsubnode: TDOMNode;
  1313. Element: TDOMElement;
  1314. Doc: TXMLDocument;
  1315. PackageDocNode, TopicNode,ModuleDocNode: TDocNode;
  1316. begin
  1317. if DontTrim then
  1318. ReadXMLFileALT(Doc, AFilename)
  1319. else
  1320. ReadXMLFile(Doc, AFilename);
  1321. DescrDocs.Add(Doc);
  1322. DescrDocNames.Add(AFilename);
  1323. Node := Doc.DocumentElement.FirstChild;
  1324. while Assigned(Node) do
  1325. begin
  1326. if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'package') then
  1327. begin
  1328. PackageDocNode := ReadNode(RootDocNode, TDOMElement(Node));
  1329. PackageDocNode.IncRefCount;
  1330. PN:=PackageDocNode.Name;
  1331. // Scan all 'module' elements within this package element
  1332. Subnode := Node.FirstChild;
  1333. while Assigned(Subnode) do
  1334. begin
  1335. if (Subnode.NodeType = ELEMENT_NODE) then
  1336. begin
  1337. If (Subnode.NodeName = 'module') then
  1338. begin
  1339. ModuleDocNode := ReadNode(PackageDocNode, TDOMElement(Subnode));
  1340. // Scan all 'element' elements within this module element
  1341. Subsubnode := Subnode.FirstChild;
  1342. while Assigned(Subsubnode) do
  1343. begin
  1344. if (Subsubnode.NodeType = ELEMENT_NODE) then
  1345. begin
  1346. if (Subsubnode.NodeName = 'element') then
  1347. ReadNode(ModuleDocNode, TDOMElement(Subsubnode))
  1348. else if (SubSubNode.NodeName='topic') then
  1349. begin
  1350. TopicNode:=ReadNode(ModuleDocNode,TDomElement(SubSubNode));
  1351. TopicNode.FTopicNode:=True;
  1352. ReadTopics(TopicNode);
  1353. end;
  1354. end;
  1355. Subsubnode := Subsubnode.NextSibling;
  1356. end;
  1357. end
  1358. else if (SubNode.NodeName='topic') then
  1359. begin
  1360. TopicNode:=ReadNode(PackageDocNode,TDomElement(SubNode));
  1361. TopicNode.FTopicNode:=True;
  1362. ReadTopics(TopicNode);
  1363. end;
  1364. end;
  1365. Subnode := Subnode.NextSibling;
  1366. end;
  1367. end;
  1368. Node := Node.NextSibling;
  1369. end;
  1370. end;
  1371. function TFPDocEngine.FindDocNode(AElement: TPasElement): TDocNode;
  1372. begin
  1373. Result:=Nil;
  1374. If Assigned(AElement) then
  1375. begin
  1376. if AElement.InheritsFrom(TPasUnresolvedTypeRef) then
  1377. Result := FindDocNode(AElement.GetModule, AElement.Name)
  1378. else
  1379. Result := RootDocNode.FindChild(AElement.PathName);
  1380. if (Result=Nil) and
  1381. WarnNoNode and
  1382. (Length(AElement.PathName)>0) and
  1383. (AElement.PathName[1]='#') then
  1384. DoLog(Format('No documentation node found for identifier : %s',[AElement.PathName]));
  1385. end;
  1386. end;
  1387. function TFPDocEngine.FindDocNode(ARefModule: TPasModule;
  1388. const AName: String): TDocNode;
  1389. var
  1390. CurPackage: TDocNode;
  1391. UnitList: TFPList;
  1392. i: Integer;
  1393. begin
  1394. if Length(AName) = 0 then
  1395. Result := nil
  1396. else
  1397. begin
  1398. if AName[1] = '#' then
  1399. Result := RootDocNode.FindChild(AName)
  1400. else
  1401. Result := RootDocNode.FindChild(Package.Name + '.' + AName);
  1402. if (not Assigned(Result)) and Assigned(ARefModule) then
  1403. Result := RootDocNode.FindChild(ARefModule.PathName + '.' + AName);
  1404. if (not Assigned(Result)) and (AName[1] <> '#') then
  1405. begin
  1406. CurPackage := RootDocNode.FirstChild;
  1407. while Assigned(CurPackage) do
  1408. begin
  1409. Result := RootDocNode.FindChild(CurPackage.Name + '.' + AName);
  1410. if Assigned(Result) then
  1411. break;
  1412. CurPackage := CurPackage.NextSibling;
  1413. end;
  1414. if not Assigned(Result) and assigned(CurModule.InterfaceSection) then
  1415. begin
  1416. { Okay, then we have to try all imported units of the current module }
  1417. UnitList := CurModule.InterfaceSection.UsesList;
  1418. for i := UnitList.Count - 1 downto 0 do
  1419. begin
  1420. { Try all packages }
  1421. CurPackage := RootDocNode.FirstChild;
  1422. while Assigned(CurPackage) do
  1423. begin
  1424. Result := RootDocNode.FindChild(CurPackage.Name + '.' +
  1425. TPasType(UnitList[i]).Name + '.' + AName);
  1426. if Assigned(Result) then
  1427. break;
  1428. CurPackage := CurPackage.NextSibling;
  1429. end;
  1430. end;
  1431. end;
  1432. end;
  1433. end;
  1434. end;
  1435. function TFPDocEngine.FindShortDescr(AElement: TPasElement): TDOMElement;
  1436. var
  1437. DocNode,N: TDocNode;
  1438. begin
  1439. DocNode := FindDocNode(AElement);
  1440. if Assigned(DocNode) then
  1441. begin
  1442. N:=FindLinkedNode(DocNode);
  1443. If (N<>Nil) then
  1444. DocNode:=N;
  1445. Result := DocNode.ShortDescr;
  1446. end
  1447. else
  1448. Result := nil;
  1449. end;
  1450. function TFPDocEngine.FindLinkedNode(ANode : TDocNode) : TDocNode;
  1451. Var
  1452. S: String;
  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.