dglobals.pp 53 KB

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