diff --git a/utils/fpdoc/dglobals.pp b/utils/fpdoc/dglobals.pp index 032f07f7a5..29e48fd5c8 100644 --- a/utils/fpdoc/dglobals.pp +++ b/utils/fpdoc/dglobals.pp @@ -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'; @@ -205,7 +208,9 @@ resourcestring Const SVisibility: array[TPasMemberVisibility] of string = ('Default', 'Private', 'Protected', 'Public', - 'Published', 'Automated','Strict Private','Strict Protected','Required','Optional'); + 'Published', 'Automated','Strict Private','Strict Protected', + 'Required', 'Optional' // ObjCClass + ); type TBufType = Array[1..ContentBufSize-1] of byte; @@ -319,9 +324,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; @@ -338,13 +343,16 @@ type constructor Create; destructor Destroy; override; procedure SetPackageName(const APackageName: String); + // process the import 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; @@ -660,7 +668,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 @@ -708,8 +718,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 @@ -721,56 +733,57 @@ 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:=''; + if not CreateNew then + exit; + HPackage := TPasPackage(inherited CreateElement(TPasPackage, s, nil, + '', 0)); + FPackages.Add(HPackage); + end; - // 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 + // 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; - HPackage := TPasPackage(inherited CreateElement(TPasPackage, s, nil, - '', 0)); - FPackages.Add(HPackage); + Module := TPasModule(HPackage.Modules[i]); + break; 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 - begin - if not CreateNew then - exit; - Module := TPasExternalModule.Create(s, HPackage); - Module.InterfaceSection := TInterfaceSection.Create('', Module); - HPackage.Modules.Add(Module); - 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; + HPackage.Modules.Add(Module); + end; + pkg:=hpackage; + result:=Copy(AName, DotPos2 + 1, length(AName)-dotpos2); end; function SearchInList(clslist:TFPList;s:string):TPasElement; @@ -834,9 +847,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); @@ -848,10 +861,10 @@ 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 @@ -870,47 +883,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 + 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('found alias ',clname,' (',s,') ',result.classname); + 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; + Result := TPasAliasType(CreateElement(TPasAliasType,s,module.interfacesection,vispublic,'',0)); + module.interfacesection.Declarations.Add(Result); + TPasAliasType(Result).DestType := cl2; + end end - else - 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; - 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 @@ -922,12 +935,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 @@ -936,7 +949,7 @@ end; end; end; inhclass.free; - end; + end; var s, Name: String; @@ -993,10 +1006,10 @@ end; CurClass.Members.Add(Member); end; end; - ProcessInheritanceStrings(Inheritanceinfo); + ProcessInheritanceStrings(Inheritanceinfo); finally - inheritanceinfo.Free; - end; + inheritanceinfo.Free; + end; end; var @@ -1044,11 +1057,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 @@ -1096,13 +1111,13 @@ begin ClassLikeDecl:=MemberDecl as TPasClassType else ClassLikeDecl:=nil; - Write(ContentFile, CheckImplicitInterfaceLink(MemberDecl.PathName), ' '); + Write(ContentFile, CheckImplicitLink(MemberDecl.PathName), ' '); if Assigned(ClassLikeDecl) then begin if Assigned(ClassLikeDecl.AncestorType) then begin // simple aliases to class types are coded as "alias(classtype)" - Write(ContentFile, CheckImplicitInterfaceLink(ClassLikeDecl.AncestorType.PathName)); + Write(ContentFile, CheckImplicitLink(ClassLikeDecl.AncestorType.PathName)); if ClassLikeDecl.AncestorType is TPasAliasType then begin alias:= TPasAliasType(ClassLikeDecl.AncestorType); @@ -1118,12 +1133,12 @@ begin begin for k:=0 to ClassLikeDecl.Interfaces.count-1 do begin - write(contentfile,',',CheckImplicitInterfaceLink(TPasClassType(ClassLikeDecl.Interfaces[k]).PathName)); + write(contentfile,',',CheckImplicitLink(TPasClassType(ClassLikeDecl.Interfaces[k]).PathName)); if TPasElement(ClassLikeDecl.Interfaces[k]) is TPasAliasType then begin 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; @@ -1173,41 +1188,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; diff --git a/utils/fpdoc/dw_html.pp b/utils/fpdoc/dw_html.pp index c6a423a5d9..7564101722 100644 --- a/utils/fpdoc/dw_html.pp +++ b/utils/fpdoc/dw_html.pp @@ -15,7 +15,7 @@ {$mode objfpc} {$H+} -unit dw_HTML; +unit dw_html; {$WARN 5024 off : Parameter "$1" not used} interface @@ -75,9 +75,7 @@ type THTMLWriter = class(TFPDocWriter) private FImageFileList: TStrings; - FOnTest: TNotifyEvent; - FPackage: TPasPackage; FCharSet : String; procedure CreateMinusImage; procedure CreatePlusImage; @@ -233,7 +231,7 @@ type procedure CreatePackagePageBody; procedure CreatePackageIndex; procedure CreatePackageClassHierarchy; - procedure CreateClassHierarchyPage(AList: TStringList; AddUnit : Boolean); + procedure CreateClassHierarchyPage(AddUnit : Boolean); procedure AddModuleIdentifiers(AModule : TPasModule; L : TStrings); Procedure CreateTopicPageBody(AElement : TTopicElement); procedure CreateModulePageBody(AModule: TPasModule; ASubpageIndex: Integer); @@ -244,9 +242,9 @@ type procedure CreateVarPageBody(AVar: TPasVariable); procedure CreateProcPageBody(AProc: TPasProcedureBase); Procedure CreateTopicLinks(Node : TDocNode; PasElement : TPasElement); - procedure AddElementsFromList(L: TStrings; List: TFPList; UsePathName : Boolean = False); procedure AppendTypeDecl(AType: TPasType; TableEl, CodeEl: TDomElement); public + // Creating all module hierarchy classes is here !!!! constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); override; destructor Destroy; override; @@ -254,7 +252,7 @@ type function CreateHTMLPage(AElement: TPasElement; ASubpageIndex: Integer): TXMLDocument; function CreateXHTMLPage(AElement: TPasElement; ASubpageIndex: Integer): TXMLDocument; - // For producing complete package documentation + // Start producing html complete package documentation procedure WriteHTMLPages; virtual; procedure WriteXHTMLPages; function ModuleForElement(AnElement:TPasElement):TPasModule; @@ -266,7 +264,7 @@ type Class procedure SplitImport(var AFilename, ALinkPrefix: String); override; Property SearchPage: String Read FSearchPage Write FSearchPage; property Allocator: TFileAllocator read FAllocator; - property Package: TPasPackage read FPackage; + property PageCount: Integer read GetPageCount; Property IncludeDateInFooter : Boolean Read FIDF Write FIDF; Property DateFormat : String Read FDateFormat Write FDateFormat; @@ -326,13 +324,20 @@ function TLongNameFileAllocator.GetFilename(AElement: TPasElement; ASubindex: In var n,s: String; i: Integer; - + excl: Boolean; //search begin Result:=''; + excl := False; if AElement.ClassType = TPasPackage then - Result := 'index' + begin + Result := 'index'; + excl := True; + end else if AElement.ClassType = TPasModule then - Result := LowerCase(AElement.Name) + PathDelim + 'index' + begin + Result := LowerCase(AElement.Name) + PathDelim + 'index'; + excl := True; + end else begin if AElement is TPasOperator then @@ -361,8 +366,12 @@ begin if (N<>'') and (N[1]=':') then Delete(N,1,1); Result:=Result + '-'+ s + '-' + N; - end else + end + else + begin Result := LowerCase(AElement.PathName); + excl := (ASubindex > 0); + end; // searching for TPasModule - it is on the 2nd level if Assigned(AElement.Parent) then while Assigned(AElement.Parent.Parent) do @@ -375,6 +384,14 @@ begin Inc(i); if (i <= Length(Result)) and (i > 0) then Result[i] := PathDelim; + if excl or (Length(Result)=0) then + begin + // exclude the from full text search index + s:= '.'+ExtractFileName(Result + '.'); + n:= ExtractFileDir(Result); + Result := n + DirectorySeparator + s; + Result := Copy(Result, 1, Length(Result)-1); + end; end; if ASubindex > 0 then @@ -632,7 +649,7 @@ var H : Boolean; begin - inherited ; + inherited Create(APackage, AEngine); // should default to true since this is the old behavior UseMenuBrackets:=True; @@ -640,7 +657,6 @@ begin IndexColCount:=3; Charset:='iso-8859-1'; CreateAllocator; - FPackage := APackage; OutputNodeStack := TList.Create; PageInfos := TObjectList.Create; @@ -716,6 +732,7 @@ begin HTMLEl.AppendChild(BodyElement); CreatePageBody(AElement, ASubpageIndex); + AppendFooter; HeadEl.AppendChild(El); @@ -771,6 +788,7 @@ begin Filename := Engine.Output + Allocator.GetFilename(Element, SubpageIndex); try CreatePath(Filename); + //writeln('Element: ',Element.PathName, ' FileName: ', Filename); WriteHTMLFile(PageDoc, Filename); except on E: Exception do @@ -1534,7 +1552,8 @@ begin end; end; -Procedure THTMLWriter.AppendShortDescr(AContext: TPasElement; Parent: TDOMNode; DocNode : TDocNode); +procedure THTMLWriter.AppendShortDescr ( AContext: TPasElement; + Parent: TDOMNode; DocNode: TDocNode ) ; Var N : TDocNode; @@ -2093,7 +2112,7 @@ end; procedure THTMLWriter.AppendMenuBar(ASubpageIndex: Integer); var - TableEl, TREl, ParaEl, TitleEl: TDOMElement; + TableEl, TREl, TRE2, ParaEl, TitleEl: TDOMElement; procedure AddLink(ALinkSubpageIndex: Integer; const AName: String); begin @@ -2132,8 +2151,34 @@ begin TableEl['border'] := '0'; TableEl['width'] := '100%'; TableEl['class'] := 'bar'; + // Title Row TREl := CreateTR(TableEl); - ParaEl := CreateEl(CreateTD(TREl), 'b'); + // Menu title + ParaEl := CreateTD(TREl); + ParaEl['align'] := 'left'; + TitleEl := CreateEl(ParaEl, 'span'); + TitleEl['class'] := 'bartitle'; + if Assigned(Module) then + AppendText(TitleEl, Format(SDocUnitMenuTitle, [Module.Name])) + else + AppendText(TitleEl, Format(SDocPackageMenuTitle, [Package.Name])); + + // Package link title + ParaEl := CreateTD(TREl); + ParaEl['align'] := 'right'; + TitleEl := CreateEl(ParaEl, 'span'); + TitleEl['class'] := 'bartitle'; + if Assigned(Module) and Assigned(Package) then // Displays a Package page + begin + AppendText(TitleEl, SDocPackageLinkTitle); + end; + + // Links Row + TRE2 := CreateTR(TableEl); + ParaEl := CreateTD(TRE2); + ParaEl['align'] := 'left'; + ParaEl := CreateEl(ParaEl, 'span'); + ParaEl['class']:= 'bartitle'; if Assigned(Module) then begin @@ -2150,12 +2195,18 @@ begin AddLink(ProcsSubindex, SDocProceduresAndFunctions); if Module.InterfaceSection.Variables.Count > 0 then AddLink(VarsSubindex, SDocVariables); - AddLink(IndexSubIndex,SDocIdentifierIndex); + AddLink(IndexSubIndex,SDocIdentifierIndex); AppendFragment(ParaEl, NavigatorHTML); end else begin + // Overview + AppendText(ParaEl, '['); + AppendHyperlink(ParaEl, Package).TextContent:= UTF8Decode(SDocOverview); + AppendText(ParaEl, ']'); + //Index AddPackageLink(IndexSubIndex, SDocIdentifierIndex); + // Class TObject tree AddPackageLink(ClassHierarchySubIndex, SDocPackageClassHierarchy); AppendFragment(ParaEl, NavigatorHTML) end; @@ -2168,17 +2219,16 @@ begin if FUseMenuBrackets then AppendText(ParaEl, ']'); end; - ParaEl := CreateTD(TREl); + + ParaEl := CreateTD(TRE2); ParaEl['align'] := 'right'; - TitleEl := CreateEl(ParaEl, 'span'); - TitleEl['class'] := 'bartitle'; - if Assigned(Module) then - AppendText(TitleEl, Format(SDocUnitTitle, [Module.Name])); - if Assigned(Package) then + ParaEl := CreateEl(ParaEl, 'span'); + ParaEl['class']:= 'bartitle'; + if Assigned(Module) and Assigned(Package) then // Displays a Package page begin - AppendText(TitleEl, ' ('); - AppendHyperlink(TitleEl, Package); - AppendText(TitleEl, ')'); + AppendText(ParaEl, '['); + AppendHyperlink(ParaEl, Package); + AppendText(ParaEl, ']'); end; AppendFragment(BodyElement,HeaderHTML); end; @@ -2189,7 +2239,8 @@ begin [ExtractFileName(AElement.SourceFilename), AElement.SourceLinenumber])); end; -Procedure THTMLWriter.AppendSeeAlsoSection(AElement : TPasElement;DocNode : TDocNode); +procedure THTMLWriter.AppendSeeAlsoSection ( AElement: TPasElement; + DocNode: TDocNode ) ; var Node: TDOMNode; @@ -2263,7 +2314,8 @@ begin end; // While end; -Procedure THTMLWriter.AppendExampleSection(AElement : TPasElement;DocNode : TDocNode); +procedure THTMLWriter.AppendExampleSection ( AElement: TPasElement; + DocNode: TDocNode ) ; var Node: TDOMNode; @@ -2384,10 +2436,11 @@ begin end; end; -procedure THTMLWriter.CreateClassHierarchyPage(AList : TStringList; AddUnit : Boolean); +procedure THTMLWriter.CreateClassHierarchyPage(AddUnit : Boolean); +type + TypeEN = (NPackage, NModule, NName); Procedure PushClassElement; - Var H : THTMLElement; begin @@ -2403,7 +2456,6 @@ procedure THTMLWriter.CreateClassHierarchyPage(AList : TStringList; AddUnit : Bo end; Procedure PushClassList; - Var H : THTMLElement; begin @@ -2412,32 +2464,39 @@ procedure THTMLWriter.CreateClassHierarchyPage(AList : TStringList; AddUnit : Bo PushOutputNode(h); end; - Procedure AppendClass(E : TPasElementNode); + function ExtractName(APathName: String; Tp: TypeEN):String; + var + l:TStringList; + begin + Result:= Trim(APathName); + if Result = '' then exit; + l:=TStringList.Create; + try + l.AddDelimitedText(Result, '.', True); + if l.Count=3 then + Result:= l.Strings[Integer(Tp)] + else + Result:=''; + finally + l.free; + end; + end; + + Procedure AppendClass(EN : TPasElementNode); Var - N : TDomNode; - P,PM,M : TPasElement; - EN : String; - LL : TstringList; - I,J : Integer; + PE,PM : TPasElement; + I : Integer; begin - M:=E.Element.GetModule; - if (M<>Nil) then - EN:=Package.Name+'.'+UTF8Encode(M.Name)+'.'+UTF8Encode(E.Element.Name) - else - EN:=UTF8Encode(E.Element.Name); - J:=AList.IndexOf(EN); - If J<>-1 then - P:=AList.Objects[J] as TPasElement - else - P:=Engine.FindElement(EN); + if not Assigned(EN) then exit; + PE:=EN.Element; PushClassElement; try - if (P<>Nil) then + if (PE<>Nil) then begin - AppendHyperLink(CurOutputNode,P); - PM:=ModuleForElement(P); + AppendHyperLink(CurOutputNode,PE); + PM:=ModuleForElement(PE); if (PM<>Nil) then begin AppendText(CurOutputNode,' ('); @@ -2446,13 +2505,13 @@ procedure THTMLWriter.CreateClassHierarchyPage(AList : TStringList; AddUnit : Bo end end else - AppendText(CurOutputNode,E.Element.Name); - if E.ChildCount>0 then + AppendText(CurOutputNode,EN.Element.Name); + if EN.ChildCount>0 then begin PushClassList; try - For I:=0 to E.ChildCount-1 do - AppendClass(E.Children[i] as TPasElementNode); + For I:=0 to EN.ChildCount-1 do + AppendClass(EN.Children[i] as TPasElementNode); finally PopOutputNode; end; @@ -2462,29 +2521,12 @@ procedure THTMLWriter.CreateClassHierarchyPage(AList : TStringList; AddUnit : Bo end; end; -Var - B : TClassTreeBuilder; - E : TPasElementNode; - begin PushOutputNode(BodyElement); try - B:=TClassTreeBuilder.Create(Package,okClass); - try - B.BuildTree(AList); - // Classes - // WriteXMLFile(B.ClassTree,'tree.xml'); - // Dummy TObject - E:=B.RootNode; - PushClassList; - try - AppendClass(E); - finally - PopOutputNode; - end; - finally - B.Free; - end; + PushClassList; + AppendClass(TreeClass.RootNode); + //PopOutputNode; finally PopOutputNode; end; @@ -2500,9 +2542,6 @@ Const '}'; Var - L : TStringList; - I : Integer; - M : TPasModule; S : String; SE : THTMLElement; @@ -2510,24 +2549,12 @@ begin SE := Doc.CreateElement('script'); AppendText(SE,SFunc); HeadElement.AppendChild(SE); - L:=TStringList.Create; - try - L.Capacity:=PageInfos.Count; // Too much, but that doesn't hurt. - For I:=0 to Package.Modules.Count-1 do - begin - M:=TPasModule(Package.Modules[i]); - if Not (M is TPasExternalModule) and assigned(M.InterfaceSection) then - Self.AddElementsFromList(L,M.InterfaceSection.Classes,True) - end; - AppendMenuBar(ClassHierarchySubIndex); - S:=Package.Name; - If Length(S)>0 then - Delete(S,1,1); - AppendTitle(UTF8Decode(Format(SDocPackageClassHierarchy, [S]))); - CreateClassHierarchyPage(L,True); - Finally - L.Free; - end; + AppendMenuBar(ClassHierarchySubIndex); + S:=Package.Name; + If Length(S)>0 then + Delete(S,1,1); + AppendTitle(UTF8Decode(Format(SDocPackageClassHierarchy, [S]))); + CreateClassHierarchyPage(True); end; procedure THTMLWriter.CreatePageBody(AElement: TPasElement; @@ -2673,29 +2700,6 @@ begin end; end; -Procedure THTMLWriter.AddElementsFromList(L : TStrings; List : TFPList; UsePathName : Boolean = False); - -Var - I : Integer; - El : TPasElement; - N : TDocNode; - -begin - For I:=0 to List.Count-1 do - begin - El:=TPasElement(List[I]); - N:=Engine.FindDocNode(El); - if (N=Nil) or (not N.IsSkipped) then - begin - if UsePathName then - L.AddObject(El.PathName,El) - else - L.AddObject(El.Name,El); - If el is TPasEnumType then - AddElementsFromList(L,TPasEnumType(el).Values); - end; - end; -end; procedure THTMLWriter.AddModuleIdentifiers(AModule : TPasModule; L : TStrings); @@ -2783,7 +2787,8 @@ begin end; end; -Procedure THTMLWriter.CreateTopicLinks(Node : TDocNode; PasElement : TPasElement); +procedure THTMLWriter.CreateTopicLinks ( Node: TDocNode; + PasElement: TPasElement ) ; var DocNode: TDocNode; @@ -3351,10 +3356,9 @@ var i: Integer; ThisInterface, ThisClass: TPasClassType; - HaveSeenTObject: Boolean; - LName : String; - ThisNode : TPasUnresolvedTypeRef; + ThisTreeNode: TPasElementNode; begin + //WriteLn('@ClassPageBody.CreateMainPage Class=', AClass.Name); AppendMenuBar(-1); AppendTitle(UTF8Decode(AClass.Name),AClass.Hints); @@ -3398,28 +3402,29 @@ var end; CreateMemberDeclarations(AClass, AClass.Members,TableEl, not AClass.IsShortDefinition); - - AppendText(CreateH2(BodyElement), UTF8Decode(SDocInheritance)); TableEl := CreateTable(BodyElement); - HaveSeenTObject := AClass.ObjKind <> okClass; - // we try to track classes. But imported classes - // are TLinkNode's not the TPasClassType generated by the parser. - ThisClass := AClass; ThisNode := Nil; + + // Now we are using only TreeClass for show inheritance + + ThisClass := AClass; ThisTreeNode := Nil; + if AClass.ObjKind = okInterface then + ThisTreeNode := TreeInterface.GetPasElNode(AClass) + else + ThisTreeNode := TreeClass.GetPasElNode(AClass); while True do begin TREl := CreateTR(TableEl); TDEl := CreateTD_vtop(TREl); TDEl['align'] := 'center'; CodeEl := CreateCode(CreatePara(TDEl)); - if Assigned(ThisClass) then - LName:=ThisClass.Name - Else - LName:=ThisNode.Name; + + // Show class item if Assigned(ThisClass) Then - AppendHyperlink(CodeEl, ThisClass) - else - AppendHyperlink(CodeEl, ThisNode); + AppendHyperlink(CodeEl, ThisClass); + //else + // AppendHyperlink(CodeEl, ThisTreeNode); + // Show links to class interfaces if Assigned(ThisClass) and (ThisClass.Interfaces.count>0) then begin for i:=0 to ThisClass.interfaces.count-1 do @@ -3429,48 +3434,28 @@ var AppendHyperlink(CodeEl, ThisInterface); end; end; - AppendShortDescrCell(TREl, ThisClass); - if HaveSeenTObject or (CompareText(LName, 'TObject') = 0) then - HaveSeenTObject := True - else - begin - TDEl := CreateTD(CreateTR(TableEl)); - TDEl['align'] := 'center'; - AppendText(TDEl, '|'); - end; + // short class description + if Assigned(ThisClass) then + AppendShortDescrCell(TREl, ThisClass); - if Assigned(ThisClass.AncestorType) then - begin - if ThisClass.AncestorType.InheritsFrom(TPasClassType) then - ThisClass := TPasClassType(ThisClass.AncestorType) - else + if Assigned(ThisTreeNode) then + if Assigned(ThisTreeNode.ParentNode) then begin - if thisclass.ancestortype is TPasUnresolvedTypeRef then - thisnode:=TPasUnresolvedTypeRef(ThisClass.ancestortype); TDEl := CreateTD(CreateTR(TableEl)); TDEl['align'] := 'center'; - AppendText(CreateCode(CreatePara(TDEl)), UTF8Decode(ThisClass.AncestorType.Name)); - if CompareText(ThisClass.AncestorType.Name, 'TObject') = 0 then - HaveSeenTObject := True + AppendText(TDEl, '|'); + ThisClass := ThisTreeNode.ParentNode.Element; + ThisTreeNode := ThisTreeNode.ParentNode; + end else - begin - TDEl := CreateTD(CreateTR(TableEl)); - TDEl['align'] := 'center'; - AppendText(TDEl, '?'); - end; + begin + ThisClass := nil; + ThisTreeNode:= nil; break; end - end else + else break; end; - - if not HaveSeenTObject then - begin - TDEl := CreateTD(CreateTR(TableEl)); - TDEl['align'] := 'center'; - AppendText(CreateCode(CreatePara(TDEl)), 'TObject'); - end; - FinishElementPage(AClass); end; @@ -3847,11 +3832,12 @@ begin FinishElementPage(AProc); end; -Function THTMLWriter.InterPretOption(Const Cmd,Arg : String) : boolean; +function THTMLWriter.InterPretOption ( const Cmd, Arg: String ) : boolean; Function ReadFile(aFileName : string) : TstringStream; begin + aFileName:= SetDirSeparators(aFileName); try if copy(aFileName,1,1)<>'@' then Result:=TStringStream.Create(aFileName) @@ -3942,7 +3928,7 @@ begin end; end; -Class Function THTMLWriter.FileNameExtension : String; +class function THTMLWriter.FileNameExtension: String; begin result:=''; end; diff --git a/utils/fpdoc/dw_txt.pp b/utils/fpdoc/dw_txt.pp index 47780cfbbe..9557b196d2 100644 --- a/utils/fpdoc/dw_txt.pp +++ b/utils/fpdoc/dw_txt.pp @@ -158,18 +158,19 @@ Function FindSpace(Const S : String; P : Integer) : Integer; Var I,L : Integer; - + SP: set of char; begin Result:=0; + SP := [#10,#13,' ',#9]; I:=P; L:=Length(S); - While (I>0) and (I<=L) and not (S[i] in [#10,#13,' ',#9]) do - Dec(i); + While (I>0) and (I<=L) and not (S[i] in SP) do + Dec(I); If (I=0) then begin - I:=P; - While (I<=L) and not (S[i] in [#10,#13,' ',#9]) do - Inc(i); + Inc(I); + While (I<=L) and not (S[I] in SP) do + Inc(I); end; Result:=I; end; @@ -186,7 +187,7 @@ begin exit; N:=S; Repeat - If ((FCurrentPos+Length(N))>LineWidth) then + If ((FCurrentPos+Length(N)+1)>LineWidth) then begin L:=FindSpace(N,LineWidth-FCurrentPos+1); inherited Write(Copy(N,1,L-1)); @@ -195,8 +196,8 @@ begin end else begin - L:=Length(N)+1; - inherited Write(Copy(N,1,L-1)); + L:=Length(N); + inherited Write(Copy(N,1,L)); Inc(FCurrentPos,L); If FCheckEOL then If (L>=LEOL) then diff --git a/utils/fpdoc/dwriter.pp b/utils/fpdoc/dwriter.pp index 5b427e1720..27d909dfd3 100644 --- a/utils/fpdoc/dwriter.pp +++ b/utils/fpdoc/dwriter.pp @@ -25,7 +25,7 @@ unit dWriter; {$WARN 5024 off : Parameter "$1" not used} interface -uses Classes, DOM, dGlobals, PasTree, SysUtils; +uses Classes, DOM, dGlobals, PasTree, SysUtils, fpdocclasstree; resourcestring SErrFileWriting = 'An error occurred during writing of file "%s": %s'; @@ -80,8 +80,12 @@ type FImgExt : String; FBeforeEmitNote : TWriterNoteEvent; procedure ConvertURL(AContext: TPasElement; El: TDOMElement); - + procedure CreateClassTree; protected + TreeClass: TClassTreeBuilder; // Global class tree + TreeInterface: TClassTreeBuilder; // Global interface tree + + procedure AddElementsFromList(L: TStrings; List: TFPList; UsePathName : Boolean = False); Procedure DoLog(Const Msg : String); Procedure DoLog(Const Fmt : String; Args : Array of const); procedure Warning(AContext: TPasElement; const AMsg: String); @@ -339,7 +343,8 @@ end; } -Constructor TFPDocWriter.Create(APackage: TPasPackage; AEngine: TFPDocEngine); +constructor TFPDocWriter.Create ( APackage: TPasPackage; AEngine: TFPDocEngine + ) ; begin inherited Create; @@ -347,6 +352,9 @@ begin FPackage := APackage; FTopics:=Tlist.Create; FImgExt:='.png'; + TreeClass:= TClassTreeBuilder.Create(FEngine, FPackage, okClass); + TreeInterface:= TClassTreeBuilder.Create(FEngine, FPackage, okInterface); + CreateClassTree; end; destructor TFPDocWriter.Destroy; @@ -358,6 +366,8 @@ begin For I:=0 to FTopics.Count-1 do TTopicElement(FTopics[i]).Free; FTopics.Free; + TreeClass.free; + TreeInterface.Free; Inherited; end; @@ -390,7 +400,7 @@ begin end; end; -Function TFPDocWriter.FindTopicElement(Node : TDocNode): TTopicElement; +function TFPDocWriter.FindTopicElement ( Node: TDocNode ) : TTopicElement; Var I : Integer; @@ -713,6 +723,55 @@ begin DescrEndURL; end; +procedure TFPDocWriter.AddElementsFromList ( L: TStrings; List: TFPList; + UsePathName: Boolean ) ; +Var + I : Integer; + El : TPasElement; + N : TDocNode; + +begin + For I:=0 to List.Count-1 do + begin + El:=TPasElement(List[I]); + N:=Engine.FindDocNode(El); + if (N=Nil) or (not N.IsSkipped) then + begin + if UsePathName then + L.AddObject(El.PathName,El) + else + L.AddObject(El.Name,El); + If el is TPasEnumType then + AddElementsFromList(L,TPasEnumType(el).Values); + end; + end; +end; + +procedure TFPDocWriter.CreateClassTree; +var + L: TStringList; + M: TPasModule; + I:Integer; +begin + L:=TStringList.Create; + try + For I:=0 to Package.Modules.Count-1 do + begin + M:=TPasModule(Package.Modules[i]); + if Not (M is TPasExternalModule) and assigned(M.InterfaceSection) then + Self.AddElementsFromList(L,M.InterfaceSection.Classes,True) + end; + TreeClass.BuildTree(L); + TreeInterface.BuildTree(L); + {$IFDEF TREE_TEST} + TreeClass.SaveToXml('TreeClass.xml'); + TreeInterface.SaveToXml('TreeInterface.xml'); + {$ENDIF} + Finally + L.Free; + end; +end; + procedure TFPDocWriter.DoLog(const Msg: String); begin If Assigned(FEngine.OnLog) then @@ -1126,7 +1185,7 @@ begin Result := False; end; -Procedure TFPDocWriter.ConvertImage(El : TDomElement); +procedure TFPDocWriter.ConvertImage ( El: TDomElement ) ; Var FN,Cap,LinkName : DOMString; @@ -1169,7 +1228,7 @@ begin Inherited; end; -Function TFPDocWriter.WriteDescr(Element: TPasElement) : TDocNode; +function TFPDocWriter.WriteDescr ( Element: TPasElement ) : TDocNode; begin Result:=Engine.FindDocNode(Element); @@ -1211,7 +1270,8 @@ begin Result:=Not ((M.Visibility=visProtected) and Engine.HideProtected) end; -Procedure TFPDocWriter.GetMethodList(ClassDecl: TPasClassType; List : TStringList); +procedure TFPDocWriter.GetMethodList ( ClassDecl: TPasClassType; + List: TStringList ) ; Var I : Integer; diff --git a/utils/fpdoc/fpclasschart.pp b/utils/fpdoc/fpclasschart.pp index 5d7540d02b..1ce706f8bb 100644 --- a/utils/fpdoc/fpclasschart.pp +++ b/utils/fpdoc/fpclasschart.pp @@ -447,7 +447,7 @@ Constructor TClassTreeEngine.Create(AClassTree : TXMLDocument; AObjectKind : TPa begin FPackage:=TPasPackage.Create('dummy',Nil); - FTree:=TClassTreeBuilder.Create(FPackage,AObjectKind); + FTree:=TClassTreeBuilder.Create(Self,FPackage,AObjectKind); FObjects:=TStringList.Create; Inherited Create; end; diff --git a/utils/fpdoc/fpdoc.lpi b/utils/fpdoc/fpdoc.lpi index 3f2c178c23..d9e4871ebb 100644 --- a/utils/fpdoc/fpdoc.lpi +++ b/utils/fpdoc/fpdoc.lpi @@ -1,7 +1,7 @@ - + @@ -10,9 +10,9 @@ + - <ResourceType Value="res"/> <UseXPManifest Value="True"/> @@ -65,7 +65,6 @@ <Unit3> <Filename Value="dw_html.pp"/> <IsPartOfProject Value="True"/> - <UnitName Value="dw_HTML"/> </Unit3> <Unit4> <Filename Value="dw_ipflin.pas"/> diff --git a/utils/fpdoc/fpdoc.pp b/utils/fpdoc/fpdoc.pp index f08bf023e1..64ba449dec 100644 --- a/utils/fpdoc/fpdoc.pp +++ b/utils/fpdoc/fpdoc.pp @@ -428,6 +428,8 @@ begin end; begin + //AssignFile(Output, 'fpdoc.log'); + //rewrite(Output); With TFPDocApplication.Create(Nil) do try Run; diff --git a/utils/fpdoc/fpdocclasstree.pp b/utils/fpdoc/fpdocclasstree.pp index fbc5997916..91084de79f 100644 --- a/utils/fpdoc/fpdocclasstree.pp +++ b/utils/fpdoc/fpdocclasstree.pp @@ -5,7 +5,7 @@ unit fpdocclasstree; interface uses - Classes, SysUtils, DOM, pastree, contnrs; + Classes, SysUtils, dGlobals, pastree, contnrs, DOM ,XMLWrite; Type @@ -13,16 +13,18 @@ Type TPasElementNode = Class Private - FElement : TPasElement; + FElement : TPasClassType; + FParentNode: TPasElementNode; FChildren : TFPObjectList; function GetChild(aIndex : Integer): TPasElementNode; function GetChildCount: Integer; Public - Constructor Create (aElement : TPaselement); + Constructor Create (aElement : TPasClassType); Destructor Destroy; override; Procedure AddChild(C : TPasElementNode); Procedure SortChildren; - Property Element : TPasElement Read FElement; + Property Element : TPasClassType Read FElement; + Property ParentNode : TPasElementNode read FParentNode; Property Children [aIndex : Integer] : TPasElementNode Read GetChild; Property ChildCount : Integer Read GetChildCount; end; @@ -31,20 +33,27 @@ Type TClassTreeBuilder = Class Private - // Full name -> TDomElement; + FEngine:TFPDocEngine; FElementList : TFPObjectHashTable; FObjectKind : TPasObjKind; FPackage: TPasPackage; FParentObject : TPasClassType; FRootNode : TPasElementNode; FRootObjectName : string; + FRootObjectPathName : string; Protected function AddToList(aElement: TPasClassType): TPasElementNode; Public - Constructor Create(APackage : TPasPackage; AObjectKind : TPasObjKind = okClass); + Constructor Create(AEngine:TFPDocEngine; APackage : TPasPackage; + AObjectKind : TPasObjKind = okClass); Destructor Destroy; override; Function BuildTree(AObjects : TStringList) : Integer; +{$IFDEF TREE_TEST} + Procedure SaveToXml(AFileName: String); +{$ENDIF} Property RootNode : TPasElementNode Read FRootNode; + Property PasElToNodes: TFPObjectHashTable read FElementList; + function GetPasElNode (APasEl: TPasElement) : TPasElementNode; end; implementation @@ -72,7 +81,7 @@ begin Result:=0 end; -constructor TPasElementNode.Create(aElement: TPaselement); +constructor TPasElementNode.Create(aElement: TPasClassType); begin FElement:=aElement; end; @@ -96,24 +105,38 @@ begin FChildren.Sort(@SortOnElementName); end; -constructor TClassTreeBuilder.Create(APackage : TPasPackage; +constructor TClassTreeBuilder.Create(AEngine:TFPDocEngine; APackage : TPasPackage; AObjectKind: TPasObjKind); begin - FPackage:=APAckage; + FEngine:= AEngine; + FPackage:= APAckage; FObjectKind:=AObjectKind; Case FObjectkind of - okInterface : FRootObjectName:='#rtl.System.IInterface'; - okObject, - okClass : FRootObjectName:='#rtl.System.TObject'; + okInterface : + begin + FRootObjectPathName:='#rtl.System.IInterface'; + FRootObjectName:= 'IInterface'; + end; + okObject, okClass : + begin + FRootObjectPathName:='#rtl.System.TObject'; + FRootObjectName:= 'TObject'; + end else - FRootObjectName:='#rtl.System.TObject'; + begin + FRootObjectPathName:='#rtl.System.TObject'; + FRootObjectName:= 'TObject'; + end; end; - FParentObject:=TPasClassType.Create(FRootObjectName,FPackage); + FParentObject:=TPasClassType.Create(FRootObjectName,FEngine.FindModule('System')); + if not Assigned(FParentObject) then + FParentObject:=TPasClassType.Create(FRootObjectName,FPackage); FParentObject.ObjKind:=FObjectKind; FRootNode:=TPasElementNode.Create(FParentObject); + FRootNode.FParentNode := nil; FElementList:=TFPObjectHashTable.Create(False); - FElementList.Add(FRootObjectName,FRootNode); + FElementList.Add(FRootObjectPathName,FRootNode); end; destructor TClassTreeBuilder.Destroy; @@ -124,34 +147,37 @@ begin Inherited; end; -Function TClassTreeBuilder.AddToList(aElement : TPasClassType) : TPasElementNode; +function TClassTreeBuilder.AddToList ( aElement: TPasClassType + ) : TPasElementNode; Var aParentNode : TPasElementNode; aName : String; begin + Result:= nil; + if (aElement.ObjKind <> FObjectKind) then exit; + aParentNode:= nil; if aElement=Nil then aName:=FRootObjectName else - begin aName:=aElement.PathName; - end; Result:=TPasElementNode(FElementList.Items[aName]); if (Result=Nil) then - begin + begin if aElement.AncestorType is TPasClassType then - aParentNode:=AddToList(aElement.AncestorType as TPasClassType) - else + aParentNode:=AddToList(aElement.AncestorType as TPasClassType); + if not Assigned(aParentNode) then aParentNode:=FRootNode; Result:=TPasElementNode.Create(aElement); aParentNode.AddChild(Result); + Result.FParentNode := aParentNode; FElementList.Add(aName,Result); - end; + end; end; -Function TClassTreeBuilder.BuildTree(AObjects : TStringList) : Integer; +function TClassTreeBuilder.BuildTree ( AObjects: TStringList ) : Integer; (* Procedure DumpNode(Prefix : String; N : TPasElementNode); @@ -182,7 +208,64 @@ begin end; end; +function TClassTreeBuilder.GetPasElNode ( APasEl: TPasElement + ) : TPasElementNode; +begin + Result:= TPasElementNode(FElementList.Items[APasEl.PathName]); +end; +{$IFDEF TREE_TEST} +procedure TClassTreeBuilder.SaveToXml ( AFileName: String ) ; + + procedure AddPasElChildsToXml (ParentxmlEl : TDOMElement ; ParentPasEl: TPasElementNode ) ; + var + CounterVar: Integer; + PasElNode: TPasElementNode; + AXmlDoc: TDOMDocument; + xmlEl: TDOMElement; + M: TPasModule; + begin + if not Assigned(ParentPasEl) or (ParentPasEl.ChildCount = 0) then exit; + AXmlDoc:= ParentxmlEl.OwnerDocument; + for CounterVar := 0 to ParentPasEl.ChildCount-1 do + begin + PasElNode:= ParentPasEl.Children[CounterVar]; + xmlEl:= AXmlDoc.CreateElement(UnicodeString(PasElNode.Element.Name)); + M:= PasElNode.Element.GetModule; + xmlEl['unit'] := UnicodeString(M.Name); + xmlEl['package'] := UnicodeString(M.PackageName); + ParentxmlEl.AppendChild(xmlEl); + AddPasElChildsToXml(xmlEl, PasElNode); + end; + end; + +var + XmlDoc: TXMLDocument; + XmlRootEl: TDOMElement; + M: TPasModule; +begin + XmlDoc:= TXMLDocument.Create; + try + XmlRootEl:= XmlDoc.CreateElement(UnicodeString(FRootNode.Element.Name)); + M:= FRootNode.Element.GetModule; + if Assigned(M) then + begin + XmlRootEl['unit'] := UnicodeString(M.Name); + XmlRootEl['package'] := UnicodeString(M.PackageName); + end + else + begin + XmlRootEl['unit'] := 'system'; + XmlRootEl['package'] := 'rtl'; + end; + XmlDoc.AppendChild(XmlRootEl); + AddPasElChildsToXml(XmlRootEl, FRootNode); + WriteXMLFile(XmlDoc, AFileName); + finally + XmlDoc.Free; + end; +end; +{$ENDIF} end. diff --git a/utils/fpdoc/mkfpdoc.pp b/utils/fpdoc/mkfpdoc.pp index e45db7e14d..082ada773b 100644 --- a/utils/fpdoc/mkfpdoc.pp +++ b/utils/fpdoc/mkfpdoc.pp @@ -42,6 +42,8 @@ Type procedure SetVerbose(AValue: Boolean); virtual; Procedure DoLog(Const Msg : String); procedure DoLog(Const Fmt : String; Args : Array of Const); + Procedure DoLogSender(Sender : TObject; Const Msg : String); + // Create documetation by specified Writer class procedure CreateOutput(APackage: TFPDocPackage; Engine: TFPDocEngine); virtual; Public Constructor Create(AOwner : TComponent); override; @@ -96,6 +98,14 @@ begin DoLog(Format(Fmt,Args)); end; +procedure TFPDocCreator.DoLogSender ( Sender: TObject; const Msg: String ) ; +begin + if Assigned(Sender) then + DoLog(Format('%s - Sender: %s', [Msg, Sender.ClassName])) + else + DoLog(Msg); +end; + procedure TFPDocCreator.HandleOnParseUnit(Sender: TObject; const AUnitName: String; out AInputFile, OSTarget, CPUTarget: String); @@ -208,7 +218,9 @@ Var Cmd,Arg : String; begin + // Now is used the specified writer WriterClass:=GetWriterClass(Options.Backend); + // ALL CONTENT CREATED HERE Writer:=WriterClass.Create(Engine.Package,Engine); With Writer do Try @@ -225,10 +237,12 @@ begin If not InterPretOption(Cmd,Arg) then DoLog(SCmdLineInvalidOption,[Cmd+'='+Arg]); end; + // Output created Documentation WriteDoc; Finally Free; end; + // Output content files Writeln('Content file : ',APackage.ContentFile); if Length(APackage.ContentFile) > 0 then Engine.WriteContentFile(APackage.ContentFile); @@ -247,16 +261,21 @@ begin Cmd:=''; FCurPackage:=APackage; Engine:=TFPDocEngine.Create; + Engine.OnLog:= @DoLogSender; try + // get documentation Writer html, latex, and other WriterClass:=GetWriterClass(Options.Backend); For J:=0 to Apackage.Imports.Count-1 do begin Arg:=Apackage.Imports[j]; + // conversion import FilePathes WriterClass.SplitImport(Arg,Cmd); + // create tree of imported objects Engine.ReadContentFile(Arg, Cmd); end; for i := 0 to APackage.Descriptions.Count - 1 do Engine.AddDocFile(FixDescrFile(APackage.Descriptions[i]),Options.donttrim); + // set engine options Engine.SetPackageName(APackage.Name); Engine.Output:=APackage.Output; Engine.OnLog:=Self.OnLog; @@ -268,13 +287,18 @@ begin Engine.WarnNoNode:=Options.WarnNoNode; if Length(Options.Language) > 0 then TranslateDocStrings(Options.Language); + // scan the input source files for i := 0 to APackage.Inputs.Count - 1 do try + // get options from input packages SplitInputFileOption(APackage.Inputs[i],Cmd,Arg); + // make absolute filepath Cmd:=FixInputFile(Cmd); if FProcessedUnits.IndexOf(Cmd)=-1 then begin FProcessedUnits.Add(Cmd); + // Parce sources for OS Target + //WriteLn(Format('Parcing unit: %s', [ExtractFilenameOnly(Cmd)])); ParseSource(Engine,Cmd+' '+Arg, Options.OSTarget, Options.CPUTarget,[poUseStreams]); end; except @@ -290,6 +314,7 @@ begin if Not ParseOnly then begin Engine.StartDocumenting; + // Create documentation CreateOutput(APackage,Engine); end; finally