diff options
Diffstat (limited to 'avx512-0037785/utils/fpdoc/dglobals.pp')
| -rw-r--r-- | avx512-0037785/utils/fpdoc/dglobals.pp | 408 |
1 files changed, 242 insertions, 166 deletions
diff --git a/avx512-0037785/utils/fpdoc/dglobals.pp b/avx512-0037785/utils/fpdoc/dglobals.pp index 42de2ac16b..2cfed6aed8 100644 --- a/avx512-0037785/utils/fpdoc/dglobals.pp +++ b/avx512-0037785/utils/fpdoc/dglobals.pp @@ -23,7 +23,7 @@ unit dGlobals; interface -uses Classes, DOM, PasTree, PParser, uriparser; +uses Classes, DOM, PasTree, PParser, uriparser, SysUtils; Const CacheSize = 20; @@ -36,9 +36,12 @@ Var resourcestring // Output strings SDocPackageTitle = 'Reference for package ''%s'''; + SDocPackageMenuTitle = 'Package ''%s'''; + SDocPackageLinkTitle = 'Package'; SDocPrograms = 'Programs'; SDocUnits = 'Units'; SDocUnitTitle = 'Reference for unit ''%s'''; + SDocUnitMenuTitle = 'Unit ''%s'''; SDocInheritanceHierarchy = 'Inheritance Hierarchy'; SDocInterfaceSection = 'Interface section'; SDocImplementationSection = 'Implementation section'; @@ -47,10 +50,15 @@ resourcestring SDocConstsTypesVars = 'Constants, types and variables'; SDocResStrings = 'Resource strings'; SDocTypes = 'Types'; + SDocType = 'Type'; SDocConstants = 'Constants'; + SDocConstant = 'Constant'; SDocClasses = 'Classes'; + SDocClass = 'Class'; SDocProceduresAndFunctions = 'Procedures and functions'; + SDocProcedureOrFunction = 'Procedure/function'; SDocVariables = 'Variables'; + SDocVariable = 'Variable'; SDocIdentifierIndex = 'Index'; SDocPackageClassHierarchy = 'Class hierarchy'; SDocModuleIndex = 'Index of all identifiers in unit ''%s'''; @@ -69,9 +77,13 @@ resourcestring SDocRemark = 'Remark: '; SDocMethodOverview = 'Method overview'; SDocPropertyOverview = 'Property overview'; + SDocEventOverview = 'Event overview'; SDocInterfacesOverview = 'Interfaces overview'; SDocInterface = 'Interfaces'; SDocPage = 'Page'; + SDocMember = 'Member'; + SDocMembers = 'Members'; + SDocField = 'Field'; SDocMethod = 'Method'; SDocProperty = 'Property'; SDocAccess = 'Access'; @@ -80,6 +92,7 @@ resourcestring SDocMethods = 'Methods'; SDocEvents = 'Events'; SDocByName = 'by Name'; + SDocByInheritance = 'By inheritance'; SDocValue = 'Value'; SDocExplanation = 'Explanation'; SDocProcedure = 'Procedure'; @@ -92,6 +105,10 @@ resourcestring // The next line requires leading/trailing space due to XML comment layout: SDocGeneratedByComment = ' Generated using FPDoc - (c) 2000-2012 FPC contributors and Sebastian Guenther, sg@freepascal.org '; SDocNotes = 'Notes'; + SDocName = 'Name'; + SDocType_s = 'Type(s)'; + SDocTopic = 'Topic'; + SDocNoneAVailable = 'No members available'; // Topics SDocRelatedTopics = 'Related topics'; @@ -113,14 +130,16 @@ resourcestring SManUsagePackageDescription = 'Use descr as the description of man pages'; // HTML usage - SHTMLUsageFooter = 'Append xhtml from file as footer to html page'; + SHTMLUsageFooter = 'Append xhtml (@filename reads from file) as footer to html page'; + SHTMLUsageNavigator = 'Append xhtml (@filename reads from file) in navigator bar'; + SHTMLUsageHeader = 'Append xhtml (@filename reads from file) as header to html page below navigation bar'; SHTMLUsageFooterDate = 'Append footer with date. fmt is Optional format for FormatDateTime'; SHTMLUsageCharset = 'Set the HTML character set'; SHTMLHtmlSearch = 'Add search page with given name to the menu bar'; SHTMLIndexColcount = 'Use N columns in the identifier index pages'; SHTMLImageUrl = 'Prefix image URLs with url'; SHTMLDisableMenuBrackets = 'Disable ''['' and '']'' characters around menu items at the top of the page. Useful for custom css'; - + // CHM usage SCHMUsageTOC = 'Use [File] as the table of contents. Usually a .hhc file.'; SCHMUsageIndex = 'Use [File] as the index. Usually a .hhk file.'; @@ -132,6 +151,17 @@ resourcestring SCHMUsageMakeSearch = 'Automatically generate a Search Index from filenames that match *.htm*'; SCHMUsageChmTitle= 'Title of the chm. Defaults to the value from --package'; + // MarkDown usage + SMDUsageFooter = 'Append markdown (@filename reads from file) as footer to every markdown page'; + SMDUsageHeader = 'Prepend markdown (@filename reads from file) as header to every markdown page'; + SMDIndexColcount = 'Use N columns in the identifier index pages'; + SMDImageUrl = 'Prefix image URLs with url'; + SMDTheme = 'Use name as theme name'; + SMDNavigation = 'Use scheme for navigation tree, here scheme is one of:'; + SMDNavSubtree = ' UnitSubTree : put all units in a sub tree of a Units node'; + SMDNavTree = ' UnitTree : put every units as a node on the same level as packages node'; + + SXMLUsageFlatStructure = 'Use a flat output structure of XML files and directories'; SXMLUsageSource = 'Include source file and line info in generated XML'; // Linear usage @@ -141,7 +171,7 @@ resourcestring STitle = 'FPDoc - Free Pascal Documentation Tool'; SVersion = 'Version %s [%s]'; SCopyright1 = '(c) 2000 - 2003 Areca Systems GmbH / Sebastian Guenther, sg@freepascal.org'; - SCopyright2 = '(c) 2005 - 2012 various FPC contributors'; + SCopyright2 = '(c) 2005 - 2021 various FPC contributors'; SCmdLineHelp = 'Usage: %s [options]'; SUsageOption008 = '--base-descr-dir=DIR prefix all description files with this directory'; @@ -182,6 +212,7 @@ resourcestring SUsageOption300 = '--dry-run Only parse sources and XML, do not create output'; SUsageOption310 = '--write-project=file'; SUsageOption320 = ' Write all command-line options to a project file'; + SUsageSubNames = 'Use the file subnames instead the indexes as postfixes'; SUsageFormats = 'The following output formats are supported by this fpdoc:'; SUsageBackendHelp = 'Specify an output format, combined with --help to get more help for this backend.'; @@ -203,7 +234,9 @@ resourcestring Const SVisibility: array[TPasMemberVisibility] of string = ('Default', 'Private', 'Protected', 'Public', - 'Published', 'Automated','Strict Private','Strict Protected'); + 'Published', 'Automated','Strict Private','Strict Protected', + 'Required', 'Optional' // ObjCClass + ); type TBufType = Array[1..ContentBufSize-1] of byte; @@ -317,9 +350,9 @@ type FAlwaysVisible : TStringList; DescrDocs: TObjectList; // List of XML documents DescrDocNames: TStringList; // Names of the XML documents - FRootLinkNode: TLinkNode; - FRootDocNode: TDocNode; - FPackages: TFPList; // List of TFPPackage objects + FRootLinkNode: TLinkNode; // Global tree of TlinkNode from the imported .xct files + FRootDocNode: TDocNode; // Global tree of TDocNode from the .xml documentation files + FPackages: TFPList; // Global list of TPasPackage objects and full tree of sources CurModule: TPasModule; CurPackageDocNode: TDocNode; function ParseUsedUnit(AName, AInputLine,AOSTarget,ACPUTarget: String): TPasModule; virtual; @@ -336,13 +369,16 @@ type constructor Create; destructor Destroy; override; procedure SetPackageName(const APackageName: String); + // The process importing of objects from external .xct file procedure ReadContentFile(const AFilename, ALinkPrefix: String); + // Creation of an own .xct output file procedure WriteContentFile(const AFilename: String); function CreateElement(AClass: TPTreeElement; const AName: String; AParent: TPasElement; AVisibility: TPasMemberVisibility; const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement; override; + function FindInModule(const AName: String ; AModule: TPasModule): TPasElement; function FindElement(const AName: String): TPasElement; override; function FindModule(const AName: String): TPasModule; override; Function HintsToStr(Hints : TPasMemberHints) : String; @@ -375,6 +411,7 @@ type procedure TranslateDocStrings(const Lang: String); +function DumpExceptionCallStack(E: Exception):String; Function IsLinkNode(Node : TDomNode) : Boolean; Function IsExampleNode(Example : TDomNode) : Boolean; @@ -385,7 +422,7 @@ Function IsLinkAbsolute(ALink: String): boolean; implementation -uses SysUtils, Gettext, XMLRead; +uses Gettext, XMLRead; const AbsoluteLinkPrefixes : array[0..2] of string = ('/', 'http://', 'ms-its:'); @@ -634,7 +671,7 @@ var i: Integer; begin for i := 0 to FPackages.Count - 1 do - TPasPackage(FPackages[i]).Release; + TPasPackage(FPackages[i]).Release{$IFDEF CheckPasTreeRefCount}('TFPDocEngine.Destroy'){$ENDIF}; FreeAndNil(FRootDocNode); FreeAndNil(FRootLinkNode); FreeAndNil(DescrDocNames); @@ -658,7 +695,9 @@ end; procedure TFPDocEngine.ReadContentFile(const AFilename, ALinkPrefix: String); var f: Text; - inheritanceinfo : TStringlist; + inheritanceinfo : TStringlist; // contents list of TPasClass with inheritance info + // like this #PackageName.ModuleName.ClassName + tmpLinkPrefix : string; procedure ReadLinkTree; var @@ -706,8 +745,10 @@ var i := ThisSpaces + 1; while s[i] <> ' ' do Inc(i); + if ALinkPrefix <> '' then + tmpLinkPrefix := ExcludeTrailingPathDelimiter(ALinkPrefix)+'/'; NewNode := TLinkNode.Create(Copy(s, ThisSpaces + 1, i - ThisSpaces - 1), - ALinkPrefix + Copy(s, i + 1, Length(s))); + tmpLinkPrefix + Copy(s, i + 1, Length(s))); if pos(' ',newnode.link)>0 then writeln(stderr,'Bad format imported node: name="',newnode.name,'" link="',newnode.link,'"'); if Assigned(PrevSibling) then @@ -719,56 +760,58 @@ var end; function ResolvePackageModule(AName:String;out pkg:TPasPackage;out module:TPasModule;createnew:boolean):String; - var - DotPos, DotPos2, i: Integer; - s: String; - HPackage: TPasPackage; + var + DotPos, DotPos2, i: Integer; + s: String; + HPackage: TPasPackage; - begin - pkg:=nil; module:=nil; result:=''; - - // Find or create package - DotPos := Pos('.', AName); - s := Copy(AName, 1, DotPos - 1); - HPackage := nil; - for i := 0 to FPackages.Count - 1 do - if CompareText(TPasPackage(FPackages[i]).Name, s) = 0 then - begin - HPackage := TPasPackage(FPackages[i]); - break; - end; - if not Assigned(HPackage) then + begin + pkg:=nil; module:=nil; result:=''; + + // Find or create package + DotPos := Pos('.', AName); + s := Copy(AName, 1, DotPos - 1); + HPackage := nil; + for i := 0 to FPackages.Count - 1 do + if CompareText(TPasPackage(FPackages[i]).Name, s) = 0 then begin - if not CreateNew then - exit; - HPackage := TPasPackage(inherited CreateElement(TPasPackage, s, nil, - '', 0)); - FPackages.Add(HPackage); + HPackage := TPasPackage(FPackages[i]); + break; end; + if not Assigned(HPackage) then + begin + if not CreateNew then + exit; + HPackage := TPasPackage(inherited CreateElement(TPasPackage, s, nil, + '', 0)); + FPackages.Add(HPackage); + end; - // Find or create module - DotPos2 := DotPos; - repeat - Inc(DotPos2); - until AName[DotPos2] = '.'; - s := Copy(AName, DotPos + 1, DotPos2 - DotPos - 1); - Module := nil; - for i := 0 to HPackage.Modules.Count - 1 do - if CompareText(TPasModule(HPackage.Modules[i]).Name, s) = 0 then - begin - Module := TPasModule(HPackage.Modules[i]); - break; - end; - if not Assigned(Module) then + // Find or create module + DotPos2 := DotPos; + repeat + Inc(DotPos2); + until AName[DotPos2] = '.'; + s := Copy(AName, DotPos + 1, DotPos2 - DotPos - 1); + Module := nil; + for i := 0 to HPackage.Modules.Count - 1 do + if CompareText(TPasModule(HPackage.Modules[i]).Name, s) = 0 then begin - if not CreateNew then - exit; - Module := TPasExternalModule.Create(s, HPackage); - Module.InterfaceSection := TInterfaceSection.Create('', Module); - HPackage.Modules.Add(Module); + Module := TPasModule(HPackage.Modules[i]); + break; end; - pkg:=hpackage; - result:=Copy(AName, DotPos2 + 1, length(AName)-dotpos2); + if not Assigned(Module) then + begin + if not CreateNew then + exit; + Module := TPasExternalModule.Create(s, HPackage); + Module.InterfaceSection := TInterfaceSection.Create('', Module); + Module.PackageName:= HPackage.Name; + // Module.AddRef{$IFDEF CheckPasTreeRefCount}('ReadContentFile.ResolvePackageModule'){$ENDIF}; + HPackage.Modules.Add(Module); + end; + pkg:=hpackage; + result:=Copy(AName, DotPos2 + 1, length(AName)-dotpos2); end; function SearchInList(clslist:TFPList;s:string):TPasElement; @@ -825,6 +868,7 @@ var // Create node for class Result := TPasExternalClassType.Create(s, Module.InterfaceSection); Result.ObjKind := okClass; + // Result.AddRef{$IFDEF CheckPasTreeRefCount}('ReadContentFile.ResolveAndLinkClass'){$ENDIF}; Module.InterfaceSection.Declarations.Add(Result); Module.InterfaceSection.Classes.Add(Result); // defer processing inheritancestr till all classes are loaded. @@ -832,9 +876,9 @@ var InheritanceInfo.AddObject(Inheritancestr,result); end; - procedure splitalias(var instr:string;out outstr:string); - var i,j:integer; - begin + procedure splitalias(var instr:string;out outstr:string); + var i,j:integer; + begin if length(instr)=0 then exit; instr:=trim(instr); i:=pos('(',instr); @@ -846,14 +890,14 @@ var outstr:=copy(instr,i+1,j); delete(instr,i,j+2); end - end; + end; - Function ResolveAndLinkClass(clname:String;IsClass:boolean;cls:TPasClassType):TPasClassType; - begin + Function ResolveAndLinkClass(clname:String;IsClass:boolean;cls:TPasClassType):TPasClassType; + begin result:=TPasClassType(ResolveClassType(clname)); if assigned(result) and not (cls=result) then // save from tobject=implicit tobject begin - result.addref; + result.addref{$IFDEF CheckPasTreeRefCount}('ReadContentFile.ResolveAndLinkClass'){$ENDIF}; if IsClass then begin cls.ancestortype:=result; @@ -868,47 +912,47 @@ var else if cls<>result then DoLog('Warning : ancestor class %s of class %s could not be resolved',[clname,cls.name]); -end; + end; -function CreateAliasType (alname,clname : string;parentclass:TPasClassType; out cl2 :TPasClassType):TPasAliasType; -// create alias clname = alname -var - pkg : TPasPackage; - module : TPasModule; - s : string; -begin - Result:=nil; - s:=ResolvePackageModule(Alname,pkg,module,True); - if not assigned(module) then - exit; - cl2:=TPasClassType(ResolveClassType(alname)); - if assigned( cl2) and not (parentclass=cl2) then - begin - result:=ResolveAliasType(clname); - if assigned(result) then - begin -// writeln('found alias ',clname,' (',s,') ',result.classname); - end - else + function CreateAliasType (alname,clname : string;parentclass:TPasClassType; out cl2 :TPasClassType):TPasAliasType; + // create alias clname = alname + var + pkg : TPasPackage; + module : TPasModule; + s : string; + begin + Result:=nil; + s:=ResolvePackageModule(Alname,pkg,module,True); + if not assigned(module) then + exit; + cl2:=TPasClassType(ResolveClassType(alname)); + if assigned( cl2) and not (parentclass=cl2) then begin -// writeln('new alias ',clname,' (',s,') '); - cl2.addref; - Result := TPasAliasType(CreateElement(TPasAliasType,s,module.interfacesection,vispublic,'',0)); - module.interfacesection.Declarations.Add(Result); - TPasAliasType(Result).DestType := cl2; + result:=ResolveAliasType(clname); + if assigned(result) then + begin + // writeln('found alias ',clname,' (',s,') ',result.classname); + end + else + begin + // writeln('new alias ',clname,' (',s,') '); + cl2.addref{$IFDEF CheckPasTreeRefCount}('ReadContentFile.CreateAliasType'){$ENDIF}; + Result := TPasAliasType(CreateElement(TPasAliasType,s,module.interfacesection,vispublic,'',0)); + module.interfacesection.Declarations.Add(Result); + TPasAliasType(Result).DestType := cl2; + end end - end -end; + end; - procedure ProcessInheritanceStrings(inhInfo:TStringList); + procedure ProcessInheritanceStrings(inhInfo:TStringList); - var i,j : integer; - cls : TPasClassType; + var i,j : integer; + cls : TPasClassType; cls2: TPasClassType; clname, alname : string; inhclass : TStringList; - begin + begin inhclass:=TStringList.Create; inhclass.delimiter:=','; if InhInfo.Count>0 then @@ -920,12 +964,12 @@ end; for j:= 0 to inhclass.count-1 do begin - //writeln('processing',inhclass[j]); + // writeln('processing',inhclass[j]); clname:=inhclass[j]; - splitalias(clname,alname); + splitalias(clname,alname); if alname<>'' then // the class//interface we refered to is an alias begin - // writeln('Found alias pair ',clname,' = ',alname); + // writeln('Found alias pair ',clname,' = ',alname); if not assigned(CreateAliasType(alname,clname,cls,cls2)) then DoLog('Warning: creating alias %s for %s failed!',[alname,clname]); end @@ -934,7 +978,7 @@ end; end; end; inhclass.free; - end; + end; var s, Name: String; @@ -991,10 +1035,10 @@ end; CurClass.Members.Add(Member); end; end; - ProcessInheritanceStrings(Inheritanceinfo); + ProcessInheritanceStrings(Inheritanceinfo); finally - inheritanceinfo.Free; - end; + inheritanceinfo.Free; + end; end; var @@ -1042,11 +1086,13 @@ var end; end; - function CheckImplicitInterfaceLink(const s : String):String; + function CheckImplicitLink(const s : String):String; begin - if uppercase(s)='IUNKNOWN' then + if uppercase(s)='IUNKNOWN' then Result:='#rtl.System.IUnknown' - else + else if uppercase(s)='TOBJECT' then + Result:='#rtl.System.TObject' + else Result:=s; end; var @@ -1054,7 +1100,8 @@ var i, j, k: Integer; Module: TPasModule; Alias : TPasAliasType; - ClassDecl: TPasClassType; + MemberDecl: TPasMembersType; + ClassLikeDecl : TPasClassType; Member: TPasElement; s: String; Buf : TBufType; @@ -1087,41 +1134,48 @@ begin if not assigned(Module.InterfaceSection) then continue; for j := 0 to Module.InterfaceSection.Classes.Count - 1 do - begin - ClassDecl := TPasClassType(Module.InterfaceSection.Classes[j]); - Write(ContentFile, CheckImplicitInterfaceLink(ClassDecl.PathName), ' '); - if Assigned(ClassDecl.AncestorType) then + begin + MemberDecl := TPasClassType(Module.InterfaceSection.Classes[j]); + if MemberDecl is TPasClassType then + ClassLikeDecl:=MemberDecl as TPasClassType + else + ClassLikeDecl:=nil; + Write(ContentFile, CheckImplicitLink(MemberDecl.PathName), ' '); + if Assigned(ClassLikeDecl) then begin - // simple aliases to class types are coded as "alias(classtype)" - Write(ContentFile, CheckImplicitInterfaceLink(ClassDecl.AncestorType.PathName)); - if ClassDecl.AncestorType is TPasAliasType then + if Assigned(ClassLikeDecl.AncestorType) then + begin + // simple aliases to class types are coded as "alias(classtype)" + Write(ContentFile, CheckImplicitLink(ClassLikeDecl.AncestorType.PathName)); + if ClassLikeDecl.AncestorType is TPasAliasType then begin - alias:= TPasAliasType(ClassDecl.AncestorType); - if assigned(alias.desttype) and (alias.desttype is TPasClassType) then - write(ContentFile,'(',alias.desttype.PathName,')'); + alias:= TPasAliasType(ClassLikeDecl.AncestorType); + if assigned(alias.desttype) and (alias.desttype is TPasClassType) then + write(ContentFile,'(',alias.desttype.PathName,')'); end; - end - else if ClassDecl.ObjKind = okClass then - Write(ContentFile, '#rtl.System.TObject') - else if ClassDecl.ObjKind = okInterface then - Write(ContentFile, '#rtl.System.IUnknown'); - if ClassDecl.Interfaces.Count>0 then - begin - for k:=0 to ClassDecl.Interfaces.count-1 do + end + else if ClassLikeDecl.ObjKind = okClass then + Write(ContentFile, '#rtl.System.TObject') + else if ClassLikeDecl.ObjKind = okInterface then + Write(ContentFile, '#rtl.System.IUnknown'); + if ClassLikeDecl.Interfaces.Count>0 then + begin + for k:=0 to ClassLikeDecl.Interfaces.count-1 do begin - write(contentfile,',',CheckImplicitInterfaceLink(TPasClassType(ClassDecl.Interfaces[k]).PathName)); - if TPasElement(ClassDecl.Interfaces[k]) is TPasAliasType then + write(contentfile,',',CheckImplicitLink(TPasType(ClassLikeDecl.Interfaces[k]).PathName)); + if TPasElement(ClassLikeDecl.Interfaces[k]) is TPasAliasType then begin - alias:= TPasAliasType(ClassDecl.Interfaces[k]); + alias:= TPasAliasType(ClassLikeDecl.Interfaces[k]); if assigned(alias.desttype) and (alias.desttype is TPasClassType) then - write(ContentFile,'(',CheckImplicitInterfaceLink(alias.desttype.PathName),')'); + write(ContentFile,'(',CheckImplicitLink(alias.desttype.PathName),')'); end; end; + end; end; writeln(contentfile); - for k := 0 to ClassDecl.Members.Count - 1 do + for k := 0 to MemberDecl.Members.Count - 1 do begin - Member := TPasElement(ClassDecl.Members[k]); + Member := TPasElement(MemberDecl.Members[k]); Write(ContentFile, Chr(Ord(Member.Visibility) + Ord('0'))); S:=''; if Member.ClassType = TPasVariable then @@ -1163,41 +1217,41 @@ begin Result.SourceLinenumber := ASourceLinenumber; end; -function TFPDocEngine.FindElement(const AName: String): TPasElement; +function TFPDocEngine.FindInModule ( const AName: String; AModule: TPasModule + ) : TPasElement; +var + l: TFPList; + i: Integer; - function FindInModule(AModule: TPasModule; const LocalName: String): TPasElement; - - var - l: TFPList; - i: Integer; - - begin - If assigned(AModule.InterfaceSection) and - Assigned(AModule.InterfaceSection.Declarations) then +begin + If Assigned(AModule) and Assigned(AModule.InterfaceSection) and + Assigned(AModule.InterfaceSection.Declarations) then + begin + l:=AModule.InterfaceSection.Declarations; + for i := 0 to l.Count - 1 do begin - l:=AModule.InterfaceSection.Declarations; - for i := 0 to l.Count - 1 do - begin - Result := TPasElement(l[i]); - if CompareText(Result.Name, LocalName) = 0 then - exit; - end; - end; - Result := nil; - end; + Result := TPasElement(l[i]); + if CompareText(Result.Name, AName) = 0 then + exit; + end; + end; + Result := nil; +end; + +function TFPDocEngine.FindElement(const AName: String): TPasElement; var i: Integer; Module: TPasElement; begin - Result := FindInModule(CurModule, AName); + Result := FindInModule( AName, CurModule ); if not Assigned(Result) and assigned (CurModule.InterfaceSection) then for i := CurModule.InterfaceSection.UsesList.Count - 1 downto 0 do begin Module := TPasElement(CurModule.InterfaceSection.UsesList[i]); if Module.ClassType.InheritsFrom(TPasModule) then begin - Result := FindInModule(TPasModule(Module), AName); + Result := FindInModule(AName, TPasModule(Module)); if Assigned(Result) then exit; end; @@ -1519,22 +1573,27 @@ end; function TFPDocEngine.FindDocNode(AElement: TPasElement): TDocNode; begin Result:=Nil; - If Assigned(AElement) then + If not Assigned(AElement) then + exit; + if aElement.CustomData is TDocNode then + Exit(TDocNode(aElement.CustomData)); + if AElement.InheritsFrom(TPasUnresolvedTypeRef) then + Result := FindDocNode(AElement.GetModule, AElement.Name) + else begin - if AElement.InheritsFrom(TPasUnresolvedTypeRef) then - Result := FindDocNode(AElement.GetModule, AElement.Name) - else - begin - Result := RootDocNode.FindChild(AElement.PathName); - if (Result=Nil) and (AElement is TPasoperator) then - Result:=RootDocNode.FindChild(TPasOperator(AElement).OldName(True)); - end; - if (Result=Nil) and - WarnNoNode and - (Length(AElement.PathName)>0) and - (AElement.PathName[1]='#') then - DoLog(Format('No documentation node found for identifier : %s',[AElement.PathName])); + Result := RootDocNode.FindChild(AElement.PathName); + if (Result=Nil) and (AElement is TPasoperator) then + Result:=RootDocNode.FindChild(TPasOperator(AElement).OldName(True)); end; + if (Result<>Nil) then + begin + if aElement.CustomData=Nil then + aElement.CustomData:=Result; + end + else if WarnNoNode and + (Length(AElement.PathName)>0) and + (AElement.PathName[1]='#') then + DoLog(Format('No documentation node found for identifier : %s',[AElement.PathName])); end; function TFPDocEngine.FindDocNode(ARefModule: TPasModule; @@ -1732,6 +1791,23 @@ begin end; end; +function DumpExceptionCallStack(E: Exception):String; +var + I: Integer; + Frames: PPointer; +begin + Result := 'Program exception! ' + LineEnding + + 'Stacktrace:' + LineEnding + LineEnding; + if E <> nil then begin + Result := Result + 'Exception class: ' + E.ClassName + LineEnding + + 'Message: ' + E.Message + LineEnding; + end; + Result := Result + BackTraceStrFunc(ExceptAddr); + Frames := ExceptFrames; + for I := 0 to ExceptFrameCount - 1 do + Result := Result + LineEnding + BackTraceStrFunc(Frames[I]); +end; + initialization LEOL:=Length(LineEnding); end. |