dglobals.pp 53 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725
  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. Result := TLinkNode.Create(ChildName, ALinkTo);
  420. if Assigned(LastChild) then
  421. LastChild.FNextSibling := Result
  422. else
  423. FFirstChild := Result;
  424. end;
  425. end;
  426. { TDocNode }
  427. constructor TDocNode.Create(const AName: String; ANode: TDOMElement);
  428. begin
  429. inherited Create;
  430. FName := AName;
  431. FNode := ANode;
  432. end;
  433. destructor TDocNode.Destroy;
  434. begin
  435. if Assigned(FirstChild) then
  436. FirstChild.Free;
  437. if Assigned(NextSibling) then
  438. NextSibling.Free;
  439. inherited Destroy;
  440. end;
  441. Function TDocNode.IncRefcount : Integer;
  442. begin
  443. Inc(FRefCount);
  444. Result:=FRefCount;
  445. end;
  446. function TDocNode.FindChild(const APathName: String): TDocNode;
  447. var
  448. DotPos: Integer;
  449. ChildName: String;
  450. Child: TDocNode;
  451. begin
  452. if Length(APathName) = 0 then
  453. Result := Self
  454. else
  455. begin
  456. DotPos := Pos('.', APathName);
  457. if DotPos = 0 then
  458. ChildName := APathName
  459. else
  460. ChildName := Copy(APathName, 1, DotPos - 1);
  461. Child := FirstChild;
  462. while Assigned(Child) do
  463. begin
  464. if CompareText(Child.Name, ChildName) = 0 then
  465. begin
  466. if DotPos = 0 then
  467. Result := Child
  468. else
  469. Result := Child.FindChild(
  470. Copy(APathName, DotPos + 1, Length(APathName)));
  471. exit;
  472. end;
  473. Child := Child.NextSibling;
  474. end;
  475. Result := nil;
  476. end;
  477. end;
  478. function TDocNode.CreateChildren(const APathName: String): TDocNode;
  479. var
  480. DotPos: Integer;
  481. ChildName: String;
  482. Child: TDocNode;
  483. begin
  484. if Length(APathName) = 0 then
  485. Result := Self
  486. else
  487. begin
  488. DotPos := Pos('.', APathName);
  489. if DotPos = 0 then
  490. ChildName := APathName
  491. else
  492. ChildName := Copy(APathName, 1, DotPos - 1);
  493. Child := FirstChild;
  494. while Assigned(Child) do
  495. begin
  496. if CompareText(Child.Name, ChildName) = 0 then
  497. begin
  498. if DotPos = 0 then
  499. Result := Child
  500. else
  501. Result := Child.CreateChildren(
  502. Copy(APathName, DotPos + 1, Length(APathName)));
  503. exit;
  504. end;
  505. Child := Child.NextSibling;
  506. end;
  507. // No child found, let's create one
  508. Result := TDocNode.Create(ChildName, nil);
  509. if Assigned(FirstChild) then
  510. begin
  511. Result.FNextSibling := FirstChild;
  512. FFirstChild := Result;
  513. end else
  514. FFirstChild := Result;
  515. if DotPos > 0 then
  516. Result := Result.CreateChildren(
  517. Copy(APathName, DotPos + 1, Length(APathName)));
  518. end;
  519. end;
  520. { TFPDocEngine }
  521. function TFPDocEngine.LogEvent(E: TFPDocLogLevel): Boolean;
  522. begin
  523. Result:=E in FDocLogLevels;
  524. end;
  525. procedure TFPDocEngine.DoLog(const Msg: String);
  526. begin
  527. If Assigned(OnLog) then
  528. OnLog(Self,Msg);
  529. end;
  530. procedure TFPDocEngine.DoLog(const Fmt: String; Args: array of const);
  531. begin
  532. DoLog(Format(Fmt,Args));
  533. end;
  534. constructor TFPDocEngine.Create;
  535. begin
  536. inherited Create;
  537. DescrDocs := TObjectList.Create;
  538. FAlwaysVisible := TStringList.Create;
  539. FAlwaysVisible.CaseSensitive:=True;
  540. DescrDocNames := TStringList.Create;
  541. FRootLinkNode := TLinkNode.Create('', '');
  542. FRootDocNode := TDocNode.Create('', nil);
  543. HidePrivate := True;
  544. InterfaceOnly:=True;
  545. FPackages := TFPList.Create;
  546. end;
  547. destructor TFPDocEngine.Destroy;
  548. var
  549. i: Integer;
  550. begin
  551. for i := 0 to FPackages.Count - 1 do
  552. TPasPackage(FPackages[i]).Release;
  553. FreeAndNil(FRootDocNode);
  554. FreeAndNil(FRootLinkNode);
  555. FreeAndNil(DescrDocNames);
  556. FreeAndNil(DescrDocs);
  557. FreeAndNil(FAlwaysVisible);
  558. inherited Destroy;
  559. end;
  560. procedure TFPDocEngine.SetPackageName(const APackageName: String);
  561. begin
  562. ASSERT(not Assigned(Package));
  563. FPackage := TPasPackage(inherited CreateElement(TPasPackage,
  564. '#' + APackageName, nil, '', 0));
  565. FPackages.Add(FPackage);
  566. CurPackageDocNode := RootDocNode.FindChild('#' + APackageName);
  567. If Assigned(CurPackageDocNode) then
  568. CurPackageDocNode.IncRefCount;
  569. end;
  570. procedure TFPDocEngine.ReadContentFile(const AFilename, ALinkPrefix: String);
  571. var
  572. f: Text;
  573. inheritanceinfo : TStringlist;
  574. procedure ReadLinkTree;
  575. var
  576. s: String;
  577. PrevSpaces, ThisSpaces, i, StackIndex: Integer;
  578. CurParent, PrevSibling, NewNode: TLinkNode;
  579. ParentStack, SiblingStack: array[0..7] of TLinkNode;
  580. begin
  581. PrevSpaces := 0;
  582. CurParent := RootLinkNode;
  583. PrevSibling := CurParent.FirstChild;
  584. if assigned(PrevSibling) then
  585. while assigned(PrevSibling.NextSibling) do
  586. PrevSibling := PrevSibling.NextSibling;
  587. StackIndex := 0;
  588. while True do
  589. begin
  590. ReadLn(f, s);
  591. if Length(s) = 0 then
  592. break;
  593. ThisSpaces := 0;
  594. while s[ThisSpaces + 1] = ' ' do
  595. Inc(ThisSpaces);
  596. if ThisSpaces <> PrevSpaces then
  597. begin
  598. if ThisSpaces > PrevSpaces then
  599. begin
  600. { Dive down one level }
  601. ParentStack[StackIndex] := CurParent;
  602. SiblingStack[StackIndex] := PrevSibling;
  603. Inc(StackIndex);
  604. CurParent := PrevSibling;
  605. PrevSibling := nil;
  606. end else
  607. while PrevSpaces > ThisSpaces do
  608. begin
  609. Dec(StackIndex);
  610. CurParent := ParentStack[StackIndex];
  611. PrevSibling := SiblingStack[StackIndex];
  612. Dec(PrevSpaces);
  613. end;
  614. PrevSpaces := ThisSpaces;
  615. end;
  616. i := ThisSpaces + 1;
  617. while s[i] <> ' ' do
  618. Inc(i);
  619. NewNode := TLinkNode.Create(Copy(s, ThisSpaces + 1, i - ThisSpaces - 1),
  620. ALinkPrefix + Copy(s, i + 1, Length(s)));
  621. if pos(' ',newnode.link)>0 then
  622. writeln(stderr,'Bad format imported node: name="',newnode.name,'" link="',newnode.link,'"');
  623. if Assigned(PrevSibling) then
  624. PrevSibling.FNextSibling := NewNode
  625. else
  626. CurParent.FFirstChild := NewNode;
  627. PrevSibling := NewNode;
  628. end;
  629. end;
  630. function ResolvePackageModule(AName:String;var pkg:TPasPackage;var module:TPasModule;createnew:boolean):String;
  631. var
  632. DotPos, DotPos2, i,j: Integer;
  633. s: String;
  634. HPackage: TPasPackage;
  635. begin
  636. pkg:=nil; module:=nil; result:='';
  637. // Find or create package
  638. DotPos := Pos('.', AName);
  639. s := Copy(AName, 1, DotPos - 1);
  640. HPackage := nil;
  641. for i := 0 to FPackages.Count - 1 do
  642. if CompareText(TPasPackage(FPackages[i]).Name, s) = 0 then
  643. begin
  644. HPackage := TPasPackage(FPackages[i]);
  645. break;
  646. end;
  647. if not Assigned(HPackage) then
  648. begin
  649. if not CreateNew then
  650. exit;
  651. HPackage := TPasPackage(inherited CreateElement(TPasPackage, s, nil,
  652. '', 0));
  653. FPackages.Add(HPackage);
  654. end;
  655. // Find or create module
  656. DotPos2 := DotPos;
  657. repeat
  658. Inc(DotPos2);
  659. until AName[DotPos2] = '.';
  660. s := Copy(AName, DotPos + 1, DotPos2 - DotPos - 1);
  661. Module := nil;
  662. for i := 0 to HPackage.Modules.Count - 1 do
  663. if CompareText(TPasModule(HPackage.Modules[i]).Name, s) = 0 then
  664. begin
  665. Module := TPasModule(HPackage.Modules[i]);
  666. break;
  667. end;
  668. if not Assigned(Module) then
  669. begin
  670. if not CreateNew then
  671. exit;
  672. Module := TPasExternalModule.Create(s, HPackage);
  673. Module.InterfaceSection := TInterfaceSection.Create('', Module);
  674. HPackage.Modules.Add(Module);
  675. end;
  676. pkg:=hpackage;
  677. result:=Copy(AName, DotPos2 + 1, length(AName)-dotpos2);
  678. end;
  679. function SearchInList(clslist:TFPList;s:string):TPasElement;
  680. var i : integer;
  681. ClassEl: TPasElement;
  682. begin
  683. result:=nil;
  684. for i:=0 to clslist.count-1 do
  685. begin
  686. ClassEl := TPasElement(clslist[i]);
  687. if CompareText(ClassEl.Name,s) =0 then
  688. exit(Classel);
  689. end;
  690. end;
  691. function ResolveClassType(AName:String):TPasClassType;
  692. var
  693. pkg : TPasPackage;
  694. module : TPasModule;
  695. s : string;
  696. begin
  697. Result:=nil;
  698. s:=ResolvePackageModule(AName,pkg,module,False);
  699. if not assigned(module) then
  700. exit;
  701. result:=TPasClassType(SearchInList(Module.InterfaceSection.Classes,s));
  702. end;
  703. function ResolveAliasType(AName:String):TPasAliasType;
  704. var
  705. pkg : TPasPackage;
  706. module : TPasModule;
  707. s : string;
  708. begin
  709. Result:=nil;
  710. s:=ResolvePackageModule(AName,pkg,module,False);
  711. if not assigned(module) then
  712. exit;
  713. result:=TPasAliasType(SearchInList(Module.InterfaceSection.Types,s));
  714. if not (result is TPasAliasType) then
  715. result:=nil;
  716. end;
  717. procedure ReadClasses;
  718. function CreateClass(const AName: String;InheritanceStr:String): TPasClassType;
  719. var
  720. DotPos, DotPos2, i,j: Integer;
  721. s: String;
  722. HPackage: TPasPackage;
  723. Module: TPasModule;
  724. begin
  725. s:= ResolvePackageModule(AName,HPackage,Module,True);
  726. // Create node for class
  727. Result := TPasExternalClassType.Create(s, Module.InterfaceSection);
  728. Result.ObjKind := okClass;
  729. Module.InterfaceSection.Declarations.Add(Result);
  730. Module.InterfaceSection.Classes.Add(Result);
  731. // defer processing inheritancestr till all classes are loaded.
  732. if inheritancestr<>'' then
  733. InheritanceInfo.AddObject(Inheritancestr,result);
  734. end;
  735. procedure splitalias(var instr:string;out outstr:string);
  736. var i,j:integer;
  737. begin
  738. if length(instr)=0 then exit;
  739. instr:=trim(instr);
  740. i:=pos('(',instr);
  741. if i>0 then
  742. begin
  743. j:=length(instr)-i;
  744. if instr[length(instr)]=')' then
  745. dec(j);
  746. outstr:=copy(instr,i+1,j);
  747. delete(instr,i,j+2);
  748. end
  749. end;
  750. Function ResolveAndLinkClass(clname:String;IsClass:boolean;cls:TPasClassType):TPasClassType;
  751. begin
  752. result:=TPasClassType(ResolveClassType(clname));
  753. if assigned(result) and not (cls=result) then // save from tobject=implicit tobject
  754. begin
  755. result.addref;
  756. if IsClass then
  757. begin
  758. cls.ancestortype:=result;
  759. // writeln(cls.name, ' has as ancestor ',result.pathname);
  760. end
  761. else
  762. begin
  763. cls.interfaces.add(result);
  764. // writeln(cls.name, ' implements ',result.pathname);
  765. end;
  766. end
  767. else
  768. if cls<>result then
  769. DoLog('Warning : ancestor class %s of class %s could not be resolved',[clname,cls.name]);
  770. end;
  771. function CreateAliasType (alname,clname : string;parentclass:TPasClassType; out cl2 :TPasClassType):TPasAliasType;
  772. // create alias clname = alname
  773. var
  774. pkg : TPasPackage;
  775. module : TPasModule;
  776. s : string;
  777. begin
  778. Result:=nil;
  779. s:=ResolvePackageModule(Alname,pkg,module,True);
  780. if not assigned(module) then
  781. exit;
  782. cl2:=TPasClassType(ResolveClassType(alname));
  783. if assigned( cl2) and not (parentclass=cl2) then
  784. begin
  785. result:=ResolveAliasType(clname);
  786. if assigned(result) then
  787. begin
  788. // writeln('found alias ',clname,' (',s,') ',result.classname);
  789. end
  790. else
  791. begin
  792. // writeln('new alias ',clname,' (',s,') ');
  793. cl2.addref;
  794. Result := TPasAliasType(CreateElement(TPasAliasType,s,module.interfacesection,vispublic,'',0));
  795. module.interfacesection.Declarations.Add(Result);
  796. TPasAliasType(Result).DestType := cl2;
  797. end
  798. end
  799. end;
  800. procedure ProcessInheritanceStrings(inhInfo:TStringList);
  801. var i,j : integer;
  802. cls : TPasClassType;
  803. cls2: TPasClassType;
  804. clname,
  805. alname : string;
  806. inhclass : TStringList;
  807. begin
  808. inhclass:=TStringList.Create;
  809. inhclass.delimiter:=',';
  810. if InhInfo.Count>0 then
  811. for i:=0 to InhInfo.Count-1 do
  812. begin
  813. cls:=TPasClassType(InhInfo.Objects[i]);
  814. inhclass.clear;
  815. inhclass.delimitedtext:=InhInfo[i];
  816. for j:= 0 to inhclass.count-1 do
  817. begin
  818. //writeln('processing',inhclass[j]);
  819. clname:=inhclass[j];
  820. splitalias(clname,alname);
  821. if alname<>'' then // the class//interface we refered to is an alias
  822. begin
  823. // writeln('Found alias pair ',clname,' = ',alname);
  824. if not assigned(CreateAliasType(alname,clname,cls,cls2)) then
  825. DoLog('Warning: creating alias %s for %s failed!',[alname,clname]);
  826. end
  827. else
  828. cls2:=ResolveAndLinkClass(clname,j=0,cls);
  829. end;
  830. end;
  831. inhclass.free;
  832. end;
  833. var
  834. s, Name: String;
  835. CurClass: TPasClassType;
  836. i: Integer;
  837. Member: TPasElement;
  838. begin
  839. inheritanceinfo :=TStringlist.Create;
  840. Try
  841. CurClass := nil;
  842. while True do
  843. begin
  844. ReadLn(f, s);
  845. if Length(s) = 0 then
  846. break;
  847. if s[1] = '#' then
  848. begin
  849. // New class
  850. i := Pos(' ', s);
  851. CurClass := CreateClass(Copy(s, 1, i - 1), copy(s,i+1,length(s)));
  852. end else
  853. begin
  854. i := Pos(' ', s);
  855. if i = 0 then
  856. Name := Copy(s, 3, Length(s))
  857. else
  858. Name := Copy(s, 3, i - 3);
  859. case s[2] of
  860. 'M':
  861. Member := TPasProcedure.Create(Name, CurClass);
  862. 'P':
  863. begin
  864. Member := TPasProperty.Create(Name, CurClass);
  865. if i > 0 then
  866. while i <= Length(s) do
  867. begin
  868. case s[i] of
  869. 'r':
  870. TPasProperty(Member).ReadAccessorName := '<dummy>';
  871. 'w':
  872. TPasProperty(Member).WriteAccessorName := '<dummy>';
  873. 's':
  874. TPasProperty(Member).StoredAccessorName := '<dummy>';
  875. end;
  876. Inc(i);
  877. end;
  878. end;
  879. 'V':
  880. Member := TPasVariable.Create(Name, CurClass);
  881. else
  882. raise Exception.Create('Invalid member type: ' + s[2]);
  883. end;
  884. CurClass.Members.Add(Member);
  885. end;
  886. end;
  887. ProcessInheritanceStrings(Inheritanceinfo);
  888. finally
  889. inheritanceinfo.Free;
  890. end;
  891. end;
  892. var
  893. s: String;
  894. buf : Array[1..ContentBufSize-1] of byte;
  895. begin
  896. if not FileExists(AFileName) then
  897. raise EInOutError.Create('File not found: ' + AFileName);
  898. Assign(f, AFilename);
  899. Reset(f);
  900. SetTextBuf(F,Buf,SizeOf(Buf));
  901. while not EOF(f) do
  902. begin
  903. ReadLn(f, s);
  904. if (Length(s) = 0) or (s[1] = '#') then
  905. continue;
  906. if s = ':link tree' then
  907. ReadLinkTree
  908. else if s = ':classes' then
  909. ReadClasses
  910. else
  911. repeat
  912. ReadLn(f, s);
  913. until EOF(f) or (Length(s) = 0);
  914. end;
  915. Close(f);
  916. end;
  917. procedure TFPDocEngine.WriteContentFile(const AFilename: String);
  918. var
  919. ContentFile: Text;
  920. procedure ProcessLinkNode(ALinkNode: TLinkNode; const AIdent: String);
  921. var
  922. ChildNode: TLinkNode;
  923. begin
  924. WriteLn(ContentFile, AIdent, ALinkNode.Name, ' ', ALinkNode.Link);
  925. ChildNode := ALinkNode.FirstChild;
  926. while Assigned(ChildNode) do
  927. begin
  928. ProcessLinkNode(ChildNode, AIdent + ' ');
  929. ChildNode := ChildNode.NextSibling;
  930. end;
  931. end;
  932. function CheckImplicitInterfaceLink(const s : String):String;
  933. begin
  934. if uppercase(s)='IUNKNOWN' then
  935. Result:='#rtl.System.IUnknown'
  936. else
  937. Result:=s;
  938. end;
  939. var
  940. LinkNode: TLinkNode;
  941. i, j, k: Integer;
  942. Module: TPasModule;
  943. Alias : TPasAliasType;
  944. ClassDecl: TPasClassType;
  945. Member: TPasElement;
  946. s: String;
  947. Buf : Array[0..ContentBufSize-1] of byte;
  948. begin
  949. Assign(ContentFile, AFilename);
  950. Rewrite(ContentFile);
  951. SetTextBuf(ContentFile,Buf,SizeOf(Buf));
  952. try
  953. WriteLn(ContentFile, '# FPDoc Content File');
  954. WriteLn(ContentFile, ':link tree');
  955. LinkNode := RootLinkNode.FirstChild;
  956. while Assigned(LinkNode) do
  957. begin
  958. if LinkNode.Name = Package.Name then
  959. begin
  960. ProcessLinkNode(LinkNode, '');
  961. end;
  962. LinkNode := LinkNode.NextSibling;
  963. end;
  964. if Assigned(Package) then
  965. begin
  966. WriteLn(ContentFile);
  967. WriteLn(ContentFile, ':classes');
  968. for i := 0 to Package.Modules.Count - 1 do
  969. begin
  970. Module := TPasModule(Package.Modules[i]);
  971. if not assigned(Module.InterfaceSection) then
  972. continue;
  973. for j := 0 to Module.InterfaceSection.Classes.Count - 1 do
  974. begin
  975. ClassDecl := TPasClassType(Module.InterfaceSection.Classes[j]);
  976. Write(ContentFile, CheckImplicitInterfaceLink(ClassDecl.PathName), ' ');
  977. if Assigned(ClassDecl.AncestorType) then
  978. begin
  979. // simple aliases to class types are coded as "alias(classtype)"
  980. Write(ContentFile, CheckImplicitInterfaceLink(ClassDecl.AncestorType.PathName));
  981. if ClassDecl.AncestorType is TPasAliasType then
  982. begin
  983. alias:= TPasAliasType(ClassDecl.AncestorType);
  984. if assigned(alias.desttype) and (alias.desttype is TPasClassType) then
  985. write(ContentFile,'(',alias.desttype.PathName,')');
  986. end;
  987. end
  988. else if ClassDecl.ObjKind = okClass then
  989. Write(ContentFile, '#rtl.System.TObject')
  990. else if ClassDecl.ObjKind = okInterface then
  991. Write(ContentFile, '#rtl.System.IUnknown');
  992. if ClassDecl.Interfaces.Count>0 then
  993. begin
  994. for k:=0 to ClassDecl.Interfaces.count-1 do
  995. begin
  996. write(contentfile,',',CheckImplicitInterfaceLink(TPasClassType(ClassDecl.Interfaces[k]).PathName));
  997. if TPasElement(ClassDecl.Interfaces[k]) is TPasAliasType then
  998. begin
  999. alias:= TPasAliasType(ClassDecl.Interfaces[k]);
  1000. if assigned(alias.desttype) and (alias.desttype is TPasClassType) then
  1001. write(ContentFile,'(',CheckImplicitInterfaceLink(alias.desttype.PathName),')');
  1002. end;
  1003. end;
  1004. end;
  1005. writeln(contentfile);
  1006. for k := 0 to ClassDecl.Members.Count - 1 do
  1007. begin
  1008. Member := TPasElement(ClassDecl.Members[k]);
  1009. Write(ContentFile, Chr(Ord(Member.Visibility) + Ord('0')));
  1010. SetLength(s, 0);
  1011. if Member.ClassType = TPasVariable then
  1012. Write(ContentFile, 'V')
  1013. else if Member.ClassType = TPasProperty then
  1014. begin
  1015. Write(ContentFile, 'P');
  1016. if Length(TPasProperty(Member).ReadAccessorName) > 0 then
  1017. s := s + 'r';
  1018. if Length(TPasProperty(Member).WriteAccessorName) > 0 then
  1019. s := s + 'w';
  1020. if Length(TPasProperty(Member).StoredAccessorName) > 0 then
  1021. s := s + 's';
  1022. end else
  1023. Write(ContentFile, 'M'); // Member must be a method
  1024. Write(ContentFile, Member.Name);
  1025. if Length(s) > 0 then
  1026. WriteLn(ContentFile, ' ', s)
  1027. else
  1028. WriteLn(ContentFile);
  1029. end;
  1030. end;
  1031. end;
  1032. end;
  1033. finally
  1034. Close(ContentFile);
  1035. end;
  1036. end;
  1037. function TFPDocEngine.CreateElement(AClass: TPTreeElement; const AName: String;
  1038. AParent: TPasElement; AVisibility: TPasMemberVisibility;
  1039. const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
  1040. begin
  1041. Result := AClass.Create(AName, AParent);
  1042. Result.Visibility := AVisibility;
  1043. if AClass.InheritsFrom(TPasModule) then
  1044. CurModule := TPasModule(Result);
  1045. Result.SourceFilename := ASourceFilename;
  1046. Result.SourceLinenumber := ASourceLinenumber;
  1047. end;
  1048. function TFPDocEngine.FindElement(const AName: String): TPasElement;
  1049. function FindInModule(AModule: TPasModule; const LocalName: String): TPasElement;
  1050. var
  1051. l: TFPList;
  1052. i: Integer;
  1053. begin
  1054. If assigned(AModule.InterfaceSection) and
  1055. Assigned(AModule.InterfaceSection.Declarations) then
  1056. begin
  1057. l:=AModule.InterfaceSection.Declarations;
  1058. for i := 0 to l.Count - 1 do
  1059. begin
  1060. Result := TPasElement(l[i]);
  1061. if CompareText(Result.Name, LocalName) = 0 then
  1062. exit;
  1063. end;
  1064. end;
  1065. Result := nil;
  1066. end;
  1067. var
  1068. i: Integer;
  1069. Module: TPasElement;
  1070. begin
  1071. Result := FindInModule(CurModule, AName);
  1072. if not Assigned(Result) and assigned (CurModule.InterfaceSection) then
  1073. for i := CurModule.InterfaceSection.UsesList.Count - 1 downto 0 do
  1074. begin
  1075. Module := TPasElement(CurModule.InterfaceSection.UsesList[i]);
  1076. if Module.ClassType.InheritsFrom(TPasModule) then
  1077. begin
  1078. Result := FindInModule(TPasModule(Module), AName);
  1079. if Assigned(Result) then
  1080. exit;
  1081. end;
  1082. end;
  1083. end;
  1084. function TFPDocEngine.FindModule(const AName: String): TPasModule;
  1085. function FindInPackage(APackage: TPasPackage): TPasModule;
  1086. var
  1087. i: Integer;
  1088. begin
  1089. for i := 0 to APackage.Modules.Count - 1 do
  1090. begin
  1091. Result := TPasModule(APackage.Modules[i]);
  1092. if CompareText(Result.Name, AName) = 0 then
  1093. exit;
  1094. end;
  1095. Result := nil;
  1096. end;
  1097. var
  1098. i: Integer;
  1099. AInPutLine,OSTarget,CPUTarget : String;
  1100. begin
  1101. Result := FindInPackage(Package);
  1102. if not Assigned(Result) then
  1103. for i := FPackages.Count - 1 downto 0 do
  1104. begin
  1105. if TPasPackage(FPackages[i]) = Package then
  1106. continue;
  1107. Result := FindInPackage(TPasPackage(FPackages[i]));
  1108. if Assigned(Result) then
  1109. exit;
  1110. end;
  1111. if Not Assigned(Result) and Assigned(FOnParseUnit) then
  1112. begin
  1113. FOnParseUnit(Self,AName,AInputLine,OSTarget,CPUTarget);
  1114. If (AInPutLine<>'') then
  1115. Result:=ParseUsedUnit(AName,AInputLine,OSTarget,CPUTarget);
  1116. end;
  1117. end;
  1118. function TFPDocEngine.HintsToStr(Hints: TPasMemberHints): String;
  1119. Var
  1120. H : TPasMemberHint;
  1121. begin
  1122. Result:='';
  1123. For h:=Low(TPasMemberHint) to High(TPasMemberHint) do
  1124. if h in Hints then
  1125. begin
  1126. if (Result<>'') then
  1127. Result:=Result+', ';
  1128. Result:=Result+cPasMemberHint[h]
  1129. end;
  1130. end;
  1131. function TFPDocEngine.ParseUsedUnit(AName, AInputLine, AOSTarget,
  1132. ACPUTarget: String): TPasModule;
  1133. Var
  1134. M : TPasModule;
  1135. begin
  1136. DoLog(SParsingUsedUnit,[AName,AInputLine]);
  1137. M:=CurModule;
  1138. CurModule:=Nil;
  1139. try
  1140. ParseSource(Self,AInputLine,AOSTarget,ACPUTarget,True);
  1141. Result:=CurModule;
  1142. finally
  1143. CurModule:=M;
  1144. end;
  1145. end;
  1146. procedure TFPDocEngine.AddLink(const APathName, ALinkTo: String);
  1147. begin
  1148. RootLinkNode.CreateChildren(APathName, ALinkTo);
  1149. end;
  1150. function TFPDocEngine.FindAbsoluteLink(const AName: String): String;
  1151. var
  1152. LinkNode: TLinkNode;
  1153. begin
  1154. LinkNode := RootLinkNode.FindChild(AName);
  1155. if Assigned(LinkNode) then
  1156. Result := LinkNode.Link
  1157. else
  1158. SetLength(Result, 0);
  1159. end;
  1160. function TFPDocEngine.ResolveLinkInPackages(AModule: TPasModule; const ALinkDest: String; Strict : Boolean = False): String;
  1161. Var
  1162. ThisPackage: TLinkNode;
  1163. begin
  1164. { Try all packages }
  1165. Result:='';
  1166. ThisPackage:=RootLinkNode.FirstChild;
  1167. while Assigned(ThisPackage) and (Result='') do
  1168. begin
  1169. Result:=ResolveLink(AModule, ThisPackage.Name + '.' + ALinkDest, Strict);
  1170. ThisPackage := ThisPackage.NextSibling;
  1171. end;
  1172. end;
  1173. function TFPDocEngine.ResolveLinkInUsedUnits(AModule: TPasModule; const ALinkDest: String; Strict : Boolean = False): String;
  1174. var
  1175. i: Integer;
  1176. UL: TFPList;
  1177. begin
  1178. Result:='';
  1179. UL:=AModule.InterfaceSection.UsesList;
  1180. I:=UL.Count-1;
  1181. While (Result='') and (I>=0) do
  1182. begin
  1183. Result:=ResolveLinkInPackages(AModule,TPasType(UL[i]).Name+'.'+ALinkDest, strict);
  1184. Dec(I);
  1185. end;
  1186. end;
  1187. function TFPDocEngine.ResolveLink(AModule: TPasModule; const ALinkDest: String; Strict : Boolean = False): String;
  1188. var
  1189. i: Integer;
  1190. begin
  1191. {
  1192. if Assigned(AModule) then
  1193. system.WriteLn('ResolveLink(', AModule.Name, ' - ', ALinkDest, ')... ')
  1194. else
  1195. system.WriteLn('ResolveLink(Nil - ', ALinkDest, ')... ');
  1196. }
  1197. if (ALinkDest='') then
  1198. Exit('');
  1199. if (ALinkDest[1] = '#') then
  1200. Result := FindAbsoluteLink(ALinkDest)
  1201. else if (AModule=Nil) then
  1202. Result:= FindAbsoluteLink(RootLinkNode.FirstChild.Name+'.'+ALinkDest)
  1203. else
  1204. begin
  1205. if Pos(AModule.Name,ALinkDest) = 1 then
  1206. Result := ResolveLink(AModule, AModule.packagename + '.' + ALinkDest, Strict)
  1207. else
  1208. Result := ResolveLink(AModule, AModule.PathName + '.' + ALinkDest, Strict);
  1209. if (Result='') then
  1210. begin
  1211. Result:=ResolveLinkInPackages(AModule,ALinkDest,Strict);
  1212. if (Result='') then
  1213. Result:=ResolveLinkInUsedUnits(Amodule,AlinkDest,Strict);
  1214. end;
  1215. end;
  1216. // Match on parent : class/enumerated/record/module
  1217. if (Result='') and not strict then
  1218. for i := Length(ALinkDest) downto 1 do
  1219. if ALinkDest[i] = '.' then
  1220. begin
  1221. Result := ResolveLink(AModule, Copy(ALinkDest, 1, i - 1), Strict);
  1222. exit;
  1223. end;
  1224. end;
  1225. procedure ReadXMLFileALT(OUT ADoc:TXMLDocument;const AFileName:ansistring);
  1226. var
  1227. Parser: TDOMParser;
  1228. Src: TXMLInputSource;
  1229. FileStream: TStream;
  1230. begin
  1231. ADoc := nil;
  1232. FileStream := TFileStream.Create(AFilename, fmOpenRead+fmShareDenyWrite);
  1233. try
  1234. Parser := TDOMParser.Create; // create a parser object
  1235. try
  1236. Src := TXMLInputSource.Create(FileStream); // and the input source
  1237. src.SystemId:=FileNameToUri(AFileName);
  1238. try
  1239. Parser.Options.PreserveWhitespace := True;
  1240. Parser.Parse(Src, ADoc);
  1241. finally
  1242. Src.Free; // cleanup
  1243. end;
  1244. finally
  1245. Parser.Free;
  1246. end;
  1247. finally
  1248. FileStream.Free;
  1249. end;
  1250. end;
  1251. procedure TFPDocEngine.AddDocFile(const AFilename: String;DontTrim:boolean=false);
  1252. Var
  1253. PN : String;
  1254. function ReadNode(OwnerDocNode: TDocNode; Element: TDOMElement): TDocNode;
  1255. var
  1256. Subnode: TDOMNode;
  1257. begin
  1258. if OwnerDocNode = RootDocNode then
  1259. Result := OwnerDocNode.CreateChildren('#' + Element['name'])
  1260. else
  1261. Result := OwnerDocNode.CreateChildren(Element['name']);
  1262. Result.FNode := Element;
  1263. Result.FLink := Element['link'];
  1264. if (Element['alwaysvisible'] = '1') and (Element.NodeName='element') then
  1265. FAlwaysVisible.Add(LowerCase(PN+'.'+TDocNode(OwnerDocNode).Name+'.'+Element['name']));
  1266. Result.FIsSkipped := Element['skip'] = '1';
  1267. Subnode := Element.FirstChild;
  1268. while Assigned(Subnode) do
  1269. begin
  1270. if Subnode.NodeType = ELEMENT_NODE then
  1271. begin
  1272. if Subnode.NodeName = 'short' then
  1273. Result.FShortDescr := TDOMElement(Subnode)
  1274. else if Subnode.NodeName = 'descr' then
  1275. Result.FDescr := TDOMElement(Subnode)
  1276. else if Subnode.NodeName = 'version' then
  1277. begin
  1278. Result.FVersion := TDOMElement(Subnode)
  1279. end
  1280. else if Subnode.NodeName = 'errors' then
  1281. Result.FErrorsDoc := TDOMElement(Subnode)
  1282. else if Subnode.NodeName = 'seealso' then
  1283. Result.FSeeAlso := TDOMElement(Subnode)
  1284. else if (Subnode.NodeName = 'example') and
  1285. not Assigned(Result.FirstExample) then
  1286. Result.FFirstExample := TDOMElement(Subnode)
  1287. else if (Subnode.NodeName = 'notes') then
  1288. Result.FNotes := TDOMElement(Subnode);
  1289. end;
  1290. Subnode := Subnode.NextSibling;
  1291. end;
  1292. end;
  1293. Procedure ReadTopics(TopicNode : TDocNode);
  1294. Var
  1295. SubNode : TDOMNode;
  1296. begin
  1297. SubNode:=TopicNode.FNode.FirstChilD;
  1298. While Assigned(SubNode) do
  1299. begin
  1300. If (SubNode.NodeType=ELEMENT_NODE) and (SubNode.NodeName='topic') then
  1301. With ReadNode(TopicNode,TDomElement(SubNode)) do
  1302. // We could allow recursion here, but we won't, because it doesn't work on paper.
  1303. FTopicNode:=True;
  1304. SubNode:=Subnode.NextSibling;
  1305. end;
  1306. end;
  1307. var
  1308. i: Integer;
  1309. Node, Subnode, Subsubnode: TDOMNode;
  1310. Element: TDOMElement;
  1311. Doc: TXMLDocument;
  1312. PackageDocNode, TopicNode,ModuleDocNode: TDocNode;
  1313. begin
  1314. if DontTrim then
  1315. ReadXMLFileALT(Doc, AFilename)
  1316. else
  1317. ReadXMLFile(Doc, AFilename);
  1318. DescrDocs.Add(Doc);
  1319. DescrDocNames.Add(AFilename);
  1320. Node := Doc.DocumentElement.FirstChild;
  1321. while Assigned(Node) do
  1322. begin
  1323. if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'package') then
  1324. begin
  1325. PackageDocNode := ReadNode(RootDocNode, TDOMElement(Node));
  1326. PackageDocNode.IncRefCount;
  1327. PN:=PackageDocNode.Name;
  1328. // Scan all 'module' elements within this package element
  1329. Subnode := Node.FirstChild;
  1330. while Assigned(Subnode) do
  1331. begin
  1332. if (Subnode.NodeType = ELEMENT_NODE) then
  1333. begin
  1334. If (Subnode.NodeName = 'module') then
  1335. begin
  1336. ModuleDocNode := ReadNode(PackageDocNode, TDOMElement(Subnode));
  1337. // Scan all 'element' elements within this module element
  1338. Subsubnode := Subnode.FirstChild;
  1339. while Assigned(Subsubnode) do
  1340. begin
  1341. if (Subsubnode.NodeType = ELEMENT_NODE) then
  1342. begin
  1343. if (Subsubnode.NodeName = 'element') then
  1344. ReadNode(ModuleDocNode, TDOMElement(Subsubnode))
  1345. else if (SubSubNode.NodeName='topic') then
  1346. begin
  1347. TopicNode:=ReadNode(ModuleDocNode,TDomElement(SubSubNode));
  1348. TopicNode.FTopicNode:=True;
  1349. ReadTopics(TopicNode);
  1350. end;
  1351. end;
  1352. Subsubnode := Subsubnode.NextSibling;
  1353. end;
  1354. end
  1355. else if (SubNode.NodeName='topic') then
  1356. begin
  1357. TopicNode:=ReadNode(PackageDocNode,TDomElement(SubNode));
  1358. TopicNode.FTopicNode:=True;
  1359. ReadTopics(TopicNode);
  1360. end;
  1361. end;
  1362. Subnode := Subnode.NextSibling;
  1363. end;
  1364. end;
  1365. Node := Node.NextSibling;
  1366. end;
  1367. end;
  1368. function TFPDocEngine.FindDocNode(AElement: TPasElement): TDocNode;
  1369. begin
  1370. Result:=Nil;
  1371. If Assigned(AElement) then
  1372. begin
  1373. if AElement.InheritsFrom(TPasUnresolvedTypeRef) then
  1374. Result := FindDocNode(AElement.GetModule, AElement.Name)
  1375. else
  1376. Result := RootDocNode.FindChild(AElement.PathName);
  1377. if (Result=Nil) and
  1378. WarnNoNode and
  1379. (Length(AElement.PathName)>0) and
  1380. (AElement.PathName[1]='#') then
  1381. DoLog(Format('No documentation node found for identifier : %s',[AElement.PathName]));
  1382. end;
  1383. end;
  1384. function TFPDocEngine.FindDocNode(ARefModule: TPasModule;
  1385. const AName: String): TDocNode;
  1386. var
  1387. CurPackage: TDocNode;
  1388. UnitList: TFPList;
  1389. i: Integer;
  1390. begin
  1391. if Length(AName) = 0 then
  1392. Result := nil
  1393. else
  1394. begin
  1395. if AName[1] = '#' then
  1396. Result := RootDocNode.FindChild(AName)
  1397. else
  1398. Result := RootDocNode.FindChild(Package.Name + '.' + AName);
  1399. if (not Assigned(Result)) and Assigned(ARefModule) then
  1400. Result := RootDocNode.FindChild(ARefModule.PathName + '.' + AName);
  1401. if (not Assigned(Result)) and (AName[1] <> '#') then
  1402. begin
  1403. CurPackage := RootDocNode.FirstChild;
  1404. while Assigned(CurPackage) do
  1405. begin
  1406. Result := RootDocNode.FindChild(CurPackage.Name + '.' + AName);
  1407. if Assigned(Result) then
  1408. break;
  1409. CurPackage := CurPackage.NextSibling;
  1410. end;
  1411. if not Assigned(Result) and assigned(CurModule.InterfaceSection) then
  1412. begin
  1413. { Okay, then we have to try all imported units of the current module }
  1414. UnitList := CurModule.InterfaceSection.UsesList;
  1415. for i := UnitList.Count - 1 downto 0 do
  1416. begin
  1417. { Try all packages }
  1418. CurPackage := RootDocNode.FirstChild;
  1419. while Assigned(CurPackage) do
  1420. begin
  1421. Result := RootDocNode.FindChild(CurPackage.Name + '.' +
  1422. TPasType(UnitList[i]).Name + '.' + AName);
  1423. if Assigned(Result) then
  1424. break;
  1425. CurPackage := CurPackage.NextSibling;
  1426. end;
  1427. end;
  1428. end;
  1429. end;
  1430. end;
  1431. end;
  1432. function TFPDocEngine.FindShortDescr(AElement: TPasElement): TDOMElement;
  1433. var
  1434. DocNode,N: TDocNode;
  1435. begin
  1436. DocNode := FindDocNode(AElement);
  1437. if Assigned(DocNode) then
  1438. begin
  1439. N:=FindLinkedNode(DocNode);
  1440. If (N<>Nil) then
  1441. DocNode:=N;
  1442. Result := DocNode.ShortDescr;
  1443. end
  1444. else
  1445. Result := nil;
  1446. end;
  1447. function TFPDocEngine.FindLinkedNode(ANode : TDocNode) : TDocNode;
  1448. Var
  1449. S: String;
  1450. begin
  1451. If (ANode.Link='') then
  1452. Result:=Nil
  1453. else
  1454. Result:=FindDocNode(CurModule,ANode.Link);
  1455. end;
  1456. function TFPDocEngine.ShowElement(El: TPasElement): Boolean;
  1457. begin
  1458. Case El.Visibility of
  1459. visStrictPrivate,
  1460. visPrivate :
  1461. Result:=Not HidePrivate;
  1462. visStrictProtected,
  1463. visProtected :
  1464. begin
  1465. Result:=Not HideProtected;
  1466. if not Result then
  1467. Result:=FAlwaysVisible.IndexOf(LowerCase(El.PathName))<>-1;
  1468. end
  1469. Else
  1470. Result:=True
  1471. end;
  1472. end;
  1473. procedure TFPDocEngine.StartDocumenting;
  1474. begin
  1475. FAlwaysVisible.Sorted:=True;
  1476. end;
  1477. function TFPDocEngine.FindShortDescr(ARefModule: TPasModule;
  1478. const AName: String): TDOMElement;
  1479. var
  1480. N,DocNode: TDocNode;
  1481. begin
  1482. DocNode := FindDocNode(ARefModule, AName);
  1483. if Assigned(DocNode) then
  1484. begin
  1485. N:=FindLinkedNode(DocNode);
  1486. If (N<>Nil) then
  1487. DocNode:=N;
  1488. Result := DocNode.ShortDescr;
  1489. end
  1490. else
  1491. Result := nil;
  1492. end;
  1493. function TFPDocEngine.GetExampleFilename(const ExElement: TDOMElement): String;
  1494. var
  1495. i: Integer;
  1496. fn : String;
  1497. begin
  1498. Result:='';
  1499. for i := 0 to DescrDocs.Count - 1 do
  1500. begin
  1501. Fn:=ExElement['file'];
  1502. if (FN<>'') and (TDOMDocument(DescrDocs[i]) = ExElement.OwnerDocument) then
  1503. begin
  1504. Result := ExtractFilePath(DescrDocNames[i]) + FN;
  1505. if (ExtractFileExt(Result)='') then
  1506. Result:=Result+'.pp';
  1507. end;
  1508. end;
  1509. end;
  1510. { Global helpers }
  1511. procedure TranslateDocStrings(const Lang: String);
  1512. Const
  1513. {$ifdef unix}
  1514. DefDir = '/usr/local/share/locale';
  1515. {$else}
  1516. DefDir = 'intl';
  1517. {$endif}
  1518. var
  1519. mo: TMOFile;
  1520. dir : string;
  1521. begin
  1522. dir:=modir;
  1523. If Dir='' then
  1524. Dir:=DefDir;
  1525. Dir:=IncludeTrailingPathDelimiter(Dir);
  1526. {$IFDEF Unix}
  1527. mo := TMOFile.Create(Format(Dir+'%s/LC_MESSAGES/dglobals.mo', [Lang]));
  1528. {$ELSE}
  1529. mo := TMOFile.Create(Format(Dir+'dglobals.%s.mo', [Lang]));
  1530. {$ENDIF}
  1531. try
  1532. TranslateResourceStrings(mo);
  1533. finally
  1534. mo.Free;
  1535. end;
  1536. end;
  1537. Function IsLinkNode(Node : TDomNode) : Boolean;
  1538. begin
  1539. Result:=Assigned(Node) and (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'link');
  1540. end;
  1541. Function IsExampleNode(Example : TDomNode) : Boolean;
  1542. begin
  1543. Result:=Assigned(Example) and (Example.NodeType = ELEMENT_NODE) and (Example.NodeName = 'example')
  1544. end;
  1545. function IsLinkAbsolute(ALink: String): boolean;
  1546. var
  1547. i: integer;
  1548. begin
  1549. Result := false;
  1550. for i := low(AbsoluteLinkPrefixes) to high(AbsoluteLinkPrefixes) do
  1551. if CompareText(AbsoluteLinkPrefixes[i], copy(ALink,1,length(AbsoluteLinkPrefixes[i])))=0 then begin
  1552. Result := true;
  1553. break;
  1554. end;
  1555. end;
  1556. initialization
  1557. LEOL:=Length(LineEnding);
  1558. end.